1 <DEFINE X$DISK-OPEN DO (STYPE:ATOM OPR NAME:STRING MODS:STRING
2 "OPTIONAL" (BYTES:STRING "ASCII")
3 (BUF?:<OR ATOM FALSE> T) (THAWED? <>) (NO-REF? <>)
4 "AUX" (NEW?:<OR ATOM FALSE> <>) (APP?:<OR ATOM FALSE> <>)
5 MODE:FIX JFN:<OR FIX FALSE> BINARY?:<OR ATOM FALSE>
6 (BYTE?:<OR ATOM FALSE> <>) NNAME:STRING PTR:FIX
7 (STOR:<PRIMTYPE VECTOR> <ITUPLE 5 <>>)
9 ; "THAWED? and NO-REF? are no-ops, due to the lossages of unix"
10 <COND (<=? .MODS "READ">
12 <SET STATUS <ORB .STATUS ,STATUS-READ>>)
15 <SET STATUS <ORB ,STATUS-NEW ,STATUS-WRITE ,STATUS-RACC>>
16 <SET MODE <+ ,O-RDWR ,O-CREAT ,O-EXCL>>)
18 <SET STATUS <ORB ,STATUS-WRITE ,STATUS-RACC>>
22 <SET STATUS ,STATUS-WRITE>
23 <SET MODE <+ ,O-RDWR ,O-APPEND>>)
25 <ERROR %<P-E "ILLEGAL-MODE"> .MODS X$DISK-OPEN>)>
26 <COND (<=? .BYTES "ASCII">
28 <SET STATUS <PUTLHW .STATUS ,BS-ASCII>>)
32 <SET STATUS <PUTLHW .STATUS ,BS-8BIT>>)
34 <SET STATUS <PUTLHW .STATUS ,BS-BINARY>>
37 <ERROR %<P-E "ILLEGAL-BYTE-SIZE"> .BYTES X$DISK-OPEN>)>
38 <SET NAME <T$PARSE-FILE-NAME .NAME <> T .STOR>>
42 <CALL SYSCALL OPEN .NAME .MODE
43 %<ORB ,FM-OWN-READ ,FM-OWN-WRITE
44 ,FM-GRP-READ ,FM-GRP-WRITE
45 ,FM-OTHER-READ ,FM-OTHER-WRITE>>>>
46 ; "Try to make shiny new file; come here if failed"
47 <COND (<==? <1 .JFN> ,EEXIST>
48 ; "Failed because file already exists"
49 <SET NNAME <I$MAKE-BACKUP-NAME .NAME>>
50 <CALL SYSCALL RENAME .NAME .NNAME>
51 <SET STATUS <ORB .STATUS ,STATUS-RENAME>>
52 <SET JFN <CALL SYSCALL OPEN .NAME
54 %<ORB ,FM-OWN-READ ,FM-OWN-WRITE
55 ,FM-OWN-XCT ,FM-GRP-READ
56 ,FM-GRP-WRITE ,FM-GRP-XCT
57 ,FM-OTHER-READ ,FM-OTHER-WRITE
62 <SET JFN <CALL SYSCALL OPEN .NAME .MODE 0>>>
69 <SET PTR <CALL SYSCALL LSEEK .JFN 0 ,WHENCE-EOF>>
71 ; "If appending in binary mode, maybe fill
72 last word of file out with 0's."
73 <COND (<NOT <0? <MOD .PTR ,BYTES/WORD>>>
74 <CALL SYSCALL WRITE .JFN
75 %<ISTRING ,BYTES/WORD <ASCII 0>>
77 <MOD .PTR ,BYTES/WORD>>>)>
78 <SET PTR </ <+ .PTR <- ,BYTES/WORD 1>>
85 <T$REQUEST-BUFFER <> <COND (.BINARY? UVECTOR)
95 <DEFINE I$MAKE-BACKUP-NAME (NAME:STRING "AUX" NNAME:STRING TN:STRING NLEN:FIX)
96 <SET TN <OR <REST <I$BMEMQ !\/ .NAME>> .NAME>>
97 <SET NLEN <MIN %<+ ,MAXNAMLEN 1> <+ <LENGTH .TN> %<LENGTH ".bak">>>>
98 <SET NNAME <ISTRING <+ <- <LENGTH .NAME> <LENGTH .TN>> .NLEN>>>
99 <SUBSTRUC .NAME 0 <LENGTH .NAME> .NNAME>
100 <SET TN <REST .NNAME <- <LENGTH .NNAME> %<+ <LENGTH ".bak"> 1>>>>
101 <SUBSTRUC ".bak" 0 4 .TN>
102 <PUT .NNAME <LENGTH .NNAME> <ASCII 0>>>
104 <DEFINE X$DISK-FILE-HANDLE (CHANNEL:T$CHANNEL OPR
105 "AUX" (DATA:I$DISK-CHANNEL
106 <T$CHANNEL-DATA .CHANNEL>))
109 <DEFINE X$DISK-QUERY (CHANNEL OPR BIT "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
110 #DECL ((CHANNEL) T$CHANNEL (BIT) FIX (DATA) I$DISK-CHANNEL)
111 <COND (<==? .BIT ,T$BIT-ACCESS>
114 <DEFINE X$DISK-CLOSE (CHANNEL OPER "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
115 #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
116 <I$FLUSH-BUFFER .DATA>
117 <COND (<NS-BUF .DATA>
118 <T$RELEASE-BUFFER <NS-BUF .DATA>>)>
119 <CALL SYSCALL CLOSE <NS-JFN .DATA>>
122 <DEFINE X$DISK-READ-BYTE (CHANNEL OPER
123 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>)
124 (BUF <NS-BUF .DATA>) (PT <ANDB <CALL TYPE .BUF> ,M$$TYSAT>)
126 #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL
127 (BUF) <OR BYTES STRING FALSE UVECTOR> (BC) FIX)
130 <X$DISK-READ-BUFFER .CHANNEL .OPER
132 <COND (<NS-BINARY? .DATA>
139 #DECL ((ONCE?) <OR ATOM FALSE>)
140 <COND (<NOT <0? <SET BC <NS-BC .DATA>>>>
142 <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
143 <NS-BUF .DATA <CASE ,==? .PT
145 <REST <CHTYPE .BUF STRING>>)
147 <REST <CHTYPE .BUF UVECTOR>>)
149 <REST <CHTYPE .BUF BYTES>>)>>
150 <NS-BC .DATA <- .BC 1>>
153 (<I$READ-BUFFER .DATA>
154 <SET BUF <NS-BUF .DATA>>
158 <DEFINE I$READ-BUFFER (DATA
159 "AUX" (JFN <NS-JFN .DATA>) CT (OB <NS-BUF .DATA>)
160 (BUF <NS-TBUF .DATA>)
162 #DECL ((DATA) I$DISK-CHANNEL (STS CT) <OR FIX FALSE> (JFN) FIX
163 (OB BUF) <OR BYTES UVECTOR STRING>)
164 <COND (<NS-WRITE-BUF? .DATA> <I$FLUSH-BUFFER .DATA>)>
165 <COND (<NOT <SET CT <CALL SYSCALL READ .JFN .BUF
166 <COND (<TYPE? .BUF STRING><LENGTH .BUF>)
167 (<TYPE? .BUF BYTES> <LENGTH .BUF>)
168 (<* ,BYTES/WORD <LENGTH .BUF>>)>>>>
169 <ERROR %<P-E "ERROR-ON-READ"> .CT I$READ-BUFFER>)>
170 <COND (<NS-BINARY? .DATA>
171 <SET CT </ <+ .CT <- ,BYTES/WORD 1>> ,BYTES/WORD>>)>
173 <NS-SPTR .DATA <+ <NS-SPTR .DATA> .CT>>
177 <DEFINE X$DISK-READ-BUFFER (CHANNEL OPER BUFFER
180 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>)
181 (IBUF <NS-BUF .DATA>) (TIBUF <NS-TBUF .DATA>)
182 (TRANS 0) BC RD RTRANS
183 (PT <ANDB <CALL TYPE .BUFFER> ,M$$TYSAT>))
184 #DECL ((CHANNEL) T$CHANNEL (BUFFER) <OR <PRIMTYPE BYTES>
188 (DATA) I$DISK-CHANNEL (IBUF) <OR BYTES STRING UVECTOR FALSE>
189 (BC) FIX (RD TRANS) <OR FIX FALSE>)
190 <COND (<AND .IBUF <N==? <ANDB <CALL TYPE .IBUF> ,M$$TYSAT> .PT>>
191 ; "Can't use buffer, since wrong type"
193 <I$FLUSH-BUFFER .DATA>)>
194 <COND (<NOT <ASSIGNED? CT>>
195 <SET CT <CASE ,==? .PT
196 (,M$$T-STR <LENGTH <CHTYPE .BUFFER STRING>>)
197 (,M$$T-UVC <LENGTH <CHTYPE .BUFFER UVECTOR>>)
198 (,M$$T-BYT <LENGTH <CHTYPE .BUFFER BYTES>>)>>)>
202 (<AND .IBUF <NOT <0? <SET BC <NS-BC .DATA>>>>>
203 <SET TRANS <MIN .BC .CT>>
206 <SUBSTRUC .IBUF:<PRIMTYPE STRING>
207 0 .TRANS .BUFFER:<PRIMTYPE STRING>>
208 <NS-BUF .DATA <REST .IBUF:<PRIMTYPE STRING> .TRANS>>
209 <SET BUFFER <REST .BUFFER:<PRIMTYPE STRING> .TRANS>>)
211 <SUBSTRUC .IBUF:<PRIMTYPE BYTES>
212 0 .TRANS .BUFFER:<PRIMTYPE BYTES>>
213 <NS-BUF .DATA <REST .IBUF:<PRIMTYPE BYTES> .TRANS>>
214 <SET BUFFER <REST .BUFFER:<PRIMTYPE BYTES> .TRANS>>)
216 <SUBSTRUC .IBUF:<PRIMTYPE UVECTOR>
217 0 .TRANS .BUFFER:<PRIMTYPE UVECTOR>>
218 <NS-BUF .DATA <REST .IBUF:<PRIMTYPE UVECTOR> .TRANS>>
219 <SET BUFFER <REST .BUFFER:<PRIMTYPE UVECTOR> .TRANS>>)>)>
220 <SET RD <+ .RD .TRANS>>
221 <SET CT <- .CT .TRANS>>
222 <NS-BC .DATA <- .BC .TRANS>>
223 <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
224 <COND (<NOT <0? .CT>>
225 ;"Only use the buffer here if it might save a system call"
227 <L? .CT <CASE ,==? .PT
229 <LENGTH <CHTYPE .TIBUF
232 <LENGTH <CHTYPE .TIBUF
235 <LENGTH <CHTYPE .TIBUF
237 <I$READ-BUFFER .DATA>
238 <COND (<0? <NS-BC .DATA>>
240 <SET IBUF <NS-BUF .DATA>>)
250 <SET TRANS </ <+ .TRANS <- ,BYTES/WORD 1>>
252 <COND (<NS-BINARY? .DATA>
253 <SET RTRANS .TRANS>)>)>
254 <NS-PTR .DATA <+ <NS-PTR .DATA> .RTRANS>>
255 <NS-SPTR .DATA <+ <NS-SPTR .DATA> .RTRANS>>
256 ; "Don't get ACCESS confused--make sure he
257 knows there's nothing in the channel buffer
260 <COND (.IBUF <NS-BUF .DATA .TIBUF>)>
261 <RETURN <+ .TRANS .RD>>)
265 <DEFINE X$DISK-WRITE-BYTE (CHANNEL OPER BYTE
266 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>)
267 (BUF <NS-BUF .DATA>) (PT <ANDB <CALL TYPE .BUF>
269 (TBUF <NS-TBUF .DATA>))
270 #DECL ((CHANNEL) T$CHANNEL (BYTE) <OR FIX CHARACTER>
271 (DATA) I$DISK-CHANNEL
272 (BUF) <OR FALSE BYTES STRING UVECTOR>)
273 <COND (<0? <ANDB <NS-MODE .DATA> ,O-RDWR>>
274 <ERROR %<P-E "CHANNEL-NOT-OPEN-FOR-WRITING">
275 .CHANNEL X$DISK-WRITE-BYTE>)>
277 <COND (<NS-BINARY? .DATA>
283 <CALL SYSCALL WRITE <NS-JFN .DATA> .BUF
284 <COND (<TYPE? .BUF UVECTOR>
287 <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
288 <NS-SPTR .DATA <+ <NS-SPTR .DATA> 1>>
291 <COND (<CASE ,==? .PT
292 (,M$$T-STR <EMPTY? .BUF:<PRIMTYPE STRING>>)
293 (,M$$T-BYT <EMPTY? .BUF:<PRIMTYPE BYTES>>)
294 (,M$$T-UVC <EMPTY? .BUF:<PRIMTYPE UVECTOR>>)>
295 <I$FLUSH-BUFFER .DATA>
296 <SET BUF <NS-BUF .DATA>>)>
299 <1 .BUF:<PRIMTYPE STRING> .BYTE>
300 <NS-BUF .DATA <SET BUF <REST .BUF:<PRIMTYPE STRING>>>>
304 .TBUF:<PRIMTYPE STRING>>
305 <LENGTH .BUF:<PRIMTYPE STRING>>>>>)
307 <1 .BUF:<PRIMTYPE BYTES> .BYTE>
308 <NS-BUF .DATA <SET BUF <REST .BUF:<PRIMTYPE BYTES>>>>
312 .TBUF:<PRIMTYPE BYTES>>
313 <LENGTH .BUF:<PRIMTYPE BYTES>>>>>)
315 <1 .BUF:<PRIMTYPE UVECTOR> .BYTE>
316 <NS-BUF .DATA <SET BUF <REST .BUF:<PRIMTYPE UVECTOR>>>>
320 .TBUF:<PRIMTYPE UVECTOR>>
321 <LENGTH .BUF:<PRIMTYPE UVECTOR>>>>>)>
322 <NS-PTR .DATA <+ <NS-PTR .DATA> 1>>
323 <NS-WRITE-BUF? .DATA T>
324 <NS-BC .DATA <MAX 0 <- <NS-BC .DATA> 1>>>
327 <DEFINE I$FLUSH-BUFFER (DATA
328 "AUX" (BUF <NS-BUF .DATA>) LEN SP (JFN <NS-JFN .DATA>)
329 (PT <ANDB <CALL TYPE .BUF> ,M$$TYSAT>) TB)
330 #DECL ((DATA) I$DISK-CHANNEL (BUF) <OR BYTES UVECTOR STRING FALSE>
332 <COND (<NS-WRITE-BUF? .DATA>
333 <NS-WRITE-BUF? .DATA <>>
335 <SET SP <- <NS-PTR .DATA>
337 (,M$$T-STR <- <LENGTH
339 <NS-TBUF .DATA>:STRING>>
341 .BUF:<PRIMTYPE STRING>>>)
345 <NS-TBUF .DATA>:BYTES>>
346 <LENGTH .BUF:<PRIMTYPE BYTES>>>)
350 <NS-TBUF .DATA>:UVECTOR>>
351 <LENGTH .BUF:<PRIMTYPE UVECTOR>>>)>>>
352 <COND (<N==? <NS-SPTR .DATA> .SP>
353 <COND (<NS-BINARY? .DATA>
354 <CALL SYSCALL LSEEK .JFN
357 (<CALL SYSCALL LSEEK .JFN
359 <NS-SPTR .DATA .SP>)>
360 <SET LEN <NS-OBC .DATA>>
361 <COND (<N==? .PT ,M$$T-UVC>
362 <CALL SYSCALL WRITE .JFN .TB .LEN>)
363 (<CALL SYSCALL WRITE .JFN .TB
364 <* .LEN ,BYTES/WORD>>)>
365 <SET SP <+ .LEN <NS-SPTR .DATA>>>
366 <COND (<N==? .SP <NS-PTR .DATA>>
367 <SET SP <NS-PTR .DATA>>
369 <CALL SYSCALL LSEEK .JFN
370 <COND (<NS-BINARY? .DATA>
373 (<NS-SPTR .DATA .SP>)>
378 <COND (<N==? <NS-PTR .DATA> <NS-SPTR .DATA>>
379 <CALL SYSCALL LSEEK .JFN
380 <COND (<NS-BINARY? .DATA>
381 <* ,BYTES/WORD <NS-PTR .DATA>>)
384 <NS-SPTR .DATA <NS-PTR .DATA>>
387 <COND (.BUF <NS-BUF .DATA <NS-TBUF .DATA>>)>)>>
389 <DEFINE X$DISK-WRITE-BUFFER (CHANNEL OPER BUFFER
391 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) RVAL
392 (IBUF <NS-BUF .DATA>) (JFN <NS-JFN .DATA>)
393 VAL TIB (PT <ANDB <CALL TYPE .BUFFER> ,M$$TYSAT>))
394 #DECL ((CHANNEL) T$CHANNEL (BUFFER) <OR <PRIMTYPE UVECTOR> <PRIMTYPE STRING>
397 (DATA) I$DISK-CHANNEL (IBUF) <OR BYTES UVECTOR STRING FALSE>
398 (VAL) <OR FALSE FIX> (TIB) FIX)
399 <COND (<0? <ANDB <NS-MODE .DATA> ,O-RDWR>>
400 <ERROR %<P-E "CHANNEL-NOT-OPEN-FOR-WRITING">
401 .CHANNEL X$DISK-WRITE-BYTE>)>
402 <COND (<NOT <ASSIGNED? LEN>>
406 <LENGTH .BUFFER:<PRIMTYPE STRING>>)
408 <LENGTH .BUFFER:<PRIMTYPE BYTES>>)
410 <LENGTH .BUFFER:<PRIMTYPE UVECTOR>>)>>)>
411 <COND (<OR <NOT .IBUF>
412 <N==? .PT <ANDB <CALL TYPE .IBUF> ,M$$TYSAT>>>
414 <I$FLUSH-BUFFER .DATA>)>
415 <COND (<SET VAL <CALL SYSCALL WRITE .JFN .BUFFER
416 <COND (<==? .PT 6> <* ,BYTES/WORD .LEN>)
420 ; "If we wrote out a uvector, get length right"
421 <SET VAL </ .VAL ,BYTES/WORD>>
422 <COND (<NS-BINARY? .DATA>
423 ; "but if not a binary channel, pointer
424 will still be in characters instead
427 <NS-PTR .DATA <+ <NS-PTR .DATA> .RVAL>>
428 <NS-SPTR .DATA <+ <NS-SPTR .DATA> .RVAL>>)>)
432 <SET TIB <LENGTH <NS-TBUF .DATA>:STRING>>)
434 <SET TIB <LENGTH <NS-TBUF .DATA>:BYTES>>)
436 <SET TIB <LENGTH <NS-TBUF .DATA>:UVECTOR>>)>
437 <REPEAT ((RD 0) TRANS (IBUF .IBUF) IL)
438 #DECL ((RD TRANS) FIX (IBUF) <OR BYTES STRING UVECTOR>)
439 <SET IL <CALL LENU .IBUF>>
440 <COND (<AND <NOT <AND <==? .IL .TIB>
442 ; "If buffer is empty, and long transfer,
443 don't put any of it in buffer"
446 <EMPTY? .IBUF:<PRIMTYPE STRING>>)
448 <EMPTY? .IBUF:<PRIMTYPE BYTES>>)
450 <EMPTY? .IBUF:<PRIMTYPE UVECTOR>>)>>>
453 <SET TRANS <MIN .LEN .IL>>
454 <SUBSTRUC .BUFFER:<PRIMTYPE STRING> 0
455 .TRANS .IBUF:<PRIMTYPE STRING>>
457 <REST .BUFFER:<PRIMTYPE STRING> .TRANS>>
460 .IBUF:<PRIMTYPE STRING>
463 <SET TRANS <MIN .LEN .IL>>
464 <SUBSTRUC .BUFFER:<PRIMTYPE BYTES> 0 .TRANS
465 .IBUF:<PRIMTYPE BYTES>>
466 <SET BUFFER <REST .BUFFER:<PRIMTYPE BYTES>
469 <SET IBUF <REST .IBUF:<PRIMTYPE BYTES>
472 <SET TRANS <MIN .LEN .IL>>
473 <SUBSTRUC .BUFFER:<PRIMTYPE UVECTOR> 0 .TRANS
474 .IBUF:<PRIMTYPE UVECTOR>>
475 <SET BUFFER <REST .BUFFER:<PRIMTYPE UVECTOR>
479 .IBUF:<PRIMTYPE UVECTOR>
481 <SET RD <+ .RD .TRANS>>
482 <SET LEN <- .LEN .TRANS>>
483 <NS-WRITE-BUF? .DATA T>
485 <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
486 <NS-BC .DATA <MAX 0 <- <NS-BC .DATA> .TRANS>>>
490 <COND (<NOT <0? .LEN>>
491 <COND (<N==? .IL .TIB> <I$FLUSH-BUFFER .DATA>)>
492 <COND (<G=? .LEN .TIB>
494 <CALL SYSCALL WRITE .JFN .BUFFER
495 <COND (<NS-BINARY? .DATA>
496 <* ,BYTES/WORD .LEN>)
498 <COND (<NS-BINARY? .DATA>
499 <SET TRANS </ .TRANS ,BYTES/WORD>>)>
500 <NS-SPTR .DATA <+ <NS-SPTR .DATA> .TRANS>>
501 <NS-PTR .DATA <+ <NS-PTR .DATA> .TRANS>>
502 <RETURN <+ .TRANS .RD>>)
503 (<SET IBUF <NS-BUF .DATA>>)>)
506 <DEFINE X$DISK-ACCESS (CHANNEL OPER "OPTIONAL" PTR
507 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) (JFN <NS-JFN .DATA>)
508 (OPTR <NS-PTR .DATA>) (BUF <NS-BUF .DATA>) INC TL L
509 (PT <ANDB <CALL TYPE .BUF> ,M$$TYSAT>) TB)
510 #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL
511 (TL L OPTR JFN INC) FIX (PTR) <OR FIX FALSE>)
515 <SET L <LENGTH <CHTYPE .BUF STRING>>>
516 <SET TL <LENGTH <SET TB <CHTYPE <NS-TBUF .DATA>
519 <SET L <LENGTH <CHTYPE .BUF BYTES>>>
520 <SET TL <LENGTH <SET TB <CHTYPE <NS-TBUF .DATA>
523 <SET L <LENGTH <CHTYPE .BUF UVECTOR>>>
525 <SET TB <CHTYPE <NS-TBUF .DATA> UVECTOR>>>>)>)>
526 <COND (<OR <NOT <ASSIGNED? PTR>>
531 <G=? .PTR <- .OPTR <- .TL .L>>>
532 <L=? .PTR <+ .OPTR <NS-BC .DATA>>>>
533 <COND (<G? .PTR .OPTR>
534 <NS-BC .DATA <- <NS-BC .DATA> <SET INC <- .PTR .OPTR>>>>
537 <NS-BUF .DATA <REST <CHTYPE .BUF STRING> .INC>>)
539 <NS-BUF .DATA <REST <CHTYPE .BUF BYTES> .INC>>)
542 <REST <CHTYPE .BUF UVECTOR> .INC>>)>)
544 <NS-BUF .DATA <CALL BACKU .BUF <SET INC <- .OPTR .PTR>>>>
545 <NS-BC .DATA <+ <NS-BC .DATA> .INC>>)>
548 <I$FLUSH-BUFFER .DATA>
551 <CALL SYSCALL LSEEK .JFN 0 ,WHENCE-EOF>)
553 .JFN <COND (<NS-BINARY? .DATA>
554 <* ,BYTES/WORD .PTR>)
557 <COND (<NS-BINARY? .DATA>
558 <SET PTR </ .PTR ,BYTES/WORD>>)>
560 <NS-SPTR .DATA .PTR>)>
563 <DEFINE X$DISK-BUFOUT (CHANNEL OPER "OPTIONAL" (FORCE? T)
564 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
565 #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL
566 (FORCE?) <OR ATOM FALSE>)
567 <COND (<NS-WRITE-BUF? .DATA>
568 <I$FLUSH-BUFFER .DATA>
569 <CALL SYSCALL FSYNC <NS-JFN .DATA>>)>>
571 <DEFINE X$DISK-FILE-LENGTH (CHANNEL OPER
572 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>))
573 #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
574 <T$GET-BYTE-COUNT <NS-JFN .DATA> <NS-BINARY? .DATA>>>
576 <DEFINE X$DISK-PRINT-DATA (CHANNEL OPER OUTCHAN
577 "AUX" (DATA <T$CHANNEL-DATA .CHANNEL>) BUF)
578 #DECL ((CHANNEL) T$CHANNEL (DATA) I$DISK-CHANNEL)
579 <PRINC "#DISK-CHANNEL [">
581 <PRIN1 <NS-JFN .DATA>>
583 <PRIN1 <NS-MODE .DATA>>
585 <PRIN1 <NS-BINARY? .DATA>>
587 <PRIN1 <NS-PTR .DATA>>
589 <PRIN1 <NS-SPTR .DATA>>
591 <COND (<SET BUF <NS-BUF .DATA>>
592 <PRIN1 <NS-BC .DATA>>
594 <COND (<TYPE? .BUF STRING>
595 <PRIN1 <- <LENGTH <NS-TBUF .DATA>>
596 <LENGTH <NS-BUF .DATA>>>>
598 <PRIN1 <LENGTH <NS-BUF .DATA>>>)
599 (<PRIN1 <- <LENGTH <NS-TBUF .DATA>>
600 <LENGTH <NS-BUF .DATA>>>>
602 <PRIN1 <LENGTH <NS-BUF .DATA>>>)>)
608 <DEFINE X$DISK-FLUSH (CHN OPER "AUX" (DAT <T$CHANNEL-DATA .CHN>)
609 (JFN <NS-JFN .DAT>) (STATUS <NS-STATUS .DAT>)
611 #DECL ((CHN) T$CHANNEL (DAT) I$DISK-CHANNEL)
613 <T$RELEASE-BUFFER <NS-BUF .DAT>>)>
614 <COND (<0? <ANDB .STATUS ,STATUS-NO-FLUSH>>
615 <COND (<CALL SYSCALL CLOSE .JFN>
616 <COND (<NOT <0? <ANDB .STATUS ,STATUS-NEW>>>
617 <SET ONM <T$STANDARD-NAME <I$DEF-NAME .CHN .OPER>>>
618 <CALL SYSCALL UNLINK .ONM>
619 <COND (<NOT <0? <ANDB .STATUS ,STATUS-RENAME>>>
620 <SET BCKNM <I$MAKE-BACKUP-NAME .ONM>>
621 <CALL SYSCALL LINK .BCKNM .ONM>
622 <CALL SYSCALL UNLINK .BCKNM>)