1 ! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: math kernel io sequences io.buffers io.timeouts generic
4 byte-vectors system io.encodings math.order io.backend
5 continuations classes byte-arrays namespaces splitting grouping
6 dlists alien alien.c-types assocs io.encodings.binary summary
7 accessors destructors combinators fry specialized-arrays ;
8 SPECIALIZED-ARRAY: uchar
11 SYMBOL: default-buffer-size
12 64 1024 * default-buffer-size set-global
14 TUPLE: port < disposable handle timeout ;
16 M: port timeout timeout>> ;
18 M: port set-timeout (>>timeout) ;
20 : <port> ( handle class -- port )
21 new-disposable swap >>handle ; inline
23 TUPLE: buffered-port < port { buffer buffer } ;
25 : <buffered-port> ( handle class -- port )
27 default-buffer-size get <buffer> >>buffer ; inline
29 TUPLE: input-port < buffered-port ;
31 M: input-port stream-element-type drop +byte+ ; inline
33 : <input-port> ( handle -- input-port )
34 input-port <buffered-port> ;
36 HOOK: (wait-to-read) io-backend ( port -- )
38 : wait-to-read ( port -- eof? )
39 dup buffer>> buffer-empty? [
40 dup (wait-to-read) buffer>> buffer-empty?
41 ] [ drop f ] if ; inline
43 M: input-port stream-read1
45 dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
47 : read-step ( count port -- byte-array/f )
48 dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
50 M: input-port stream-read-partial ( max stream -- byte-array/f )
52 [ 0 max >integer ] dip read-step ;
54 : read-loop ( count port accum -- )
55 pick over length - dup 0 > [
65 M: input-port stream-read
77 : read-until-step ( separators port -- string/f separator/f )
78 dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
80 : read-until-loop ( seps port buf -- separator/f )
81 2over read-until-step over [
91 M: input-port stream-read-until ( seps port -- str/f sep/f )
92 2dup read-until-step dup [ [ 2drop ] 2dip ] [
95 BV{ } like [ read-until-loop ] keep B{ } like swap
96 ] [ [ 2drop ] 2dip ] if
99 TUPLE: output-port < buffered-port ;
101 : <output-port> ( handle -- output-port )
102 output-port <buffered-port> ;
104 : wait-to-write ( len port -- )
105 [ nip ] [ buffer>> buffer-capacity <= ] 2bi
106 [ drop ] [ stream-flush ] if ; inline
108 M: output-port stream-element-type stream>> stream-element-type ; inline
110 M: output-port stream-write1
113 buffer>> byte>buffer ; inline
115 : write-in-groups ( byte-array port -- )
116 [ binary-object <direct-uchar-array> ] dip
117 [ buffer>> size>> <sliced-groups> ] [ '[ _ stream-write ] ] bi
120 M: output-port stream-write
122 2dup [ byte-length ] [ buffer>> size>> ] bi* > [
125 [ [ byte-length ] dip wait-to-write ]
126 [ buffer>> >buffer ] 2bi
129 HOOK: (wait-to-write) io-backend ( port -- )
131 HOOK: tell-handle os ( handle -- n )
132 HOOK: seek-handle os ( n seek-type handle -- )
134 M: buffered-port stream-tell ( stream -- n )
136 [ handle>> tell-handle ]
137 [ [ buffer>> size>> - 0 max ] [ buffer>> pos>> ] bi + ] tri ;
139 M: input-port stream-seek ( n seek-type stream -- )
141 [ buffer>> 0 swap buffer-reset ]
142 [ handle>> seek-handle ] tri ;
144 M: output-port stream-seek ( n seek-type stream -- )
147 [ handle>> seek-handle ] tri ;
149 GENERIC: shutdown ( handle -- )
151 M: object shutdown drop ;
153 : port-flush ( port -- )
154 dup buffer>> buffer-empty?
155 [ drop ] [ dup (wait-to-write) port-flush ] if ;
157 M: output-port stream-flush ( port -- )
158 [ check-disposed ] [ port-flush ] bi ;
160 M: output-port dispose*
163 [ handle>> &dispose drop ]
164 [ buffer>> &dispose drop ]
166 [ handle>> shutdown ]
170 M: buffered-port dispose*
171 [ call-next-method ] [ buffer>> dispose ] bi ;
173 M: port cancel-operation handle>> cancel-operation ;
177 [ handle>> &dispose drop ]
178 [ handle>> shutdown ]
182 GENERIC: underlying-port ( stream -- port )
184 M: port underlying-port ;
186 M: encoder underlying-port stream>> underlying-port ;
188 M: decoder underlying-port stream>> underlying-port ;
190 GENERIC: underlying-handle ( stream -- handle )
192 M: object underlying-handle underlying-port handle>> ;
194 ! Fast-path optimization
195 USING: hints strings io.encodings.utf8 io.encodings.ascii
196 io.encodings.private ;
198 HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
200 HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;