/
ports.factor
176 lines (133 loc) · 4.5 KB
/
ports.factor
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel io sequences io.buffers io.timeouts generic
byte-vectors system io.encodings math.order io.backend
continuations classes byte-arrays namespaces splitting
grouping dlists assocs io.encodings.binary summary accessors
destructors combinators ;
IN: io.ports
SYMBOL: default-buffer-size
64 1024 * default-buffer-size set-global
TUPLE: port handle timeout disposed ;
M: port timeout timeout>> ;
M: port set-timeout (>>timeout) ;
: <port> ( handle class -- port )
new swap >>handle ; inline
TUPLE: buffered-port < port { buffer buffer } ;
: <buffered-port> ( handle class -- port )
<port>
default-buffer-size get <buffer> >>buffer ; inline
TUPLE: input-port < buffered-port ;
: <input-port> ( handle -- input-port )
input-port <buffered-port> ;
HOOK: (wait-to-read) io-backend ( port -- )
: wait-to-read ( port -- eof? )
dup buffer>> buffer-empty? [
dup (wait-to-read) buffer>> buffer-empty?
] [ drop f ] if ; inline
M: input-port stream-read1
dup check-disposed
dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline
: read-step ( count port -- byte-array/f )
dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ;
M: input-port stream-read-partial ( max stream -- byte-array/f )
dup check-disposed
[ 0 max >integer ] dip read-step ;
: read-loop ( count port accum -- )
pick over length - dup 0 > [
pick read-step dup [
over push-all read-loop
] [
2drop 2drop
] if
] [
2drop 2drop
] if ;
M: input-port stream-read
dup check-disposed
[ 0 max >fixnum ] dip
2dup read-step dup [
pick over length > [
pick <byte-vector>
[ push-all ] keep
[ read-loop ] keep
B{ } like
] [ 2nip ] if
] [ 2nip ] if ;
: read-until-step ( separators port -- string/f separator/f )
dup wait-to-read [ 2drop f f ] [ buffer>> buffer-until ] if ;
: read-until-loop ( seps port buf -- separator/f )
2over read-until-step over [
[ over push-all ] dip dup [
[ 3drop ] dip
] [
drop read-until-loop
] if
] [
[ 2drop 2drop ] dip
] if ;
M: input-port stream-read-until ( seps port -- str/f sep/f )
2dup read-until-step dup [ [ 2drop ] 2dip ] [
over [
drop
BV{ } like [ read-until-loop ] keep B{ } like swap
] [ [ 2drop ] 2dip ] if
] if ;
TUPLE: output-port < buffered-port ;
: <output-port> ( handle -- output-port )
output-port <buffered-port> ;
: wait-to-write ( len port -- )
[ nip ] [ buffer>> buffer-capacity <= ] 2bi
[ drop ] [ stream-flush ] if ; inline
M: output-port stream-write1
dup check-disposed
1 over wait-to-write
buffer>> byte>buffer ; inline
M: output-port stream-write
dup check-disposed
over length over buffer>> size>> > [
[ buffer>> size>> <groups> ]
[ [ stream-write ] curry ] bi
each
] [
[ [ length ] dip wait-to-write ]
[ buffer>> >buffer ] 2bi
] if ;
HOOK: (wait-to-write) io-backend ( port -- )
GENERIC: shutdown ( handle -- )
M: object shutdown drop ;
: port-flush ( port -- )
dup buffer>> buffer-empty?
[ drop ] [ dup (wait-to-write) port-flush ] if ;
M: output-port stream-flush ( port -- )
[ check-disposed ] [ port-flush ] bi ;
M: output-port dispose*
[
{
[ handle>> &dispose drop ]
[ buffer>> &dispose drop ]
[ port-flush ]
[ handle>> shutdown ]
} cleave
] with-destructors ;
M: buffered-port dispose*
[ call-next-method ] [ buffer>> dispose ] bi ;
M: port cancel-operation handle>> cancel-operation ;
M: port dispose*
[
[ handle>> &dispose drop ]
[ handle>> shutdown ]
bi
] with-destructors ;
GENERIC: underlying-port ( stream -- port )
M: port underlying-port ;
M: encoder underlying-port stream>> underlying-port ;
M: decoder underlying-port stream>> underlying-port ;
GENERIC: underlying-handle ( stream -- handle )
M: object underlying-handle underlying-port handle>> ;
! Fast-path optimization
USING: hints strings io.encodings.utf8 io.encodings.ascii
io.encodings.private ;
HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;
HINTS: encoder-write { string output-port utf8 } { string output-port ascii } ;