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
9 SPECIALIZED-ARRAY: uchar
12 SYMBOL: default-buffer-size
13 64 1024 * default-buffer-size set-global
15 TUPLE: port < disposable handle timeout ;
17 M: port timeout timeout>> ;
19 M: port set-timeout timeout<< ;
21 : <port> ( handle class -- port )
22 new-disposable swap >>handle ; inline
24 TUPLE: buffered-port < port { buffer buffer } ;
26 : <buffered-port> ( handle class -- port )
28 default-buffer-size get <buffer> >>buffer ; inline
30 TUPLE: input-port < buffered-port ;
32 M: input-port stream-element-type drop +byte+ ; inline
34 : <input-port> ( handle -- input-port )
35 input-port <buffered-port> ;
37 HOOK: (wait-to-read) io-backend ( port -- )
39 : wait-to-read ( port -- eof? )
40 dup buffer>> buffer-empty? [
41 dup (wait-to-read) buffer>> buffer-empty?
42 ] [ drop f ] if ; inline
44 M: input-port stream-peek1
45 dup check-disposed dup wait-to-read
46 [ drop f ] [ buffer>> buffer-peek1 ] if ; inline
48 M: input-port stream-read1
50 dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
52 : read-step ( count port -- byte-array/f )
54 { [ over 0 = ] [ 2drop f ] }
55 { [ dup wait-to-read ] [ 2drop f ] }
56 [ buffer>> buffer-read ]
59 : prepare-read ( count stream -- count stream )
60 dup check-disposed [ 0 max >fixnum ] dip ; inline
62 M: input-port stream-read-partial ( max stream -- byte-array/f )
63 prepare-read read-step ;
65 : read-loop ( count port accum -- )
66 pick over length - dup 0 > [
76 M: input-port stream-read
87 M: input-port stream-peek [ stream-read ] with-input-rewind ;
89 : read-until-step ( separators port -- string/f separator/f )
90 dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
92 : read-until-loop ( seps port buf -- separator/f )
93 2over read-until-step over [
103 M: input-port stream-read-until ( seps port -- str/f sep/f )
104 2dup read-until-step dup [ [ 2drop ] 2dip ] [
107 BV{ } like [ read-until-loop ] keep B{ } like swap
108 ] [ [ 2drop ] 2dip ] if
111 TUPLE: output-port < buffered-port ;
113 : <output-port> ( handle -- output-port )
114 output-port <buffered-port> ;
116 : wait-to-write ( len port -- )
117 [ nip ] [ buffer>> buffer-capacity <= ] 2bi
118 [ drop ] [ stream-flush ] if ; inline
120 M: output-port stream-element-type
121 stream>> stream-element-type ; inline
123 M: output-port stream-write1
126 buffer>> byte>buffer ; inline
128 : write-in-groups ( byte-array port -- )
129 [ binary-object <direct-uchar-array> ] dip
130 [ buffer>> size>> <sliced-groups> ] [ '[ _ stream-write ] ] bi
133 M: output-port stream-write
135 2dup [ byte-length ] [ buffer>> size>> ] bi* > [
138 [ [ byte-length ] dip wait-to-write ]
139 [ buffer>> >buffer ] 2bi
142 HOOK: (wait-to-write) io-backend ( port -- )
144 : port-flush ( port -- )
145 dup buffer>> buffer-empty?
146 [ drop ] [ dup (wait-to-write) port-flush ] if ;
148 M: output-port stream-flush ( port -- )
149 [ check-disposed ] [ port-flush ] bi ;
151 HOOK: tell-handle os ( handle -- n )
153 HOOK: seek-handle os ( n seek-type handle -- )
155 M: input-port stream-tell ( stream -- n )
157 [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ;
159 M: output-port stream-tell ( stream -- n )
161 [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
163 :: do-seek-relative ( n seek-type stream -- n seek-type stream )
164 ! seek-relative needs special handling here, because of the
166 seek-type seek-relative eq?
167 [ n stream stream-tell + seek-absolute ] [ n seek-type ] if
170 M: input-port stream-seek ( n seek-type stream -- )
173 [ buffer>> 0 swap buffer-reset ]
174 [ handle>> seek-handle ] tri ;
176 M: output-port stream-seek ( n seek-type stream -- )
180 [ handle>> seek-handle ] tri ;
182 GENERIC: shutdown ( handle -- )
184 M: object shutdown drop ;
186 M: output-port dispose*
189 [ handle>> &dispose drop ]
190 [ buffer>> &dispose drop ]
192 [ handle>> shutdown ]
196 M: buffered-port dispose*
197 [ call-next-method ] [ buffer>> dispose ] bi ;
199 M: port cancel-operation handle>> cancel-operation ;
203 [ handle>> &dispose drop ]
204 [ handle>> shutdown ]
208 GENERIC: underlying-port ( stream -- port )
210 M: port underlying-port ;
212 M: encoder underlying-port stream>> underlying-port ;
214 M: decoder underlying-port stream>> underlying-port ;
216 GENERIC: underlying-handle ( stream -- handle )
218 M: object underlying-handle underlying-port handle>> ;
220 ! Fast-path optimization
221 USING: hints strings io.encodings.utf8 io.encodings.ascii
222 io.encodings.private ;
224 HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
226 HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;