3 <ENTRY TS-RJFN TS-MODE TS-BSZ TS-RBUF TS-RBC TS-WJFN TS-WBUF
4 TS-WBC TS-EXTRA TWAY-READ-BYTE TWAY-READ-BUFFER TWAY-WRITE-BUFFER
5 TWAY-WRITE-BYTE TTY-CHANNEL DUMP-WRITE-BUFFER TWAY-BUFOUT>
7 <NEW-CHANNEL-TYPE TWAY DEFAULT
10 READ-BYTE TWAY-READ-BYTE
11 FILL-READ-BUFFER TWAY-FILL-READ
12 WRITE-BYTE TWAY-WRITE-BYTE
13 READ-BUFFER TWAY-READ-BUFFER
14 WRITE-BUFFER TWAY-WRITE-BUFFER
16 PRINT-DATA TWAY-PRINT-DATA>
18 <MSETG TS-RJFN %<OFFSET 1 '<OR TTY-CHANNEL TWAY-BASE>>>
19 <MSETG TS-MODE %<OFFSET 2 '<OR TTY-CHANNEL TWAY-BASE>>>
20 <MSETG TS-BSZ %<OFFSET 3 '<OR TTY-CHANNEL TWAY-BASE>>>
21 <MSETG TS-RBUF %<OFFSET 4 '<OR TTY-CHANNEL TWAY-BASE>>>
22 <MSETG TS-RBC %<OFFSET 5 '<OR TTY-CHANNEL TWAY-BASE>>>
23 <MSETG TS-WJFN %<OFFSET 6 '<OR TTY-CHANNEL TWAY-BASE>>>
24 <MSETG TS-WBUF %<OFFSET 7 '<OR TTY-CHANNEL TWAY-BASE>>>
25 <MSETG TS-WBC %<OFFSET 8 '<OR TTY-CHANNEL TWAY-BASE>>>
26 <MSETG TS-EXTRA %<OFFSET 9 '<OR TTY-CHANNEL TWAY-BASE>>>
28 ;"<NEWSTRUC TWAY-CHANNEL (VECTOR)
32 TS-RBUF <OR FALSE STRING UVECTOR>
34 TS-WJFN <OR FIX FALSE>
35 TS-WBUF <OR FALSE STRING UVECTOR>
40 <NEWSTRUC TWAY-BASE VECTOR
44 TB-RBUF <OR FALSE STRING UVECTOR>
46 TB-WJFN <OR FIX FALSE>
47 TB-WBUF <OR FALSE STRING UVECTOR>
50 <SETG BUFFERED <UVECTOR %,/DVDSK %,/DVMTA %,/DVLPT %,/DVNUL %,/DVNET>>
52 <GDECL (BUFFERED) <UVECTOR [REST FIX]>>
54 <DEFINE TWAY-OPEN (STYPE OPER NAME MODS
55 "OPTIONAL" (BYTES "ASCII") (OBUF? 1) (IBUF? 1)
56 "AUX" (NEW? <>) MODE RJFN WJFN BSZ (WRITE? <>) (BUF? <>))
57 #DECL ((NAME MODS BYTES) STRING (IBUF? OBUF?) <OR FIX ATOM FALSE>
58 (NEW? BUF?) <OR ATOM FALSE> (MODE BSZ) FIX
59 (RJFN WJFN) <OR FIX FALSE>)
60 <COND (<=? .MODS "READ">
61 <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-EX ,OF-PLN> FIX>>)
65 <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-EX ,OF-PLN> FIX>>)
68 <SET MODE %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-EX ,OF-PLN> FIX>>)
69 (T <ERROR ILLEGAL-MODE .MODS TWAY-OPEN>)>
70 <COND (<=? .BYTES "ASCII"> <SET BSZ 7>)
71 (<=? .BYTES "BINARY"> <SET BSZ 36>)
72 (T <ERROR ILLEGAL-BYTE-SIZE .BYTES TWAY-OPEN>)>
73 <COND (<SET RJFN <GET-JFN .NAME .MODE .BSZ .NEW?>>
74 <COND (<OR <TYPE? .IBUF? FIX> <TYPE? .OBUF? FIX>>
75 <COND (<MEMQ <GET-DEVICE-TYPE .RJFN> ,BUFFERED>
77 <COND (<TYPE? .IBUF? FIX> <SET IBUF? .BUF?>)>
78 <COND (<TYPE? .OBUF? FIX> <SET OBUF? .BUF?>)>)>
82 <COND (.IBUF? <MAKE-BUFFER .BSZ>)>
84 <COND (.WRITE? .RJFN)>
85 <COND (<AND .WRITE? .OBUF?> <MAKE-BUFFER .BSZ>)>
88 <DEFINE MAKE-BUFFER (BSZ)
95 <DEFINE TWAY-READ-BYTE TWB (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
96 (IBUF <TS-RBUF .DATA>) VAL)
97 #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL>
98 (IBUF) <OR FALSE STRING UVECTOR>)
100 <COND (<0? <TS-RBC .DATA>>
101 ; "This allows CHANNELs to do funny buffering without
102 re-inventing the wheel."
103 <COND (<NOT <SET VAL <FCHANNEL-OP .CHANNEL FILL-READ-BUFFER>>>
105 <SET IBUF <TS-RBUF .DATA>>)>
106 <COND (<0? <TS-RBC .DATA>>
110 <TS-RBC .DATA <- <TS-RBC .DATA> 1>>
111 <TS-RBUF .DATA <REST .IBUF>>
114 <COND (<SET VAL <CALL SYSOP BIN <TS-RJFN .DATA> '(RETURN 2)>>
115 <COND (<==? <TS-BSZ .DATA> 7> <CHTYPE .VAL CHARACTER>)
118 <DEFINE TWAY-FILL-READ (CHANNEL OPER
119 "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
120 (JFN <TS-RJFN .DATA>) (BUF <TOP <TS-RBUF .DATA>>)
122 #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL> (JFN) FIX
123 (BUF) <OR STRING UVECTOR> (CT) <OR FIX FALSE>)
124 <COND (<SET NB <CALL SYSOP SIN-JSYS .JFN .BUF
125 <- <SET CT <LENGTH .BUF>>>>>
126 <SET CT <- .CT <LENGTH .NB>>>
131 <DEFINE TWAY-READ-BUFFER (CHANNEL OPER BUF "OPTIONAL" (LEN <LENGTH .BUF>)
133 "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
134 (IBUF <TS-RBUF .DATA>) BC)
135 #DECL ((CHANNEL) CHANNEL (BUF) <OR STRING UVECTOR> (BC LEN CONT) FIX
136 (DATA) <OR TWAY-BASE TTY-CHANNEL> (IBUF) <OR FALSE STRING UVECTOR>)
137 <SET LEN <MIN .LEN <CALL LENU .BUF>:FIX>>
139 <COND (<SET IBUF <CALL SYSOP SIN-JSYS <TS-RJFN .DATA>
140 <REST .BUF .CONT> <- <SET BC <- .LEN .CONT>>>>>
141 <SET BC <- .BC <LENGTH .IBUF>>>
144 <COND (<N==? <PRIMTYPE .IBUF> <PRIMTYPE .BUF>>
145 <ERROR WRONG-TYPE-BUFFER .BUF TWAY-READ-BUFFER>)>
146 <SET BUF <REST .BUF .CONT>>
147 <SET LEN <- .LEN .CONT>>
148 <REPEAT ((RD .CONT) (TRANS -1))
149 #DECL ((RD) FIX (ONCE?) <OR ATOM FALSE>)
150 <COND (<NOT <0? <SET BC <TS-RBC .DATA>>>>
151 <SET TRANS <MIN .BC .LEN>>
154 <COND (<TYPE? .IBUF STRING>
157 #DECL ((IB B) STRING)
159 <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
161 .IBUF <CHTYPE .BUF STRING>>)
162 (<TYPE? .IBUF UVECTOR>
165 #DECL ((IB B) UVECTOR)
167 <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
169 <CHTYPE .IBUF UVECTOR>
170 <CHTYPE .BUF UVECTOR>>)>>
171 <SET BUF <REST .BUF .TRANS>>
172 <SET RD <+ .TRANS .RD>>
173 <TS-RBUF .DATA <REST .IBUF .TRANS>>
174 <TS-RBC .DATA <- .BC .TRANS>>
175 <SET LEN <- .LEN .TRANS>>)>
176 <COND (<OR <0? .LEN> <0? .TRANS>>
179 <COND (<OR <NOT <FCHANNEL-OP .CHANNEL FILL-READ-BUFFER>>
182 <SET IBUF <TS-RBUF .DATA>>)>>)>>
184 <DEFINE TWAY-WRITE-BYTE (CHANNEL OPER BYTE "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
185 (JFN <TS-WJFN .DATA>) (BUF <TS-WBUF .DATA>))
186 #DECL ((CHANNEL) CHANNEL (BYTE) <OR CHARACTER FIX>
187 (DATA) <OR TWAY-BASE TTY-CHANNEL> (JFN) <OR FALSE FIX>)
189 <ERROR CHANNEL-NOT-OPEN-FOR-WRITING .CHANNEL TWAY-WRITE-BYTE>)>
191 <CALL SYSOP BOUT .JFN <CHTYPE .BYTE FIX> '(RETURN 2)>)
194 <DUMP-WRITE-BUFFER .DATA>
195 <SET BUF <TS-WBUF .DATA>>)>
196 <1 .BUF <COND (<TYPE? .BUF UVECTOR>
198 (<CHTYPE .BYTE CHARACTER>)>>
199 <TS-WBUF .DATA <REST .BUF>>
200 <TS-WBC .DATA <+ <TS-WBC .DATA> 1>>)>
203 <DEFINE DUMP-WRITE-BUFFER (DATA "AUX" VAL BUF)
204 #DECL ((DATA) <OR TWAY-BASE TTY-CHANNEL>)
205 <COND (<NOT <0? <TS-WBC .DATA>>>
206 <COND (<SET VAL <CALL SYSOP SOUT <TS-WJFN .DATA>
207 <SET BUF <CALL TOPU <TS-WBUF .DATA>>>
210 <TS-WBUF .DATA <TOP <TS-WBUF .DATA>>>>
212 <DEFINE TWAY-BUFOUT (CHANNEL OPER "OPTIONAL" (FORCE? T)
213 "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
214 (JFN <TS-WJFN .DATA>) (BC <TS-WBC .DATA>)
215 (BUF <TS-WBUF .DATA>))
216 #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL> (JFN) <OR FALSE FIX>
217 (BC) FIX (BUF) <OR FALSE UVECTOR STRING> (FORCE?) <OR ATOM FALSE>)
219 <COND (<AND .BUF <NOT <0? .BC>>>
220 <DUMP-WRITE-BUFFER .DATA>)>
221 <COND (.FORCE? <CALL SYSOP DOBE .JFN>)>
224 <DEFINE TWAY-WRITE-BUFFER (CHANNEL OPER BUF "OPTIONAL" (LEN <CALL LENU .BUF>)
225 "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
226 (JFN <TS-WJFN .DATA>) (OBUF <TS-WBUF .DATA>))
227 #DECL ((CHANNEL) CHANNEL (BUF) <OR STRING BYTES UVECTOR> (JFN) <OR FIX FALSE>
230 <ERROR CHANNEL-NOT-OPEN-FOR-WRITING .CHANNEL TWAY-WRITE-BUFFER>)>
231 <SET LEN <MIN .LEN <CALL LENU .BUF>:FIX>>
232 <COND (<OR <NOT .OBUF>
233 <N==? <ANDB <CALL TYPE .OBUF> *7*>
234 <ANDB <CALL TYPE .BUF> *7*>>>
236 <DUMP-WRITE-BUFFER .DATA>)>
238 <COND (<SET OBUF <CALL SYSOP SOUT .JFN .BUF <- .LEN>>>
239 <- <CALL LENU .BUF>:FIX <CALL LENU .OBUF>:FIX>)>)
242 <REPEAT ((RD 0) TRANS CT)
243 #DECL ((CT RD TRANS) FIX)
247 <DUMP-WRITE-BUFFER .DATA>
248 <SET OBUF <TS-WBUF .DATA>>)>
250 <SET TRANS <MIN <CALL LENU .OBUF>:FIX .LEN>>
251 <COND (<TYPE? .BUF STRING>
254 #DECL ((B OB) STRING)
256 <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
258 .BUF <CHTYPE .OBUF STRING>>)
261 #DECL ((B OB) UVECTOR)
263 <COND (<G=? <SET CT <+ .CT 1>> .TRANS>
265 <CHTYPE .BUF UVECTOR>
266 <CHTYPE .OBUF UVECTOR>>)>
267 <SET BUF <REST .BUF .TRANS>>
268 <TS-WBUF .DATA <SET OBUF <REST .OBUF .TRANS>>>
269 <TS-WBC .DATA <+ <TS-WBC .DATA> .TRANS>>
270 <SET RD <+ .RD .TRANS>>
271 <SET LEN <- .LEN .TRANS>>>)>>
273 <DEFINE TWAY-CLOSE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
274 #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL>)
275 <COND (<TS-WJFN .DATA>
276 <COND (<TS-WBUF .DATA>
277 <DUMP-WRITE-BUFFER .DATA>)>
278 <CALL SYSOP CLOSF <TS-WJFN .DATA>>)>
279 <COND (<N==? <TS-RJFN .DATA> <TS-WJFN .DATA>>
280 <CALL SYSOP CLOSF <TS-RJFN .DATA>>)>
284 <DEFINE TWAY-PRINT-DATA (CHANNEL OPER OUTCHAN
285 "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
286 #DECL ((CHANNEL) CHANNEL (DATA) <OR TWAY-BASE TTY-CHANNEL>)
287 <PRINC "#TWAY-CHANNEL [">
289 <PRINC <TS-RJFN .DATA>>
291 <PRIN1 <TS-MODE .DATA>>
293 <PRIN1 <TS-BSZ .DATA>>
294 <COND (<TS-RBUF .DATA>
296 <PRIN1 <TS-RBC .DATA>>
298 <PRIN1 <LENGTH <TOP <TS-RBUF .DATA>>>>)>
299 <COND (<TS-WJFN .DATA>
301 <PRINC <TS-WJFN .DATA>>
302 <COND (<TS-WBUF .DATA>
304 <PRIN1 <TS-WBC .DATA>>
306 <PRIN1 <LENGTH <TOP <TS-WBUF .DATA>>>>)>)>