From 718d9f988cd29f3a5f301f32c61da9caff5c5fc0 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Sat, 9 Jul 2022 17:08:16 -0700 Subject: [PATCH] Rmk52 fix external format for error stream (#817) * CLSTREAMS: Fix EOL/external format on error stream (synonym and 2-way) #815 * CMLFORMAT: makefile NEW to get functions in filemap * CLSTREAMS: cleanup formats for more types * FILEIO: Add readonly bit in streams for external-format --- sources/CLSTREAMS | 535 +++++++++++++++++++++++++------------ sources/CLSTREAMS.LCOM | Bin 31606 -> 35087 bytes sources/CMLFORMAT | 585 ++++++++++++++++++++++------------------- sources/CMLFORMAT.LCOM | Bin 49608 -> 49610 bytes sources/FILEIO | 122 +++++---- sources/FILEIO.LCOM | Bin 44297 -> 44331 bytes 6 files changed, 748 insertions(+), 494 deletions(-) diff --git a/sources/CLSTREAMS b/sources/CLSTREAMS index ef5e9959..995097be 100644 --- a/sources/CLSTREAMS +++ b/sources/CLSTREAMS @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED " 3-Jul-2022 14:17:13"  -|{DSK}kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;5| 55647 +(FILECREATED " 6-Jul-2022 11:56:07"  +|{DSK}kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;37| 65858 - :CHANGES-TO (FNS %INITIALIZE-CLSTREAM-TYPES) + :CHANGES-TO (FUNCTIONS CL:MAKE-SYNONYM-STREAM CL:MAKE-BROADCAST-STREAM + CL:MAKE-CONCATENATED-STREAM CL:MAKE-TWO-WAY-STREAM CL:MAKE-ECHO-STREAM) - :PREVIOUS-DATE "20-Jan-2022 09:16:52" -|{DSK}kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;4|) + :PREVIOUS-DATE " 5-Jul-2022 23:12:39" +|{DSK}kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;36|) ; Copyright (c) 1985-1988, 1990-1991 by Venue & Xerox Corporation. @@ -48,38 +49,52 @@ (FUNCTIONS %NEW-FILE PREDICT-NAME) (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS))) - (COMS - (* |;;| "methods for the special devices") + + (* |;;| "methods for the special devices") - (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN - %BROADCAST-STREAM-DEVICE-CLOSEFILE %BROADCAST-STREAM-DEVICE-FORCEOUTPUT) + (COMS (* \; "broadcast streams") + (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-CLOSEFILE + %BROADCAST-STREAM-DEVICE-FORCEOUTPUT) (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN) + (FNS %BROADCAST-STREAM-OUTCHARFN)) + (COMS (* \; "Concatenated streams") (FNS %CONCATENATED-STREAM-DEVICE-BIN %CONCATENATED-STREAM-DEVICE-CLOSEFILE %CONCATENATED-STREAM-DEVICE-EOFP %CONCATENATED-STREAM-DEVICE-PEEKBIN %CONCATENATED-STREAM-DEVICE-BACKFILEPTR) - (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN) - (FNS %ECHO-STREAM-DEVICE-BIN) + (FNS %CONCATENATED-STREAM-INCCODEFN %CONCATENATED-STREAM-PEEKCCODEFN + %CONCATENATED-STREAM-BACKCCODEFN) + (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)) + (FNS %ECHO-STREAM-DEVICE-BIN %ECHO-STREAM-INCCODEFN) + (COMS (* \; "Synonym streams") (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM) - (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT - %SYNONYM-STREAM-DEVICE-OUTCHARFN %SYNONYM-STREAM-DEVICE-CLOSEFILE - %SYNONYM-STREAM-DEVICE-EOFP %SYNONYM-STREAM-DEVICE-FORCEOUTPUT - %SYNONYM-STREAM-DEVICE-GETFILEINFO %SYNONYM-STREAM-DEVICE-PEEKBIN - %SYNONYM-STREAM-DEVICE-READP %SYNONYM-STREAM-DEVICE-BACKFILEPTR - %SYNONYM-STREAM-DEVICE-SETFILEINFO %SYNONYM-STREAM-DEVICE-CHARSETFN) + (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT %SYNONYM-STREAM-DEVICE-EOFP + %SYNONYM-STREAM-DEVICE-FORCEOUTPUT %SYNONYM-STREAM-DEVICE-GETFILEINFO + %SYNONYM-STREAM-DEVICE-PEEKBIN %SYNONYM-STREAM-DEVICE-READP + %SYNONYM-STREAM-DEVICE-BACKFILEPTR %SYNONYM-STREAM-DEVICE-SETFILEINFO + %SYNONYM-STREAM-DEVICE-CHARSETFN %SYNONYM-STREAM-DEVICE-CLOSEFILE) + + (* |;;| "helper ") + + (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM) + + (* |;;| "Synonym external format") + + (FNS %SYNONYM-STREAM-OUTCHARFN %SYNONYM-STREAM-INCCODEFN %SYNONYM-STREAM-PEEKCCODEFN + %SYNONYM-STREAM-BACKCCODEFN)) + (COMS (* \; "Two-way streams") + (FNS %TWO-WAY-STREAM-BACKCCODEFN %TWO-WAY-STREAM-INCCODEFN %TWO-WAY-STREAM-OUTCHARFN + %TWO-WAY-STREAM-PEEKCCODEFN) (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM %TWO-WAY-STREAM-DEVICE-OUTCHARFN %TWO-WAY-STREAM-DEVICE-CLOSEFILE %TWO-WAY-STREAM-DEVICE-EOFP %TWO-WAY-STREAM-DEVICE-READP %TWO-WAY-STREAM-DEVICE-BACKFILEPTR %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT - %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN) + %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)) + (COMS (* \; "Fill-pointer streams") (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE %FILL-POINTER-STREAM-DEVICE-GETFILEPTR - ) - (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE - %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE)) - (COMS - (* |;;| "helper stuff") - - (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM)) + )) + (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE + %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE) (COMS (* |;;| "module initialization") @@ -304,16 +319,17 @@ (CL:DEFSETF FILE-STREAM-POSITION SETFILEPTR) -(CL:DEFUN CL:MAKE-SYNONYM-STREAM (CL:SYMBOL) +(CL:DEFUN CL:MAKE-SYNONYM-STREAM (CL:SYMBOL) (* \; "Edited 6-Jul-2022 11:53 by rmk") + (* \; "Edited 3-Jul-2022 22:03 by rmk") - (* |;;| "A CommonLisp function for shadowing a stream. See CLtL p. 329") + (* |;;| "A CommonLisp function for shadowing a stream. See CLtL p. 329 or Steele p 500") (LET ((STREAM (|create| STREAM DEVICE _ %SYNONYM-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL:SYMBOL LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| (CL:SYMBOL-VALUE CL:SYMBOL)) - OUTCHARFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-OUTCHARFN)))) + READONLY-EXTERNALFORMAT _ T))) (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P T) (* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE") @@ -342,20 +358,15 @@ (XCL:FOLLOW-SYNONYM-STREAMS (CL:SYMBOL-VALUE (XCL:SYNONYM-STREAM-SYMBOL STREAM))) STREAM)) -(CL:DEFUN CL:MAKE-BROADCAST-STREAM (&REST STREAMS) - - (* |;;| "CommonLisp function that makes a broadcast stream. See CLtL p329") - - (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) - THEN (LET ((STREAM (|create| STREAM - DEVICE _ %BROADCAST-STREAM-DEVICE - ACCESS _ 'OUTPUT - F1 _ STREAMS - OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN)))) - (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T) - STREAM) - ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) - DO (RETURN STREAM?))))) +(CL:DEFUN CL:MAKE-BROADCAST-STREAM (&REST STREAMS) (* \; "Edited 6-Jul-2022 11:53 by rmk") + (FOR STREAM? IN STREAMS DO (\\GETSTREAM STREAM? 'OUTPUT)) + (LET ((STREAM (|create| STREAM + DEVICE _ %BROADCAST-STREAM-DEVICE + ACCESS _ 'OUTPUT + F1 _ STREAMS + READONLY-EXTERNALFORMAT _ T))) + (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T) + STREAM)) (CL:DEFUN XCL:BROADCAST-STREAM-P (STREAM) @@ -370,19 +381,18 @@ (AND (XCL:BROADCAST-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) -(CL:DEFUN CL:MAKE-CONCATENATED-STREAM (&REST STREAMS) +(CL:DEFUN CL:MAKE-CONCATENATED-STREAM (&REST STREAMS) (* \; "Edited 6-Jul-2022 11:54 by rmk") (* |;;| "CommonLisp function that creates a concatenated stream. See CLtL p. 329") - (IF (FOR STREAM? IN STREAMS ALWAYS (STREAMP STREAM?)) - THEN (LET ((STREAM (|create| STREAM - DEVICE _ %CONCATENATED-STREAM-DEVICE - ACCESS _ 'INPUT - F1 _ STREAMS))) - (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T) - STREAM) - ELSE (\\ILLEGAL.ARG (FOR STREAM? IN STREAMS WHEN (NOT (STREAMP STREAM?)) - DO (RETURN STREAM?))))) + (FOR STREAM? IN STREAMS DO (\\GETSTREAM STREAM? 'INPUT)) + (LET ((STREAM (|create| STREAM + DEVICE _ %CONCATENATED-STREAM-DEVICE + ACCESS _ 'INPUT + F1 _ STREAMS + READONLY-EXTERNALFORMAT _ T))) + (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T) + STREAM)) (CL:DEFUN XCL:CONCATENATED-STREAM-P (STREAM) (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P)) @@ -394,21 +404,21 @@ (AND (XCL:CONCATENATED-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) -(CL:DEFUN CL:MAKE-TWO-WAY-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) +(CL:DEFUN CL:MAKE-TWO-WAY-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) + (* \; "Edited 6-Jul-2022 11:55 by rmk") + (* \; "Edited 4-Jul-2022 00:05 by rmk") (* |;;| "A CommonLisp function for splicing together two streams. See CLtL p. 329") - (CL:UNLESS (STREAMP CL::INPUT-STREAM) - (\\ILLEGAL.ARG CL::INPUT-STREAM)) - (CL:UNLESS (STREAMP CL::OUTPUT-STREAM) - (\\ILLEGAL.ARG CL::OUTPUT-STREAM)) + (CL:SETQ CL::INPUT-STREAM (\\GETSTREAM CL::INPUT-STREAM 'INPUT)) + (CL:SETQ CL::OUTPUT-STREAM (\\GETSTREAM CL::OUTPUT-STREAM 'OUTPUT)) (LET ((STREAM (|create| STREAM DEVICE _ %TWO-WAY-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL::INPUT-STREAM F2 _ CL::OUTPUT-STREAM LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| CL::OUTPUT-STREAM) - OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN)))) + READONLY-EXTERNALFORMAT _ T))) (STREAMPROP STREAM 'XCL:TWO-WAY-STREAM-P T) (* |;;| "save STREAM in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE") @@ -436,21 +446,20 @@ (AND (XCL:TWO-WAY-STREAM-P STREAM) (FETCH (STREAM F1) OF STREAM))) -(CL:DEFUN CL:MAKE-ECHO-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) +(CL:DEFUN CL:MAKE-ECHO-STREAM (CL::INPUT-STREAM CL::OUTPUT-STREAM) + (* \; "Edited 6-Jul-2022 11:54 by rmk") - (* |;;| "A CommonLisp function for making an echo stream. See CLtL p. 329") + (* |;;| "See Steele p 500") - (CL:UNLESS (STREAMP CL::INPUT-STREAM) - (\\ILLEGAL.ARG CL::INPUT-STREAM)) - (CL:UNLESS (STREAMP CL::OUTPUT-STREAM) - (\\ILLEGAL.ARG CL::OUTPUT-STREAM)) + (CL:SETQ CL::INPUT-STREAM (\\GETSTREAM CL::INPUT-STREAM 'INPUT)) + (CL:SETQ CL::OUTPUT-STREAM (\\GETSTREAM CL::OUTPUT-STREAM 'OUTPUT)) (LET ((STREAM (|create| STREAM DEVICE _ %ECHO-STREAM-DEVICE ACCESS _ 'BOTH F1 _ CL::INPUT-STREAM F2 _ CL::OUTPUT-STREAM LINELENGTH _ (|fetch| (STREAM LINELENGTH) |of| CL::OUTPUT-STREAM) - OUTCHARFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTCHARFN)))) + READONLY-EXTERNALFORMAT _ T))) (STREAMPROP STREAM 'XCL:ECHO-STREAM-P T) (* |;;| "save STREAM in the OPENFILELST field of %ECHO-STREAM-DEVICE") @@ -670,16 +679,17 @@ (* |;;| "methods for the special devices") + + + +(* \; "broadcast streams") + (DEFINEQ (%broadcast-stream-device-bout (lambda (stream byte) (* \; "Edited 13-Jan-87 14:45 by hdj") (* |;;| "The BOUT method for the broadcast-stream device") (|for| s |in| (|fetch| f1 |of| stream) |do| (\\bout s byte)) byte) ) -(%broadcast-stream-device-outcharfn -(lambda (stream charcode) (* \; "Edited 18-Mar-87 11:00 by lal") (* |;;| "outcharfn for broadcast streams") (* |;;| "Using the charposition from the first stream in the broadcast stream list") (|for| s |in| (|fetch| (stream f1) |of| stream) |do| (\\outchar s charcode)) (|replace| (stream charposition) |of| stream |with| (|fetch| (stream charposition) |of| (car (|fetch| (stream f1) |of| stream)))) charcode) -) - (%broadcast-stream-device-closefile (lambda (stream) (* |hdj| "26-Mar-86 16:28") (* |;;;| "The CLOSEFILE method for the broadcast-stream device") (|replace| access |of| stream |with| nil) (|replace| f1 |of| stream |with| nil) stream) ) @@ -696,6 +706,28 @@ (FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE)))) (DEFINEQ +(%BROADCAST-STREAM-OUTCHARFN + (LAMBDA (STREAM CHARCODE) (* \; "Edited 5-Jul-2022 12:50 by rmk") + (* \; "Edited 18-Mar-87 11:00 by lal") + + (* |;;| "outcharfn for broadcast streams") + + (* |;;| "Using the charposition from the first stream in the broadcast stream list") + + (LET ((STREAMS (|fetch| (STREAM F1) |of| STREAM))) + (CL:WHEN STREAMS + (|for| S |in| STREAMS |do| (\\OUTCHAR S CHARCODE)) + (|replace| (STREAM CHARPOSITION) |of| STREAM |with| (|fetch| (STREAM CHARPOSITION) + |of| (CAR STREAMS))))) + CHARCODE)) +) + + + +(* \; "Concatenated streams") + +(DEFINEQ + (%concatenated-stream-device-bin (lambda (stream) (* \; "Edited 13-Jan-87 14:52 by hdj") (* |;;| "The BIN method for the concatenated-stream device") (while (fetch (stream f1) of stream) do (if (eofp (car (fetch (stream f1) of stream))) then (closef (pop (fetch (stream f1) of stream))) else (return (\\bin (car (fetch (stream f1) of stream))))) finally (* \; "the EOF case") (\\eof.action stream))) ) @@ -716,6 +748,50 @@ (lambda (|stream|) (* \; "Edited 24-Mar-87 10:47 by lal") (* |;;| "concatenated streams are read sequentially and a list of them are kept in F1. as they are read, the used stream is removed from the list. \\backfileptr will work because 1) when a file is stream is used up the new one is read, at least one character's worth and 2) \\backfileptr only needs to back up one character") (\\backfileptr (car (|fetch| f1 |of| |stream|)))) ) ) +(DEFINEQ + +(%CONCATENATED-STREAM-INCCODEFN + (LAMBDA (STREAM) (* \; "Edited 5-Jul-2022 16:16 by rmk") + (* \; "Edited 13-Jan-87 14:52 by hdj") + + (* |;;| "The INCCODE method for the concatenated-stream device") + + (WHILE (FETCH (STREAM F1) OF STREAM) + DO (IF (EOFP (CAR (FETCH (STREAM F1) OF STREAM))) + THEN (CLOSEF (POP (FETCH (STREAM F1) OF STREAM))) + ELSE (RETURN (\\INCCODE (CAR (FETCH (STREAM F1) OF STREAM)) + BYTECOUNTVAR BYTECOUNTVAL))) FINALLY + (* \; "the EOF case") + (\\EOF.ACTION STREAM)))) + +(%CONCATENATED-STREAM-PEEKCCODEFN + (LAMBDA (STREAM) (* \; "Edited 5-Jul-2022 16:16 by rmk") + (* \; "Edited 13-Jan-87 14:52 by hdj") + + (* |;;| "The INCCODE method for the concatenated-stream device") + + (WHILE (FETCH (STREAM F1) OF STREAM) + DO (IF (EOFP (CAR (FETCH (STREAM F1) OF STREAM))) + THEN (CLOSEF (POP (FETCH (STREAM F1) OF STREAM))) + ELSE (RETURN (\\INCCODE (CAR (FETCH (STREAM F1) OF STREAM)) + BYTECOUNTVAR BYTECOUNTVAL))) FINALLY + (* \; "the EOF case") + (\\EOF.ACTION STREAM)))) + +(%CONCATENATED-STREAM-BACKCCODEFN + (LAMBDA (STREAM) (* \; "Edited 5-Jul-2022 16:16 by rmk") + (* \; "Edited 13-Jan-87 14:52 by hdj") + + (* |;;| "The INCCODE method for the concatenated-stream device") + + (WHILE (FETCH (STREAM F1) OF STREAM) + DO (IF (EOFP (CAR (FETCH (STREAM F1) OF STREAM))) + THEN (CLOSEF (POP (FETCH (STREAM F1) OF STREAM))) + ELSE (RETURN (\\INCCODE (CAR (FETCH (STREAM F1) OF STREAM)) + BYTECOUNTVAR BYTECOUNTVAL))) FINALLY + (* \; "the EOF case") + (\\EOF.ACTION STREAM)))) +) (CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) @@ -731,8 +807,20 @@ (%echo-stream-device-bin (lambda (stream) (* |hdj| "21-Apr-86 18:33") (* |;;;| "The BIN method for the echo-stream device") (let ((byte (%two-way-stream-device-bin stream))) (\\bout stream byte) byte)) ) + +(%ECHO-STREAM-INCCODEFN + (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* \; "Edited 5-Jul-2022 23:07 by rmk") + +(* |;;;| "The INCCODE method for the echo-stream device") + + (%TWO-WAY-STREAM-OUTCHARFN STREAM (%TWO-WAY-STREAM-INCCODEFN STREAM BYTECOUNTVAR BYTECOUNTVAL)))) ) + + +(* \; "Synonym streams") + + (CL:DEFUN %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM (SYNONYM-STREAM) (* |;;| "given a synonym-stream, find out what it is currently tracking") @@ -748,33 +836,6 @@ (lambda (stream byte) (* |hdj| "19-Mar-86 17:20") (* |;;;| "The BOUT method for the synonym-stream device.") (\\bout (%synonym-stream-device-get-stream stream) byte)) ) -(%SYNONYM-STREAM-DEVICE-OUTCHARFN - (LAMBDA (STREAM CHARCODE) (* \; "Edited 3-Jan-90 15:25 by jds") - - (* |;;| " OUTCHARFN for synonym streams") - - (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) - (\\OUTCHAR OTHER-STREAM CHARCODE) - (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM - CHARPOSITION - ) - |of| OTHER-STREAM))) - )) - -(%SYNONYM-STREAM-DEVICE-CLOSEFILE - (LAMBDA (STREAM) (* \; "Edited 18-Dec-87 12:17 by sye") - -(* |;;;| "the CLOSEFILE method for the synonym-stream device") - - (|replace| F1 |of| STREAM |with| NIL) - - (* |;;| - "remove the synonym stream STREAM from the OPENFILELST field of %SYNONYM-STREAM-DEVICE") - - (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE - |with| (DREMOVE STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE))) - STREAM)) - (%synonym-stream-device-eofp (lambda (stream) (* |hdj| "19-Mar-86 17:20") (* |;;;| "The EOFP method for the synonym-stream device.") (\\eofp (%synonym-stream-device-get-stream stream))) ) @@ -805,6 +866,131 @@ (%synonym-stream-device-charsetfn (lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:01 by bvm:") (* |;;| "The charset method for the synonym-stream device.") (access-charset (%synonym-stream-device-get-stream stream) newvalue)) ) + +(%SYNONYM-STREAM-DEVICE-CLOSEFILE + (LAMBDA (STREAM) (* \; "Edited 18-Dec-87 12:17 by sye") + +(* |;;;| "the CLOSEFILE method for the synonym-stream device") + + (|replace| F1 |of| STREAM |with| NIL) + + (* |;;| + "remove the synonym stream STREAM from the OPENFILELST field of %SYNONYM-STREAM-DEVICE") + + (|replace| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE + |with| (DREMOVE STREAM (|fetch| (FDEV OPENFILELST) |of| %SYNONYM-STREAM-DEVICE))) + STREAM)) +) + + + +(* |;;| "helper ") + +(DEFINEQ + +(%synonym-stream-device-get-stream +(lambda (|stream|) (* \; "Edited 12-Jan-87 14:46 by hdj") (* |;;| "given a synonym-stream, find out what it is currently tracking") (cl:symbol-value (|fetch| (stream f1) |of| |stream|))) +) +) + + + +(* |;;| "Synonym external format") + +(DEFINEQ + +(%SYNONYM-STREAM-OUTCHARFN + (LAMBDA (STREAM CHARCODE) (* \; "Edited 5-Jul-2022 23:12 by rmk") + (* \; "Edited 3-Jul-2022 21:16 by rmk") + (* \; "Edited 3-Jan-90 15:25 by jds") + + (* |;;| " OUTCHARFN for synonym streams") + + (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) + (|freplace| (STREAM EOLCONVENTION) |of| STREAM |with| (|ffetch| (STREAM EOLCONVENTION) + |of| OTHER-STREAM)) + (\\OUTCHAR OTHER-STREAM CHARCODE) + (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM CHARPOSITION) + |of| OTHER-STREAM)) + CHARCODE))) + +(%SYNONYM-STREAM-INCCODEFN + (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* \; "Edited 3-Jul-2022 21:28 by rmk") + + (* |;;| " INCCODEFN for synonym streams") + + (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) + (|freplace| (STREAM EOLCONVENTION) |of| STREAM |with| (|ffetch| (STREAM EOLCONVENTION) + |of| OTHER-STREAM)) + (\\INCCODE OTHER-STREAM BYTECOUNTVAR BYTECOUNTVAL)))) + +(%SYNONYM-STREAM-PEEKCCODEFN + (LAMBDA (STREAM NOERROR EOL) (* \; "Edited 3-Jul-2022 21:31 by rmk") + (* \; "Edited 3-Jan-90 15:25 by jds") + + (* |;;| " PEEKCCODEFN for synonym streams") + + (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) + (|freplace| (STREAM EOLCONVENTION) |of| STREAM |with| (|ffetch| (STREAM EOLCONVENTION) + |of| OTHER-STREAM)) + (\\PEEKCCODE OTHER-STREAM NOERROR EOL)))) + +(%SYNONYM-STREAM-BACKCCODEFN + (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* \; "Edited 3-Jul-2022 21:31 by rmk") + (* \; "Edited 3-Jan-90 15:25 by jds") + + (* |;;| " BACKCCODEFN for synonym streams") + + (LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM))) + (|freplace| (STREAM EOLCONVENTION) |of| STREAM |with| (|ffetch| (STREAM EOLCONVENTION) + |of| OTHER-STREAM)) + (\\BACKCCODE OTHER-STREAM BYTECOUNTVAR BYTECOUNTVAL)))) +) + + + +(* \; "Two-way streams") + +(DEFINEQ + +(%TWO-WAY-STREAM-BACKCCODEFN + (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* \; "Edited 3-Jul-2022 23:52 by rmk") + (* \; "Edited 3-Jan-90 15:26 by jds") + + (* |;;| "backccodefn for two-way streams") + + (\\BACKCCODE (|fetch| (STREAM F1) |of| STREAM) + BYTECOUNTVAR BYTECOUNTVAL))) + +(%TWO-WAY-STREAM-INCCODEFN + (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* \; "Edited 3-Jul-2022 23:52 by rmk") + (* \; "Edited 3-Jan-90 15:26 by jds") + + (* |;;| "inccodefn for two-way streams") + + (\\INCCODE (|fetch| (STREAM F1) |of| STREAM) + BYTECOUNTVAR BYTECOUNTVAL))) + +(%TWO-WAY-STREAM-OUTCHARFN + (LAMBDA (STREAM CHARCODE) (* \; "Edited 5-Jul-2022 23:06 by rmk") + (* \; "Edited 3-Jan-90 15:26 by jds") + + (* |;;| "outcharfn for two-way streams") + + (PROG1 (\\OUTCHAR (|fetch| (STREAM F2) |of| STREAM) + CHARCODE) + (|freplace| (STREAM CHARPOSITION) |of| STREAM |with| (|ffetch| (STREAM CHARPOSITION) + |of| (|ffetch| (STREAM F2) + |of| STREAM)))))) + +(%TWO-WAY-STREAM-PEEKCCODEFN + (LAMBDA (STREAM NOERROR EOL) (* \; "Edited 4-Jul-2022 00:02 by rmk") + (* \; "Edited 3-Jan-90 15:26 by jds") + + (* |;;| "peekccodefn for two-way streams") + + (\\PEEKCCODE (|fetch| (STREAM F1) |of| STREAM) + NOERROR EOL))) ) (DEFINEQ @@ -888,6 +1074,11 @@ ) ) + + +(* \; "Fill-pointer streams") + + (CL:DEFUN %FILL-POINTER-STREAM-DEVICE-CLOSEFILE (STREAM &OPTIONAL ABORTFLAG) (* |;;;| "the CLOSEFILE method for the fill-pointer-string-stream device") @@ -905,17 +1096,6 @@ -(* |;;| "helper stuff") - -(DEFINEQ - -(%synonym-stream-device-get-stream -(lambda (|stream|) (* \; "Edited 12-Jan-87 14:46 by hdj") (* |;;| "given a synonym-stream, find out what it is currently tracking") (cl:symbol-value (|fetch| (stream f1) |of| |stream|))) -) -) - - - (* |;;| "module initialization") @@ -931,7 +1111,7 @@ (CL:DEFVAR *STANDARD-INPUT*) -(CL:DEFUN %INITIALIZE-STANDARD-STREAMS () +(CL:DEFUN %INITIALIZE-STANDARD-STREAMS () (* \; "Edited 3-Jul-2022 23:18 by rmk") (* |;;|  "Called when CLSTREAMS is loaded. Almost everything is same as *TERMINAL-IO* to start with.") @@ -944,11 +1124,18 @@ (DEFINEQ (%INITIALIZE-CLSTREAM-TYPES - (LAMBDA NIL (* \; "Edited 3-Jul-2022 14:16 by rmk") + (LAMBDA NIL (* \; "Edited 5-Jul-2022 21:20 by rmk") + (* \; "Edited 3-Jul-2022 23:57 by rmk") (* \; "Edited 14-Apr-87 17:08 by bvm:") (* |;;| "Initialize the CLSTREAMS package. This sets up some file devices for the functions make-two-way-stream-device, etc. See CLtL chapter 21") + (* |;;| "The input functions for broadcast streams should never be called, because they are guarded by the fact that the stream itself is output only.") + + (MAKE-EXTERNALFORMAT :BROADCAST-STREAM-FORMAT (FUNCTION SHOULDNT) + (FUNCTION SHOULDNT) + (FUNCTION SHOULDNT) + (FUNCTION %BROADCAST-STREAM-OUTCHARFN)) (SETQ %BROADCAST-STREAM-DEVICE (|create| FDEV DEVICENAME _ 'BROADCAST-STREAM-DEVICE @@ -980,7 +1167,12 @@ FORCEOUTPUT _ (FUNCTION %BROADCAST-STREAM-DEVICE-FORCEOUTPUT) GETFILEINFO _ (FUNCTION NILL) SETFILEINFO _ (FUNCTION NILL) - CHARSETFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-CHARSETFN))) + CHARSETFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-CHARSETFN) + DEFAULTEXTERNALFORMAT _ :BROADCAST-STREAM-FORMAT)) + (MAKE-EXTERNALFORMAT :CONCATENATED-STREAM-FORMAT (FUNCTION %CONCATENATED-STREAM-INCCODEFN) + (FUNCTION %CONCATENATED-STREAM-PEEKCCODEFN) + (FUNCTION %CONCATENATED-STREAM-BACKCCODEFN) + (FUNCTION SHOULDNT)) (SETQ %CONCATENATED-STREAM-DEVICE (|create| FDEV DEVICENAME _ 'CONCATENATED-STREAM-DEVICE @@ -1013,7 +1205,12 @@ FORCEOUTPUT _ (FUNCTION NILL) GETFILEINFO _ (FUNCTION NILL) SETFILEINFO _ (FUNCTION NILL) - CHARSETFN _ (FUNCTION %CONCATENATED-STREAM-DEVICE-CHARSETFN))) + CHARSETFN _ (FUNCTION %CONCATENATED-STREAM-DEVICE-CHARSETFN) + DEFAULTEXTERNALFORMAT _ :CONCATENATED-STREAM-FORMAT)) + (MAKE-EXTERNALFORMAT :TWO-WAY-STREAM-FORMAT (FUNCTION %TWO-WAY-STREAM-INCCODEFN) + (FUNCTION %TWO-WAY-STREAM-PEEKCCODEFN) + (FUNCTION %TWO-WAY-STREAM-BACKCCODEFN) + (FUNCTION %TWO-WAY-STREAM-OUTCHARFN)) (SETQ %TWO-WAY-STREAM-DEVICE (|create| FDEV DEVICENAME _ 'TWO-WAY-STREAM-DEVICE @@ -1050,11 +1247,21 @@ SETFILEINFO _ (FUNCTION NILL) CHARSETFN _ (FUNCTION %TWO-WAY-STREAM-DEVICE-CHARSETFN) INPUTSTREAM _ (FUNCTION %TWO-WAY-STREAM-DEVICE-INPUTSTREAM) - OUTPUTSTREAM _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM))) + OUTPUTSTREAM _ (FUNCTION %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM) + DEFAULTEXTERNALFORMAT _ :TWO-WAY-STREAM-FORMAT)) + (MAKE-EXTERNALFORMAT :ECHO-STREAM-FORMAT (FUNCTION %ECHO-STREAM-INCCODEFN) + (FUNCTION %TWO-WAY-STREAM-PEEKCCODEFN) + (FUNCTION %TWO-WAY-STREAM-BACKCCODEFN) + (FUNCTION %TWO-WAY-STREAM-OUTCHARFN)) (SETQ %ECHO-STREAM-DEVICE (|create| FDEV |using| %TWO-WAY-STREAM-DEVICE DEVICENAME _ 'ECHO-STREAM-DEVICE BIN _ (FUNCTION %ECHO-STREAM-DEVICE-BIN - ))) + ) + DEFAULTEXTERNALFORMAT _ :ECHO-STREAM-FORMAT)) + (MAKE-EXTERNALFORMAT :SYNONYM-STREAM (FUNCTION %SYNONYM-STREAM-INCCODEFN) + (FUNCTION %SYNONYM-STREAM-PEEKCCODEFN) + (FUNCTION %SYNONYM-STREAM-BACKCCODEFN) + (FUNCTION %SYNONYM-STREAM-OUTCHARFN)) (SETQ %SYNONYM-STREAM-DEVICE (|create| FDEV DEVICENAME _ 'SYNONYM-STREAM-DEVICE @@ -1091,7 +1298,8 @@ SETFILEINFO _ (FUNCTION %SYNONYM-STREAM-DEVICE-SETFILEINFO) INPUTSTREAM _ (FUNCTION %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM) OUTPUTSTREAM _ (FUNCTION %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM) - CHARSETFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-CHARSETFN))) + CHARSETFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-CHARSETFN) + DEFAULTEXTERNALFORMAT _ :SYNONYM-STREAM)) (SETQ \\FILL-POINTER-STREAM-DEVICE (|create| FDEV DEVICENAME _ 'FILL-POINTER-STREAM-DEVICE @@ -1135,51 +1343,56 @@ (PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE) (PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (5227 14202 (OPEN 5227 . 14202)) (14204 15130 (CL:CLOSE 14204 . 15130)) (15132 15210 ( -CL:STREAM-EXTERNAL-FORMAT 15132 . 15210)) (15212 15279 (CL:STREAM-ELEMENT-TYPE 15212 . 15279)) (15281 -15515 (CL:INPUT-STREAM-P 15281 . 15515)) (15517 15753 (CL:OUTPUT-STREAM-P 15517 . 15753)) (15755 15892 - (XCL:OPEN-STREAM-P 15755 . 15892)) (15894 15961 (FILE-STREAM-POSITION 15894 . 15961)) (16013 17356 ( -CL:MAKE-SYNONYM-STREAM 16013 . 17356)) (17358 17447 (XCL:SYNONYM-STREAM-P 17358 . 17447)) (17449 17587 - (XCL:SYNONYM-STREAM-SYMBOL 17449 . 17587)) (17589 17867 (XCL:FOLLOW-SYNONYM-STREAMS 17589 . 17867)) ( -17869 18628 (CL:MAKE-BROADCAST-STREAM 17869 . 18628)) (18630 18773 (XCL:BROADCAST-STREAM-P 18630 . -18773)) (18775 18990 (XCL:BROADCAST-STREAM-STREAMS 18775 . 18990)) (18992 19677 ( -CL:MAKE-CONCATENATED-STREAM 18992 . 19677)) (19679 19778 (XCL:CONCATENATED-STREAM-P 19679 . 19778)) ( -19780 19993 (XCL:CONCATENATED-STREAM-STREAMS 19780 . 19993)) (19995 21579 (CL:MAKE-TWO-WAY-STREAM -19995 . 21579)) (21581 21718 (XCL:TWO-WAY-STREAM-P 21581 . 21718)) (21720 21865 ( -XCL:TWO-WAY-STREAM-OUTPUT-STREAM 21720 . 21865)) (21867 22011 (XCL:TWO-WAY-STREAM-INPUT-STREAM 21867 - . 22011)) (22013 23563 (CL:MAKE-ECHO-STREAM 22013 . 23563)) (23565 23694 (XCL:ECHO-STREAM-P 23565 . -23694)) (23696 23834 (XCL:ECHO-STREAM-INPUT-STREAM 23696 . 23834)) (23836 23975 ( -XCL:ECHO-STREAM-OUTPUT-STREAM 23836 . 23975)) (23977 24704 (CL:MAKE-STRING-INPUT-STREAM 23977 . 24704) -) (24706 25199 (MAKE-CONCATENATED-STRING-INPUT-STREAM 24706 . 25199)) (25201 25361 ( -%MAKE-INITIAL-STRING-STREAM-CONTENTS 25201 . 25361)) (25363 25793 (CL:WITH-OPEN-STREAM 25363 . 25793)) - (25795 27024 (CL:WITH-INPUT-FROM-STRING 25795 . 27024)) (27026 27528 (CL:WITH-OUTPUT-TO-STRING 27026 - . 27528)) (27530 28184 (CL:WITH-OPEN-FILE 27530 . 28184)) (28408 29934 ( -MAKE-FILL-POINTER-OUTPUT-STREAM 28408 . 29934)) (29936 30657 (CL:GET-OUTPUT-STREAM-STRING 29936 . -30657)) (30659 31138 (\\STRING-STREAM-OUTCHARFN 30659 . 31138)) (31140 32995 ( -\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 31140 . 32995)) (33024 33106 (%NEW-FILE 33024 . 33106)) (33108 -33253 (PREDICT-NAME 33108 . 33253)) (33289 33440 (INTERLISP-ACCESS 33289 . 33440)) (33494 34682 ( -%BROADCAST-STREAM-DEVICE-BOUT 33504 . 33727) (%BROADCAST-STREAM-DEVICE-OUTCHARFN 33729 . 34180) ( -%BROADCAST-STREAM-DEVICE-CLOSEFILE 34182 . 34421) (%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34423 . 34680) -) (34684 35011 (%BROADCAST-STREAM-DEVICE-CHARSETFN 34684 . 35011)) (35012 37071 ( -%CONCATENATED-STREAM-DEVICE-BIN 35022 . 35427) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 35429 . 35742) ( -%CONCATENATED-STREAM-DEVICE-EOFP 35744 . 36108) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36110 . 36585) ( -%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 36587 . 37069)) (37073 37404 ( -%CONCATENATED-STREAM-DEVICE-CHARSETFN 37073 . 37404)) (37405 37624 (%ECHO-STREAM-DEVICE-BIN 37415 . -37622)) (37626 37851 (%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 37626 . 37851)) (37852 41197 ( -%SYNONYM-STREAM-DEVICE-BIN 37862 . 38050) (%SYNONYM-STREAM-DEVICE-BOUT 38052 . 38253) ( -%SYNONYM-STREAM-DEVICE-OUTCHARFN 38255 . 38962) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 38964 . 39548) ( -%SYNONYM-STREAM-DEVICE-EOFP 39550 . 39741) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 39743 . 39981) ( -%SYNONYM-STREAM-DEVICE-GETFILEINFO 39983 . 40220) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40222 . 40445) ( -%SYNONYM-STREAM-DEVICE-READP 40447 . 40558) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 40560 . 40706) ( -%SYNONYM-STREAM-DEVICE-SETFILEINFO 40708 . 40957) (%SYNONYM-STREAM-DEVICE-CHARSETFN 40959 . 41195)) ( -41198 45523 (%TWO-WAY-STREAM-DEVICE-BIN 41208 . 41381) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 41383 . -41574) (%TWO-WAY-STREAM-DEVICE-BOUT 41576 . 41748) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 41750 . 41940) - (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 41942 . 42804) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 42806 . 44229) ( -%TWO-WAY-STREAM-DEVICE-EOFP 44231 . 44407) (%TWO-WAY-STREAM-DEVICE-READP 44409 . 44602) ( -%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 44604 . 44740) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 44742 . 44971) ( -%TWO-WAY-STREAM-DEVICE-PEEKBIN 44973 . 45186) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45188 . 45521)) (45525 - 45750 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE 45525 . 45750)) (45752 45871 ( -%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 45752 . 45871)) (46111 46350 (%SYNONYM-STREAM-DEVICE-GET-STREAM - 46121 . 46348)) (46581 47057 (%INITIALIZE-STANDARD-STREAMS 46581 . 47057)) (47058 55373 ( -%INITIALIZE-CLSTREAM-TYPES 47068 . 55371))))) + (FILEMAP (NIL (6268 15243 (OPEN 6268 . 15243)) (15245 16171 (CL:CLOSE 15245 . 16171)) (16173 16251 ( +CL:STREAM-EXTERNAL-FORMAT 16173 . 16251)) (16253 16320 (CL:STREAM-ELEMENT-TYPE 16253 . 16320)) (16322 +16556 (CL:INPUT-STREAM-P 16322 . 16556)) (16558 16794 (CL:OUTPUT-STREAM-P 16558 . 16794)) (16796 16933 + (XCL:OPEN-STREAM-P 16796 . 16933)) (16935 17002 (FILE-STREAM-POSITION 16935 . 17002)) (17054 18558 ( +CL:MAKE-SYNONYM-STREAM 17054 . 18558)) (18560 18649 (XCL:SYNONYM-STREAM-P 18560 . 18649)) (18651 18789 + (XCL:SYNONYM-STREAM-SYMBOL 18651 . 18789)) (18791 19069 (XCL:FOLLOW-SYNONYM-STREAMS 18791 . 19069)) ( +19071 19556 (CL:MAKE-BROADCAST-STREAM 19071 . 19556)) (19558 19701 (XCL:BROADCAST-STREAM-P 19558 . +19701)) (19703 19918 (XCL:BROADCAST-STREAM-STREAMS 19703 . 19918)) (19920 20504 ( +CL:MAKE-CONCATENATED-STREAM 19920 . 20504)) (20506 20605 (XCL:CONCATENATED-STREAM-P 20506 . 20605)) ( +20607 20820 (XCL:CONCATENATED-STREAM-STREAMS 20607 . 20820)) (20822 22563 (CL:MAKE-TWO-WAY-STREAM +20822 . 22563)) (22565 22702 (XCL:TWO-WAY-STREAM-P 22565 . 22702)) (22704 22849 ( +XCL:TWO-WAY-STREAM-OUTPUT-STREAM 22704 . 22849)) (22851 22995 (XCL:TWO-WAY-STREAM-INPUT-STREAM 22851 + . 22995)) (22997 24544 (CL:MAKE-ECHO-STREAM 22997 . 24544)) (24546 24675 (XCL:ECHO-STREAM-P 24546 . +24675)) (24677 24815 (XCL:ECHO-STREAM-INPUT-STREAM 24677 . 24815)) (24817 24956 ( +XCL:ECHO-STREAM-OUTPUT-STREAM 24817 . 24956)) (24958 25685 (CL:MAKE-STRING-INPUT-STREAM 24958 . 25685) +) (25687 26180 (MAKE-CONCATENATED-STRING-INPUT-STREAM 25687 . 26180)) (26182 26342 ( +%MAKE-INITIAL-STRING-STREAM-CONTENTS 26182 . 26342)) (26344 26774 (CL:WITH-OPEN-STREAM 26344 . 26774)) + (26776 28005 (CL:WITH-INPUT-FROM-STRING 26776 . 28005)) (28007 28509 (CL:WITH-OUTPUT-TO-STRING 28007 + . 28509)) (28511 29165 (CL:WITH-OPEN-FILE 28511 . 29165)) (29389 30915 ( +MAKE-FILL-POINTER-OUTPUT-STREAM 29389 . 30915)) (30917 31638 (CL:GET-OUTPUT-STREAM-STRING 30917 . +31638)) (31640 32119 (\\STRING-STREAM-OUTCHARFN 31640 . 32119)) (32121 33976 ( +\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 32121 . 33976)) (34005 34087 (%NEW-FILE 34005 . 34087)) (34089 +34234 (PREDICT-NAME 34089 . 34234)) (34270 34421 (INTERLISP-ACCESS 34270 . 34421)) (34510 35245 ( +%BROADCAST-STREAM-DEVICE-BOUT 34520 . 34743) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34745 . 34984) ( +%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34986 . 35243)) (35247 35574 (%BROADCAST-STREAM-DEVICE-CHARSETFN +35247 . 35574)) (35575 36370 (%BROADCAST-STREAM-OUTCHARFN 35585 . 36368)) (36409 38468 ( +%CONCATENATED-STREAM-DEVICE-BIN 36419 . 36824) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36826 . 37139) ( +%CONCATENATED-STREAM-DEVICE-EOFP 37141 . 37505) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 37507 . 37982) ( +%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 37984 . 38466)) (38469 41099 (%CONCATENATED-STREAM-INCCODEFN +38479 . 39349) (%CONCATENATED-STREAM-PEEKCCODEFN 39351 . 40223) (%CONCATENATED-STREAM-BACKCCODEFN +40225 . 41097)) (41101 41432 (%CONCATENATED-STREAM-DEVICE-CHARSETFN 41101 . 41432)) (41433 41964 ( +%ECHO-STREAM-DEVICE-BIN 41443 . 41650) (%ECHO-STREAM-INCCODEFN 41652 . 41962)) (41999 42224 ( +%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 41999 . 42224)) (42225 44861 (%SYNONYM-STREAM-DEVICE-BIN +42235 . 42423) (%SYNONYM-STREAM-DEVICE-BOUT 42425 . 42626) (%SYNONYM-STREAM-DEVICE-EOFP 42628 . 42819) + (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 42821 . 43059) (%SYNONYM-STREAM-DEVICE-GETFILEINFO 43061 . 43298) + (%SYNONYM-STREAM-DEVICE-PEEKBIN 43300 . 43523) (%SYNONYM-STREAM-DEVICE-READP 43525 . 43636) ( +%SYNONYM-STREAM-DEVICE-BACKFILEPTR 43638 . 43784) (%SYNONYM-STREAM-DEVICE-SETFILEINFO 43786 . 44035) ( +%SYNONYM-STREAM-DEVICE-CHARSETFN 44037 . 44273) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 44275 . 44859)) ( +44889 45128 (%SYNONYM-STREAM-DEVICE-GET-STREAM 44899 . 45126)) (45172 47937 (%SYNONYM-STREAM-OUTCHARFN + 45182 . 46128) (%SYNONYM-STREAM-INCCODEFN 46130 . 46659) (%SYNONYM-STREAM-PEEKCCODEFN 46661 . 47290) +(%SYNONYM-STREAM-BACKCCODEFN 47292 . 47935)) (47971 49864 (%TWO-WAY-STREAM-BACKCCODEFN 47981 . 48382) +(%TWO-WAY-STREAM-INCCODEFN 48384 . 48779) (%TWO-WAY-STREAM-OUTCHARFN 48781 . 49473) ( +%TWO-WAY-STREAM-PEEKCCODEFN 49475 . 49862)) (49865 54190 (%TWO-WAY-STREAM-DEVICE-BIN 49875 . 50048) ( +%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 50050 . 50241) (%TWO-WAY-STREAM-DEVICE-BOUT 50243 . 50415) ( +%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 50417 . 50607) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 50609 . 51471) ( +%TWO-WAY-STREAM-DEVICE-CLOSEFILE 51473 . 52896) (%TWO-WAY-STREAM-DEVICE-EOFP 52898 . 53074) ( +%TWO-WAY-STREAM-DEVICE-READP 53076 . 53269) (%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 53271 . 53407) ( +%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 53409 . 53638) (%TWO-WAY-STREAM-DEVICE-PEEKBIN 53640 . 53853) ( +%TWO-WAY-STREAM-DEVICE-CHARSETFN 53855 . 54188)) (54230 54455 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE +54230 . 54455)) (54457 54576 (%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 54457 . 54576)) (55014 55557 ( +%INITIALIZE-STANDARD-STREAMS 55014 . 55557)) (55558 65584 (%INITIALIZE-CLSTREAM-TYPES 55568 . 65582))) +)) STOP diff --git a/sources/CLSTREAMS.LCOM b/sources/CLSTREAMS.LCOM index afcd0969f6c58b928a78df5cc0df304e1f52c867..5bb202715084fd0b102e70767e86534090f617da 100644 GIT binary patch delta 6935 zcmd5>T}&L;6=r|HFw0^v|9|EhOv2(U%$@(){D@^4V4Y=V*i&++QyCYCsnDcJTy_H_9YLAs;25gnx1=SW_NZW zPV!)-JnY=LckVgop7Wh^&pCYZiSLI``Jc=*D$(QLT8#?4ARvrmvJ&If-Ie(cQN0#H zy~wl5^D$nG3HDxF7YN+1glKURu1gjV^6(tt_sQPY>J^;7~ugezldHt`7O^(aFtP@?>?G zOj{k~@iR5#R`mf=RegwzA84jzxZcFZ`VwesoodV>b*VQ3r!=!9eYu-_P(4Vlr@P6E zo0Vkxau@lGtA_W(6E+AtorC&+Y7YiKl{a9&MvwMHT@ z)ErKrevdMuh5f+RJt9ZXn7y*Tv3_N(L@ZbNB+j*wk7_!ITG!?uO_D{fot&PnB(HF- zOjf+mMoz)uU*Y=5g-|P#yC1e34n@c)eDi3imiz5Y5IWcXgP9{w5mMx9v84UQS3GZWFI zHHh+0*G)J2{zX1K5)EE>vz8~Q_cbIV+p*FaD~+(OqlJa6k&7o1MmCGECX-NKgj3M? zm@$h45d%(I!$=ThXGY-ZOb`jYPQKgM)+M1)D>n%nc@zT-$7fPGgjLMGCVw-!c$?dh zY2}8jv|%Dm1&)T5H8L41gH#RPOe;ARpD?U+7Rf64w68n=(9u8o<|?Wx{1qz=zKY2U z4MOGdRCQb-)8*Q8fh>jRmasYTeak{W`My8&9Q0RI_(zI>I#Ut%y!got9I<`s zJ^b1!Tml~O6|YYT%y?zs5kxO|5T@oX!II(tMF5Z34N(`AZKpy2GddFhkdfyeZRrDq z@wO8Ryi$Z3)>Q{;;KUSH0{k`|!IW{q{V-2K?D0QMq`<0`Mdw6Flqj=9;NUKxWm|3J zZN4pE$6xpTU#SXTYARC|%;=yh8J&Pc!h3Ckm)>Q?0qcDfmw!NNX!Z*dv68=qNB-b( zF_{0%e8NWt%?9$<qHAn8pnx3;fVH z2rxRIGZNN}nVXGgU_$Utq#~$d#^Em!OxG9eb0RDPq@!s)YuPhm|bEb~er#r|Kxz~5R(A{IX zQtO~(x&4Z^1a|L^O4}M1++)0E2H4x%n@=Q9M z|IfmkRe5>&$Nu&M7b^h4EFob(%ggK$t|TYVjgjFCm1N=UcL-WLN*+1iNiu7l>JU+NS~R&tMj=W=;ihUj-4a%z5VIvwRm_N}ieRr$zo^SD-MmS7luwFKl$TKo1CA z3kGOOnVU}=eb*3{HC9JPVN@U?7f8rO5|S&TEGi&$3#73PS6YKu#!O{xGOwdpY3~4N z@{~GjP6V-}(;}8OI~pqymNdbA3&NX9d|U0bnE~G^5?gtfqc5@@*G_GQ{h+Pg^~P37 z^xAGT3H<>q2^!n;;$~Gq!a5tjwHb!7Ex_SW70?2ZPywLz6T~9uguXzpB|s}a#(t|Z zEJ9{vYfV&SW(!evQ6oyORYcgqNSRy|i-PWMfkf8X48?{s;$71Sf`-WSO!E%Hv=}Y3 zgaEZi@p38eS73qn-aYnmAqYd9gAexZFN7}o0oEM~L!M?#F>=E?v<}KGNE;E5J|Bkd zs)|bTcBlNt7z#OjsiPCiI`Sq*fU;!5fQ{f(P`bdWF*tnLsX=*nNOv$6)IG~3rv^># z`JnXF;7P1YH|%z_yhnyM!2W0AS+xgl!9!=pHY8v0JHFs|e8FjWMWntQ;AM%04qlS! zvxgU<7A$LDxtiml9{AO8C;9J5E{J(>q}>oS`?dl0Jal#F3v~6G;l)9ft~;R8HS+Ox zJM9Y&>Z)DA+L6o-Lb^h)=t5wk9-@OEQG(F^4Ct(IZHLw;7eu;9PfGiVRRJBmh>pQQ z0y=onZm6B0>L84H7eXXfP3Y zQH9nx3WbKr^gzb|5}}7^%OE=9i4c748E}7lz*FaK3JB28qec=S>cO)|P{DaeGgf>o z5zpq_0OBx!t9p8%lbpH|f{WFrBS0^U5fmf{#_V4hCpW_nK>OC22F#T?rU3O`E;D05 zBiFrnTrgn(lTGB&*{Wt5e;I9vx6S|{1<68->|QzmDfgUvxpeXgBF|^+bMg^^N}l#NXi0 delta 4518 zcmd5=TWnO<74w&}R{oO{oGn5OYyU)y8GGvk>t!p12~Wxy#k zkn%`HT>$|~KHBowUrkU$8ns`of-~YPX`Dz=OIwkL(vM1wRQRYOReeN?g!)JKIrrZ2 z*hcD4Rh19VdG53CT6?dv4_9yaA3pS5E3~P}@zckWOks>rZGajBRK0#^dIMkRC0j|& zq+$+meSn+S|G2qOGu+?bzm+V^l}{a-TUfin7*MpWy^)@gbjBVk*r}2|ymFCuBux6# zU3`IXu4@Jv7#d4uN9|&=lp{SO*&>0Dj&I!2O9t`pu>>59MzP-wSE7k<)fb=(ozfMt^22Zl z)P*>_dcFyM6Ma(d7RRxL1Z-*QmHh(;n&7X|1YFIB(bYz{sC2;b>H3P%JnxIuo*jXY z*G<6Yme;${B>@NN=_3ofb|F{uhmM^%^lftT)ak>A;k~Av@Lr47)HiJJo*GT2bA2RI z@wHC2`ThmPZOMisb@;En2llGJ+d@rJEFqZ_`9dyFFmlN3Y|$>IhKB57kx zZjVPSGBRxMB}~=u3llNInCXr%Rg44)qYNHw@7!#V-MP{jZdS>_usxER%9IE-G-owc z;6ZOYTLr;Bx;?pfbjZb;7r?gU<3tozHeIQ03k=;pbD@>?TIbLsZ>r8)P@ zm*$>(^ynU6l9O-E?SWtP(7@Ys8Mxo0`<{X8cH-QGvo<2OFMVC^dp0UM*_QG0uQGR< zC+53m-x@#qhndAk>nC=+efyy=ET&(dUwo7p_b)yQrw=p-?u6&%Xp3)7{=WIeQm)y5 z`?IF7#!Vsw0*>omjkESyHslq5>!+OoMs(4E!N7Pus5mPjQ`m?!Ge=cul z3036Lt41wToL}Y9!rn5E0b(#H@8}M2LndjgnkPh4#Yku6cwf73Y};cv{bU8Fp9)St zTg&NxmCB8)s3d~Q_5XoNlX?6QhGD*%N?tR~s*HB40eEj7n(uzvb zS%*fYhDOXBnVFRGH8eh+Fp+`86htl4CX#WPHlnLg9^K@_zd|EJmBpmt+tTi@tMd=a zNdCF=vy^gr&d(C`s=YPx@_V9t$jHydK(75u#S@(GO?}fl1Z|x0T>g?uZhjbQwA!cMf#wW5b<2F5D?fW({yuSsCyI zB@^S_Z>Z=(BA#51ckcO4R5-76R-UIn{{M!w%sZM`Ev7hdjv=V~hB5>8&{!_%2t*P! zhW(H54Hj1doOnFII+S^Ps?2lvZCNKHP0w~LkAlo|{P z;dcK1w%sRtcSH9=sTP!J5wR|X7;)M%g@zl5M5VB}FAgu{H^94%Vfe66U%8n(?SohL zwu|E8#B{jwkI7#KMEh#K7oyYmAi6(Zxi)jw=Q^{qziT{R-WBb|^q(AG_gbZP#2D9M&X!kH)`>1$XOm1vpF1sxhGN+|mn%6SLCyv@# zyO1907gZg~BB8pW!>zLkzplfpXFCHrSAkq?4^myj+wD8OTXhu=mgaRPQrI)F8#%-B zMW=>X-%NGIbk}jqa!hbbappJ*sAGfUU4_dn%5~2}&V`^$vsk5ObK;&v!yF^Q-GkEM zwwM7Qt^1NrIVyxZgyP_}6t|_}&F_q9cyYKbra(z;g<%*8QdL%MqLxKCRVs=)ucJ5- zhIMI>GE0{;Z+tfvV5TA4Sj;9VGlUGT!kg(r46B1_ESM?N6}bz8Ge8-K*S2@USEgcU zT9fWXu=*U%<2qH8k)5I%$2qKC=)#6Zq!DK@g|YM1G*%!?@!+PGQ0FzwV9Dx&N(~Qu zYB(<710ji(jfX$Qo7usiVlCpfR4*bG9d8d>jwh(X*RY~!sPa4>P&7p-ji}e_siIN> z7qqq@RgljMN+)i`%w0vOf)y~%^-u+GA9<){xu;vEd$?t|;bmdqV?_Ebj`5!eSa|HM zv+;n1ML6Cr@WbZjfQ6WfcD6a@x2U*T@X-_Pu<+`a)=jL>oQ7%1g+DnT>oZLuY*nIU zwwQ(}!K-6}JX2n*3HTr!3YeIC;vD2IU}E}VJCby`GgZfhe}=<;lSvl_kA(atg~@ZB z0-LDm<)2|e`AU0-fwiY}%J7oUz}yq&-)W5Y7+(4rn0?MNFW(F=-E^H1xPGJ~PISCj zS7NMlWJT63Jw(@Bly%ibS;ul$8pTX?8;XN6wK~{Tt2ouyd5Mp%dNQNtF%e;0zxymw-sNpnx?xR zXjoRSO#)4G-O*Gx1vJ%lqCs35J({P=nkUMdr^%`($*2|tS}%1ah>GgI5?~eYMNzx= z;O*zat9k~QXMmxkOLQ2DxCmklocal>lde>lispcore>sources>CMLFORMAT.;2 79148 - changes to%: (VARS CMLFORMATCOMS) +(FILECREATED " 3-Jul-2022 17:43:01"  +{DSK}kaplan>local>medley3.5>working-medley>sources>CMLFORMAT.;2 79948 - previous date%: " 5-Apr-89 14:15:38" {DSK}local>lde>lispcore>sources>CMLFORMAT.;1) + :PREVIOUS-DATE "16-May-90 13:19:59" +{DSK}kaplan>local>medley3.5>working-medley>sources>CMLFORMAT.;1) (* ; " -Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1986-1990 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT CMLFORMATCOMS) @@ -57,7 +58,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (DEFINE-CONDITION FORMAT-ERROR (CL:ERROR) (ARGS) [:REPORT (CL:LAMBDA (CONDITION *STANDARD-OUTPUT*) - (CL:FORMAT T "~%%~:{~@?~%%~}" (FORMAT-ERROR-ARGS CONDITION]) + (CL:FORMAT T "~%%~:{~@?~%%~}" (FORMAT-ERROR-ARGS CONDITION]) (DEFMACRO MAKE-DISPATCH-VECTOR (&BODY ENTRIES) @@ -88,7 +89,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri :ELEMENT-TYPE T :INITIAL-CONTENTS ',(CL:NREVERSE COMTAB])]) (CL:DEFUN SCALE-EXPONENT (X) - (SCALE-EXPT-AUX X 0.0 1.0 10.0 0.1 (CONSTANT (CL:LOG 2.0 10.0)))) + (SCALE-EXPT-AUX X 0.0 1.0 10.0 0.1 (CONSTANT (CL:LOG 2.0 10.0)))) (CL:DEFUN SCALE-EXPT-AUX (X ZERO ONE TEN ONE-TENTH LOG10-OF-2) [CL:MULTIPLE-VALUE-BIND (SIG EXPONENT) @@ -115,8 +116,8 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri [CL:ERROR 'FORMAT-ERROR :ARGS (LIST (LIST "~?~%%~S~%%~V@T^" COMPLAINT FORMAT-ARGS *FORMAT-CONTROL-STRING* (CL:1+ *FORMAT-INDEX*]) -(CL:DEFVAR *DIGIT-STRING* (CL:MAKE-ARRAY 50 :ELEMENT-TYPE 'CL:STRING-CHAR :FILL-POINTER 0 - :ADJUSTABLE T)) +(CL:DEFVAR *DIGIT-STRING* (CL:MAKE-ARRAY 50 :ELEMENT-TYPE 'CL:STRING-CHAR :FILL-POINTER 0 :ADJUSTABLE + T)) (CL:DEFCONSTANT *DIGITS* "0123456789") @@ -133,7 +134,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (FMIN))) [ROUND (COND [REALDP (* ; - "Foo! Compute rounding place based on size of number and scale factor") + "Foo! Compute rounding place based on size of number and scale factor") (MIN 9 (+ (DIGITSBDP X) REALDP (OR SCALE 0] @@ -144,7 +145,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:IF SCALE (CL:INCF INTEXP SCALE)) (* ;; - "OK, now copy the digit string into *digit-string* with the decimal point set appropriately") + "OK, now copy the digit string into *digit-string* with the decimal point set appropriately") (CL:MACROLET [(STRPUT (C) `(CL:VECTOR-PUSH-EXTEND ,C *DIGIT-STRING*] @@ -157,9 +158,9 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (IF (NOT (ZEROP X)) THEN (WHILE (AND (CL:PLUSP DIGITS) - (CL:CHAR= (CL:CHAR MANTSTR (CL:1- DIGITS)) - #\0)) DO (CL:DECF DIGITS) - (CL:INCF INTEXP))) + (CL:CHAR= (CL:CHAR MANTSTR (CL:1- DIGITS)) + #\0)) DO (CL:DECF DIGITS) + (CL:INCF INTEXP))) (CL:SETF (CL:FILL-POINTER *DIGIT-STRING*) 0) [COND @@ -187,12 +188,11 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (SETQ DIGITS (CL:1- (CL:LENGTH *DIGIT-STRING*))) (IF DECPLACES THEN + (* ;; "Need extra 0s to get enough decimal places") - (* ;; "Need extra 0s to get enough decimal places") - - (CL:DOTIMES (I (- DECPLACES (- DIGITS DECPNT))) - (STRPUT #\0) - (CL:INCF DIGITS))) + (CL:DOTIMES (I (- DECPLACES (- DIGITS DECPNT))) + (STRPUT #\0) + (CL:INCF DIGITS))) (CL:VALUES *DIGIT-STRING* (CL:1+ DIGITS) (= DECPNT 0) (= DECPNT DIGITS) @@ -207,7 +207,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (*FORMAT-LENGTH* (CL:LENGTH STRING)) (*FORMAT-INDEX* 0)) ,@FORMS) - (FORMAT-ERROR (C) + (FORMAT-ERROR (C) (CL:ERROR 'FORMAT-ERROR :ARGS (CONS (LIST "While processing indirect control string~%%~S~%%~V@T^" *FORMAT-CONTROL-STRING* (CL:1+ @@ -229,17 +229,17 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri '(CL:IF *FORMAT-ARGUMENTS* (CL:POP *FORMAT-ARGUMENTS*) - (FORMAT-ERROR "Missing argument"))) + (FORMAT-ERROR "Missing argument"))) (DEFMACRO WITH-FORMAT-PARAMETERS (PARMVAR PARMDEFS &BODY FORMS) (* ;; "This macro decomposes the argument list returned by PARSE-FORMAT-OPERATION. PARMVAR is the list of parameters. PARMDEFS is a list of lists of the form ( ) . The FORMS are evaluated in an environment where each is bound to either the value of the parameter supplied in the parameter list, or to its value if the parameter was omitted or explicitly defaulted.") `(LET ,[FOR PARMDEF IN PARMDEFS COLLECT `(,(CL:FIRST PARMDEF) - (OR (CL:IF ,PARMVAR - (POP ,PARMVAR)) - ,(CL:SECOND PARMDEF] - (CL:WHEN ,PARMVAR (FORMAT-ERROR "Too many parameters")) + (OR (CL:IF ,PARMVAR + (POP ,PARMVAR)) + ,(CL:SECOND PARMDEF] + (CL:WHEN ,PARMVAR (FORMAT-ERROR "Too many parameters")) ,@FORMS)) (DEFMACRO NEXTCHAR () @@ -249,7 +249,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri '(CL:IF (< (CL:INCF *FORMAT-INDEX*) *FORMAT-LENGTH*) (CL:CHAR *FORMAT-CONTROL-STRING* *FORMAT-INDEX*) - (FORMAT-ERROR "Syntax error"))) + (FORMAT-ERROR "Syntax error"))) (DEFMACRO FORMAT-PEEK () @@ -267,41 +267,41 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Attempts to parse a parameter, starting at the current index. Returns the value of the parameter, or NIL if none is found. On exit, *format-index* points to the first character which is not a part of the recognized parameter.") - (LET [(NUMSIGN (CASE (FORMAT-PEEK) + (LET [(NUMSIGN (CASE (FORMAT-PEEK) (#\+ - (NEXTCHAR) + (NEXTCHAR) NIL) (#\- - (NEXTCHAR) + (NEXTCHAR) T) (T NIL))] - (CASE (FORMAT-PEEK) + (CASE (FORMAT-PEEK) (#\# - (NEXTCHAR) + (NEXTCHAR) (CL:LENGTH *FORMAT-ARGUMENTS*)) - ((#\V #\v) (PROG1 (POP-FORMAT-ARG) - (NEXTCHAR))) - (#\' (PROG1 (NEXTCHAR) - (NEXTCHAR))) - ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (CL:DO* [(CL:NUMBER (CL:DIGIT-CHAR-P ( - FORMAT-PEEK + ((#\V #\v) (PROG1 (POP-FORMAT-ARG) + (NEXTCHAR))) + (#\' (PROG1 (NEXTCHAR) + (NEXTCHAR))) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (CL:DO* [(CL:NUMBER (CL:DIGIT-CHAR-P ( + FORMAT-PEEK )) (+ (CL:* 10 CL:NUMBER) - (CL:DIGIT-CHAR-P ( - FORMAT-PEEK + (CL:DIGIT-CHAR-P ( + FORMAT-PEEK ] - ((NOT (CL:DIGIT-CHAR-P (NEXTCHAR))) + ((NOT (CL:DIGIT-CHAR-P (NEXTCHAR))) (CL:IF NUMSIGN (- CL:NUMBER) CL:NUMBER)))) (T NIL)))) (CL:DEFUN PARSE-FORMAT-OPERATION () -  (* amd " 1-May-86 14:33") + (* amd " 1-May-86 14:33") (* ;; "Parses a format directive, including flags and parameters. On entry, *format-index* should point to the '~' preceding the command. On exit, *format-index* points to the command character itself. Returns the list of parameters, the ':' flag, the '@' flag, and the command character as multiple values. Explicitly defaulted parameters appear in the list of parameters as NIL. Omitted parameters are simply not included in the list at all. *") - (LET ((CH (NEXTCHAR)) + (LET ((CH (NEXTCHAR)) PARMS COLON ATSIGN) (* ;; "First get the parameters") @@ -310,26 +310,26 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:MEMBER CH '(#\, #\# #\V #\v #\') :TEST (FUNCTION CL:CHAR=))) - (CL:DO ((PARMS (LIST (FORMAT-GET-PARAMETER)) - (CONS (FORMAT-GET-PARAMETER) + (CL:DO ((PARMS (LIST (FORMAT-GET-PARAMETER)) + (CONS (FORMAT-GET-PARAMETER) PARMS))) - ((CL:CHAR/= (FORMAT-PEEK) + ((CL:CHAR/= (FORMAT-PEEK) #\,) (CL:NREVERSE PARMS)) - (NEXTCHAR)) + (NEXTCHAR)) 'NIL)) (* ;; "Then check for : and @ (not necessarily in that order)") - [CL:LOOP (CASE (FORMAT-PEEK) + [CL:LOOP (CASE (FORMAT-PEEK) (#\: (CL:IF COLON (RETURN NIL) - (SETQ COLON (NEXTCHAR)))) + (SETQ COLON (NEXTCHAR)))) (#\@ (CL:IF ATSIGN (RETURN NIL) - (SETQ ATSIGN (NEXTCHAR)))) + (SETQ ATSIGN (NEXTCHAR)))) (T (RETURN NIL)))] - (CL:VALUES PARMS COLON ATSIGN (FORMAT-PEEK)))) + (CL:VALUES PARMS COLON ATSIGN (FORMAT-PEEK)))) (CL:DEFUN FORMAT-FIND-COMMAND (COMMAND-LIST) @@ -337,30 +337,30 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri [LET ((START *FORMAT-INDEX*)) (CL:DO ((PLACE START *FORMAT-INDEX*) - (TILDE (FORMAT-FIND-CHAR #\~ START *FORMAT-LENGTH*) - (FORMAT-FIND-CHAR #\~ PLACE *FORMAT-LENGTH*))) + (TILDE (FORMAT-FIND-CHAR #\~ START *FORMAT-LENGTH*) + (FORMAT-FIND-CHAR #\~ PLACE *FORMAT-LENGTH*))) ((NOT TILDE) - (FORMAT-ERROR "Expecting one of ~S" COMMAND-LIST)) + (FORMAT-ERROR "Expecting one of ~S" COMMAND-LIST)) (SETQ *FORMAT-INDEX* TILDE) [CL:MULTIPLE-VALUE-BIND (PARMS COLON ATSIGN COMMAND) - (PARSE-FORMAT-OPERATION) + (PARSE-FORMAT-OPERATION) (CL:WHEN (MEMBER COMMAND COMMAND-LIST :TEST (FUNCTION CL:CHAR=)) (RETURN (CL:VALUES START TILDE PARMS COLON ATSIGN COMMAND))) NIL (CASE COMMAND (#\{ - (NEXTCHAR) - (FORMAT-FIND-COMMAND '(#\}))) + (NEXTCHAR) + (FORMAT-FIND-COMMAND '(#\}))) (#\< - (NEXTCHAR) - (FORMAT-FIND-COMMAND '(#\>))) + (NEXTCHAR) + (FORMAT-FIND-COMMAND '(#\>))) (#\( - (NEXTCHAR) - (FORMAT-FIND-COMMAND '(#\)))) + (NEXTCHAR) + (FORMAT-FIND-COMMAND '(#\)))) (#\[ - (NEXTCHAR) - (FORMAT-FIND-COMMAND '(#\]))) - ((#\} #\> #\) #\]) (FORMAT-ERROR "No matching bracket")))])]) + (NEXTCHAR) + (FORMAT-FIND-COMMAND '(#\]))) + ((#\} #\> #\) #\]) (FORMAT-ERROR "No matching bracket")))])]) (CL:DEFUN CL:FORMAT (CL::DESTINATION CL::CONTROL-STRING &REST CL::FORMAT-ARGUMENTS) [LET ((*FORMAT-ORIGINAL-ARGUMENTS* CL::FORMAT-ARGUMENTS) @@ -371,12 +371,12 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:CATCH 'FORMAT-COLON-ESCAPE ,@CL::BODY))] (COND [(NOT CL::DESTINATION) - (FORMAT-STRINGIFY-OUTPUT (CL::WITH-FORMAT-ESCAPES (SUB-FORMAT 0 (CL:LENGTH + (FORMAT-STRINGIFY-OUTPUT (CL::WITH-FORMAT-ESCAPES (SUB-FORMAT 0 (CL:LENGTH CL::CONTROL-STRING ] ((CL:STRINGP CL::DESTINATION) [CL:WITH-OUTPUT-TO-STRING (*STANDARD-OUTPUT* CL::DESTINATION) - (CL::WITH-FORMAT-ESCAPES (SUB-FORMAT 0 (CL:LENGTH CL::CONTROL-STRING] + (CL::WITH-FORMAT-ESCAPES (SUB-FORMAT 0 (CL:LENGTH CL::CONTROL-STRING] NIL) (T (LET [(*STANDARD-OUTPUT* (CL:IF (EQ CL::DESTINATION T) *STANDARD-OUTPUT* @@ -384,7 +384,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; " FORMAT extension - IL:DESTINATION may be anything that IL:GETSTREAM can coerce into being a stream") (GETSTREAM CL::DESTINATION 'OUTPUT))] - (CL::WITH-FORMAT-ESCAPES (SUB-FORMAT 0 (CL:LENGTH CL::CONTROL-STRING))) + (CL::WITH-FORMAT-ESCAPES (SUB-FORMAT 0 (CL:LENGTH CL::CONTROL-STRING))) NIL]) (CL:DEFUN SUB-FORMAT (START END) @@ -395,19 +395,19 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (*FORMAT-LENGTH* END)) (DECLARE (CL:SPECIAL *FORMAT-INDEX* *FORMAT-LENGTH*)) (CL:DO* ((PLACE START *FORMAT-INDEX*) - (TILDE (FORMAT-FIND-CHAR #\~ START END) - (FORMAT-FIND-CHAR #\~ PLACE END))) + (TILDE (FORMAT-FIND-CHAR #\~ START END) + (FORMAT-FIND-CHAR #\~ PLACE END))) ((NOT TILDE) (WRITE-STRING* *FORMAT-CONTROL-STRING* *STANDARD-OUTPUT* PLACE END)) (CL:WHEN (> TILDE PLACE) (WRITE-STRING* *FORMAT-CONTROL-STRING* *STANDARD-OUTPUT* PLACE TILDE)) (SETQ *FORMAT-INDEX* TILDE) [CL:MULTIPLE-VALUE-BIND (PARMS COLON ATSIGN COMMAND) - (PARSE-FORMAT-OPERATION) + (PARSE-FORMAT-OPERATION) (LET [(CMDFUN (CL:AREF *FORMAT-DISPATCH-TABLE* (CL:CHAR-CODE COMMAND] (CL:IF CMDFUN (CL:FUNCALL CMDFUN COLON ATSIGN PARMS) - (FORMAT-ERROR "Illegal FORMAT command ~~~C" COMMAND))] + (FORMAT-ERROR "Illegal FORMAT command ~~~C" COMMAND))] (CL:UNLESS (< (CL:INCF *FORMAT-INDEX*) END) (RETURN)))]) @@ -416,18 +416,18 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Capitalize ~(") - (CL:WHEN PARMS (FORMAT-ERROR "No parameters allowed to ~~(")) - (NEXTCHAR) + (CL:WHEN PARMS (FORMAT-ERROR "No parameters allowed to ~~(")) + (NEXTCHAR) [CL:MULTIPLE-VALUE-BIND (PREV TILDE END-PARMS END-COLON END-ATSIGN) - (FORMAT-FIND-COMMAND '(#\))) + (FORMAT-FIND-COMMAND '(#\))) (CL:WHEN (OR END-PARMS END-COLON END-ATSIGN) - (FORMAT-ERROR "Flags or parameters not allowed")) + (FORMAT-ERROR "Flags or parameters not allowed")) (LET* [(ESCAPE NIL) - (STRING (FORMAT-STRINGIFY-OUTPUT (SETQ ESCAPE 'FORMAT-COLON-ESCAPE) + (STRING (FORMAT-STRINGIFY-OUTPUT (SETQ ESCAPE 'FORMAT-COLON-ESCAPE) (CL:CATCH 'FORMAT-COLON-ESCAPE (LET ((SUB-ESCAPE 'FORMAT-ESCAPE)) (CL:CATCH 'FORMAT-ESCAPE - (SUB-FORMAT PREV TILDE) + (SUB-FORMAT PREV TILDE) (SETQ SUB-ESCAPE NIL)) (CL:SETQ ESCAPE SUB-ESCAPE)))] [WRITE-STRING* (COND @@ -450,7 +450,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Up and Out (Escape) ~^") - (CL:WHEN ATSIGN (FORMAT-ERROR "FORMAT command ~~~:[~;:~]@^ is undefined" COLON)) + (CL:WHEN ATSIGN (FORMAT-ERROR "FORMAT command ~~~:[~;:~]@^ is undefined" COLON)) (CL:WHEN (CL:IF (CL:FIRST PARMS) (CL:IF (CL:SECOND PARMS) (CL:IF (CL:THIRD PARMS) @@ -473,109 +473,109 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:DEFUN FORMAT-SEMICOLON-ERROR (COLON ATSIGN PARAMS) (DECLARE (IGNORE COLON ATSIGN PARAMS)) - (FORMAT-ERROR "Unexpected semicolon (probably a missing ~~ somewhere).")) + (FORMAT-ERROR "Unexpected semicolon (probably a missing ~~ somewhere).")) (CL:DEFUN FORMAT-UNTAGGED-CONDITION () (* ;; "~[") - [LET ((TEST (POP-FORMAT-ARG))) + [LET ((TEST (POP-FORMAT-ARG))) (CL:UNLESS (CL:INTEGERP TEST) - (FORMAT-ERROR "Argument to ~~[ must be integer - ~S" TEST)) + (FORMAT-ERROR "Argument to ~~[ must be integer - ~S" TEST)) (CL:DO ((CL:COUNT 0 (CL:1+ CL:COUNT))) [(= CL:COUNT TEST) (CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN CMD) - (FORMAT-FIND-COMMAND '(#\; #\])) + (FORMAT-FIND-COMMAND '(#\; #\])) (DECLARE (IGNORE COLON)) - (CL:WHEN ATSIGN (FORMAT-ERROR "Atsign flag not allowed")) - (CL:WHEN PARMS (FORMAT-ERROR "No parameters allowed")) - (SUB-FORMAT PREV TILDE) + (CL:WHEN ATSIGN (FORMAT-ERROR "Atsign flag not allowed")) + (CL:WHEN PARMS (FORMAT-ERROR "No parameters allowed")) + (SUB-FORMAT PREV TILDE) (CL:UNLESS (CL:CHAR= CMD #\]) - (FORMAT-FIND-COMMAND '(#\])))] + (FORMAT-FIND-COMMAND '(#\])))] (CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN CMD) - (FORMAT-FIND-COMMAND '(#\; #\])) + (FORMAT-FIND-COMMAND '(#\; #\])) (DECLARE (IGNORE PREV TILDE)) - (CL:WHEN ATSIGN (FORMAT-ERROR "Atsign flag not allowed")) - (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) + (CL:WHEN ATSIGN (FORMAT-ERROR "Atsign flag not allowed")) + (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) (CL:WHEN (CL:CHAR= CMD #\]) (RETURN)) (CL:WHEN COLON - (NEXTCHAR) + (NEXTCHAR) [CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN CMD) - (FORMAT-FIND-COMMAND '(#\; #\])) + (FORMAT-FIND-COMMAND '(#\; #\])) (DECLARE (IGNORE PARMS COLON ATSIGN)) - (SUB-FORMAT PREV TILDE) + (SUB-FORMAT PREV TILDE) (CL:UNLESS (CL:CHAR= CMD #\]) - (FORMAT-FIND-COMMAND '(#\])))] + (FORMAT-FIND-COMMAND '(#\])))] (RETURN)) - (NEXTCHAR)))]) + (NEXTCHAR)))]) (CL:DEFUN FORMAT-FUNNY-CONDITION () (* ;; "~@[ ") (CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN) - (FORMAT-FIND-COMMAND '(#\])) + (FORMAT-FIND-COMMAND '(#\])) (CL:WHEN (OR COLON ATSIGN PARMS) - (FORMAT-ERROR "Flags or arguments not allowed")) + (FORMAT-ERROR "Flags or arguments not allowed")) (CL:IF *FORMAT-ARGUMENTS* (CL:IF (CAR *FORMAT-ARGUMENTS*) - (SUB-FORMAT PREV TILDE) + (SUB-FORMAT PREV TILDE) (CL:POP *FORMAT-ARGUMENTS*)) - (FORMAT-ERROR "Missing argument")))) + (FORMAT-ERROR "Missing argument")))) (CL:DEFUN FORMAT-BOOLEAN-CONDITION () (* ;; "~:[") [CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN) - (FORMAT-FIND-COMMAND '(#\;)) + (FORMAT-FIND-COMMAND '(#\;)) (CL:WHEN (OR PARMS COLON ATSIGN) - (FORMAT-ERROR "Flags or parameters not allowed")) - (NEXTCHAR) - (CL:IF (POP-FORMAT-ARG) + (FORMAT-ERROR "Flags or parameters not allowed")) + (NEXTCHAR) + (CL:IF (POP-FORMAT-ARG) (CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN) - (FORMAT-FIND-COMMAND '(#\])) + (FORMAT-FIND-COMMAND '(#\])) (CL:WHEN (OR COLON ATSIGN PARMS) - (FORMAT-ERROR "Flags or parameters not allowed")) - (SUB-FORMAT PREV TILDE)) - [PROGN (SUB-FORMAT PREV TILDE) - (FORMAT-FIND-COMMAND '(#\]])]) + (FORMAT-ERROR "Flags or parameters not allowed")) + (SUB-FORMAT PREV TILDE)) + [PROGN (SUB-FORMAT PREV TILDE) + (FORMAT-FIND-COMMAND '(#\]])]) (CL:DEFUN FORMAT-CONDITION (COLON ATSIGN PARMS) (CL:WHEN PARMS (CL:PUSH (POP PARMS) *FORMAT-ARGUMENTS*) (CL:UNLESS (NULL PARMS) - (FORMAT-ERROR "Too many parameters to ~["))) - (NEXTCHAR) + (FORMAT-ERROR "Too many parameters to ~["))) + (NEXTCHAR) (COND - (COLON (CL:WHEN ATSIGN (FORMAT-ERROR "~~:@[ undefined")) - (FORMAT-BOOLEAN-CONDITION)) - (ATSIGN (FORMAT-FUNNY-CONDITION)) - (T (FORMAT-UNTAGGED-CONDITION)))) + (COLON (CL:WHEN ATSIGN (FORMAT-ERROR "~~:@[ undefined")) + (FORMAT-BOOLEAN-CONDITION)) + (ATSIGN (FORMAT-FUNNY-CONDITION)) + (T (FORMAT-UNTAGGED-CONDITION)))) (CL:DEFUN FORMAT-ITERATION (COLON ATSIGN PARMS) (* ;; "Iteration ~{ ... ~}") - [WITH-FORMAT-PARAMETERS PARMS ((MAX-ITER -1)) - (NEXTCHAR) + [WITH-FORMAT-PARAMETERS PARMS ((MAX-ITER -1)) + (NEXTCHAR) (CL:MULTIPLE-VALUE-BIND (PREV TILDE END-PARMS END-COLON END-ATSIGN) - (FORMAT-FIND-COMMAND '(#\})) + (FORMAT-FIND-COMMAND '(#\})) (CL:WHEN (OR END-ATSIGN END-PARMS) - (FORMAT-ERROR "Illegal terminator for ~~{")) + (FORMAT-ERROR "Illegal terminator for ~~{")) (CL:IF (= PREV TILDE) - (LET ((STRING (POP-FORMAT-ARG))) + (LET ((STRING (POP-FORMAT-ARG))) (* ;; "Use an argument as the control string if ~{~} is empty") (CL:UNLESS (CL:STRINGP STRING) - (FORMAT-ERROR "Control string is not a string")) - (FORMAT-WITH-CONTROL-STRING STRING (FORMAT-DO-ITERATION 0 *FORMAT-LENGTH* + (FORMAT-ERROR "Control string is not a string")) + (FORMAT-WITH-CONTROL-STRING STRING (FORMAT-DO-ITERATION 0 *FORMAT-LENGTH* MAX-ITER COLON ATSIGN END-COLON)) ) - (FORMAT-DO-ITERATION PREV TILDE MAX-ITER COLON ATSIGN END-COLON))]) + (FORMAT-DO-ITERATION PREV TILDE MAX-ITER COLON ATSIGN END-COLON))]) (CL:DEFUN FORMAT-DO-ITERATION (START END MAX-ITER COLON ATSIGN AT-LEAST-ONCE-P) @@ -592,16 +592,16 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri T)] (CL:CATCH 'FORMAT-ESCAPE (CL:IF COLON - (LET* ((*ORIGINAL-ARGUMENTS* (POP-FORMAT-ARG)) + (LET* ((*ORIGINAL-ARGUMENTS* (POP-FORMAT-ARG)) (*FORMAT-ARGUMENTS* *ORIGINAL-ARGUMENTS*)) (CL:UNLESS (CL:LISTP *FORMAT-ARGUMENTS*) - (FORMAT-ERROR "Argument must be a list")) - (SUB-FORMAT START END)) - (SUB-FORMAT START END)))) - [LET* ((*ORIGINAL-ARGUMENTS* (POP-FORMAT-ARG)) + (FORMAT-ERROR "Argument must be a list")) + (SUB-FORMAT START END)) + (SUB-FORMAT START END)))) + [LET* ((*ORIGINAL-ARGUMENTS* (POP-FORMAT-ARG)) (*FORMAT-ARGUMENTS* *ORIGINAL-ARGUMENTS*)) (CL:UNLESS (CL:LISTP *FORMAT-ARGUMENTS*) - (FORMAT-ERROR "Argument must be a list")) + (FORMAT-ERROR "Argument must be a list")) (CL:DO ((CL:COUNT 0 (CL:1+ CL:COUNT))) [(OR (= CL:COUNT MAX-ITER) (AND (NULL *FORMAT-ARGUMENTS*) @@ -610,29 +610,29 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri T)] (CL:CATCH 'FORMAT-ESCAPE (CL:IF COLON - (LET* ((*ORIGINAL-ARGUMENTS* (POP-FORMAT-ARG)) + (LET* ((*ORIGINAL-ARGUMENTS* (POP-FORMAT-ARG)) (*FORMAT-ARGUMENTS* *ORIGINAL-ARGUMENTS*)) (CL:UNLESS (CL:LISTP *FORMAT-ARGUMENTS*) - (FORMAT-ERROR "Argument must be a list of lists")) - (SUB-FORMAT START END)) - (SUB-FORMAT START END))))])))) + (FORMAT-ERROR "Argument must be a list of lists")) + (SUB-FORMAT START END)) + (SUB-FORMAT START END))))])))) (CL:DEFUN FORMAT-GET-TRAILING-SEGMENTS () (* ;; "Parses a list of clauses delimited by ~ and terminated by ~>. Recursively invoke SUB-FORMAT to process them, and return a list of the results, the length of this list, and the total number of characters in the strings composing the list.") - (NEXTCHAR) + (NEXTCHAR) [CL:MULTIPLE-VALUE-BIND (PREV TILDE COLON ATSIGN PARMS CMD) - (FORMAT-FIND-COMMAND '(#\; #\>)) - (CL:WHEN COLON (FORMAT-ERROR "~~:; allowed only after first segment in ~~<")) + (FORMAT-FIND-COMMAND '(#\; #\>)) + (CL:WHEN COLON (FORMAT-ERROR "~~:; allowed only after first segment in ~~<")) (CL:WHEN (OR ATSIGN PARMS) - (FORMAT-ERROR "Flags and parameters not allowed")) + (FORMAT-ERROR "Flags and parameters not allowed")) (LET [(STR (CL:CATCH 'FORMAT-ESCAPE - (FORMAT-STRINGIFY-OUTPUT (SUB-FORMAT PREV TILDE)))] + (FORMAT-STRINGIFY-OUTPUT (SUB-FORMAT PREV TILDE)))] (CL:IF STR (CL:IF (CL:CHAR= CMD #\;) [CL:MULTIPLE-VALUE-BIND (SEGMENTS NUMSEGS NUMCHARS) - (FORMAT-GET-TRAILING-SEGMENTS) + (FORMAT-GET-TRAILING-SEGMENTS) (CL:VALUES (CONS STR SEGMENTS) (CL:1+ NUMSEGS) (+ NUMCHARS (CL:LENGTH STR] @@ -646,12 +646,12 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Gets the first segment, which is treated specially. Call FORMAT-GET-TRAILING-SEGMENTS to get the rest.") [CL:MULTIPLE-VALUE-BIND (PREV TILDE PARMS COLON ATSIGN CMD) - (FORMAT-FIND-COMMAND '(#\; #\>)) - (CL:WHEN ATSIGN (FORMAT-ERROR "Atsign flag not allowed")) - (LET [(FIRST-SEG (FORMAT-STRINGIFY-OUTPUT (SUB-FORMAT PREV TILDE] + (FORMAT-FIND-COMMAND '(#\; #\>)) + (CL:WHEN ATSIGN (FORMAT-ERROR "Atsign flag not allowed")) + (LET [(FIRST-SEG (FORMAT-STRINGIFY-OUTPUT (SUB-FORMAT PREV TILDE] (CL:IF (CL:CHAR= CMD #\;) [CL:MULTIPLE-VALUE-BIND (SEGMENTS NUMSEGS NUMCHARS) - (FORMAT-GET-TRAILING-SEGMENTS) + (FORMAT-GET-TRAILING-SEGMENTS) (CL:IF COLON (CL:VALUES FIRST-SEG PARMS SEGMENTS NUMSEGS NUMCHARS) (CL:VALUES NIL NIL (CONS FIRST-SEG SEGMENTS) @@ -694,24 +694,24 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri COLINC))))) (CL:DEFUN FORMAT-JUSTIFICATION (COLON ATSIGN PARMS) - [WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) + [WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) (COLINC 1) (MINPAD 0) (PADCHAR #\Space)) (CL:UNLESS (AND (CL:INTEGERP MINCOL) (NOT (MINUSP MINCOL))) - (FORMAT-ERROR "Mincol must be a non-negative integer - ~S" MINCOL)) + (FORMAT-ERROR "Mincol must be a non-negative integer - ~S" MINCOL)) (CL:UNLESS (AND (CL:INTEGERP COLINC) (CL:PLUSP COLINC)) - (FORMAT-ERROR "Colinc must be a positive integer - ~S" COLINC)) + (FORMAT-ERROR "Colinc must be a positive integer - ~S" COLINC)) (CL:UNLESS (AND (CL:INTEGERP MINPAD) (NOT (MINUSP MINPAD))) - (FORMAT-ERROR "Minpad must be a non-negative integer - ~S" MINPAD)) + (FORMAT-ERROR "Minpad must be a non-negative integer - ~S" MINPAD)) (CL:UNLESS (CL:CHARACTERP PADCHAR) - (FORMAT-ERROR "Padchar must be a character - ~S" PADCHAR)) - (NEXTCHAR) + (FORMAT-ERROR "Padchar must be a character - ~S" PADCHAR)) + (NEXTCHAR) (CL:MULTIPLE-VALUE-BIND (SPECIAL-ARG SPECIAL-PARMS SEGMENTS NUMSEGS NUMCHARS) - (FORMAT-GET-SEGMENTS) + (FORMAT-GET-SEGMENTS) (LET* ([PADSEGS (CL:IF (= NUMSEGS 1) (CL:IF (AND COLON ATSIGN) 2 @@ -723,9 +723,9 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:IF ATSIGN 1 0)))] - (WIDTH (FORMAT-ROUND-COLUMNS (+ NUMCHARS (CL:* MINPAD PADSEGS)) + (WIDTH (FORMAT-ROUND-COLUMNS (+ NUMCHARS (CL:* MINPAD PADSEGS)) MINCOL COLINC)) - (SPACES (MAKE-PAD-SEGS (- WIDTH NUMCHARS) + (SPACES (MAKE-PAD-SEGS (- WIDTH NUMCHARS) PADSEGS))) (CL:IF (= NUMSEGS 1) [COND @@ -744,10 +744,10 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (NOT COLON))) (CL:PUSH '0 SPACES)))) (CL:WHEN SPECIAL-ARG - [WITH-FORMAT-PARAMETERS SPECIAL-PARMS ((SPARE 0) + [WITH-FORMAT-PARAMETERS SPECIAL-PARMS ((SPARE 0) (LINEL (OR (LINELENGTH) 72))) - (LET ((POS (OR (CHARPOS *STANDARD-OUTPUT*) + (LET ((POS (OR (CHARPOS *STANDARD-OUTPUT*) 0))) (CL:WHEN (> (+ POS WIDTH SPARE) LINEL) @@ -766,8 +766,8 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Newline ~&") (CL:WHEN (OR COLON ATSIGN) - (FORMAT-ERROR "Flags not allowed")) - (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) + (FORMAT-ERROR "Flags not allowed")) + (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) (CL:DOTIMES (I REPEAT-COUNT) (TERPRI *STANDARD-OUTPUT*)))) @@ -776,8 +776,8 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Fresh-line ~%%") (CL:WHEN (OR COLON ATSIGN) - (FORMAT-ERROR "Flags not allowed")) - (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) + (FORMAT-ERROR "Flags not allowed")) + (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) (CL:FRESH-LINE *STANDARD-OUTPUT*) (CL:DOTIMES (I (CL:1- REPEAT-COUNT)) (TERPRI *STANDARD-OUTPUT*)))) @@ -787,8 +787,8 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; " Page ~|") (CL:WHEN (OR COLON ATSIGN) - (FORMAT-ERROR "Flags not allowed")) - (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) + (FORMAT-ERROR "Flags not allowed")) + (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) (CL:DOTIMES (I REPEAT-COUNT) (CL:WRITE-CHAR #\Page)))) @@ -797,8 +797,8 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Print a tilde ~~") (CL:WHEN (OR COLON ATSIGN) - (FORMAT-ERROR "Flags not allowed")) - (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) + (FORMAT-ERROR "Flags not allowed")) + (WITH-FORMAT-PARAMETERS PARMS ((REPEAT-COUNT 1)) (CL:DOTIMES (I REPEAT-COUNT) (CL:WRITE-CHAR #\~)))) @@ -806,7 +806,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Continue control string on next line ~") - (NEXTCHAR) + (NEXTCHAR) [SETQ *FORMAT-INDEX* (LET ((NEXT-NON-WHITE (CL:POSITION-IF-NOT (FUNCTION WHITESPACE-CHAR-P) *FORMAT-CONTROL-STRING* :START *FORMAT-INDEX*))) (CL:IF NEXT-NON-WHITE @@ -814,18 +814,18 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:LENGTH *FORMAT-CONTROL-STRING*))]) (CL:DEFUN FORMAT-NEWLINE (COLON ATSIGN PARMS) - (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) + (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) (COND - (COLON (CL:WHEN ATSIGN (FORMAT-ERROR "~:@ is undefined"))) + (COLON (CL:WHEN ATSIGN (FORMAT-ERROR "~:@ is undefined"))) (ATSIGN (TERPRI *STANDARD-OUTPUT*) - (FORMAT-EAT-WHITESPACE)) - (T (FORMAT-EAT-WHITESPACE)))) + (FORMAT-EAT-WHITESPACE)) + (T (FORMAT-EAT-WHITESPACE)))) (CL:DEFUN FORMAT-PLURAL (COLON ATSIGN PARMS) (* ;; "Pluralize word ~P") - (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) + (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) (CL:WHEN COLON (* ;; "Back up one argument first ") @@ -834,9 +834,9 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:LENGTH *FORMAT-ARGUMENTS*) 1))) (CL:IF (MINUSP CDRS) - (FORMAT-ERROR "No previous argument") + (FORMAT-ERROR "No previous argument") (SETQ *FORMAT-ARGUMENTS* (CL:NTHCDR CDRS *FORMAT-ORIGINAL-ARGUMENTS*)))]) - (CL:IF (EQL (POP-FORMAT-ARG) + (CL:IF (EQL (POP-FORMAT-ARG) 1) (WRITE-STRING* (CL:IF ATSIGN "y" @@ -849,47 +849,47 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Skip arguments (relative goto) ~*") - [WITH-FORMAT-PARAMETERS PARMS ((CL:COUNT (CL:IF ATSIGN + [WITH-FORMAT-PARAMETERS PARMS ((CL:COUNT (CL:IF ATSIGN 0 1))) (COND (ATSIGN (CL:WHEN (OR (MINUSP CL:COUNT) (> CL:COUNT (CL:LENGTH *FORMAT-ORIGINAL-ARGUMENTS*))) - (FORMAT-ERROR "Illegal to go to non-existant argument")) + (FORMAT-ERROR "Illegal to go to non-existant argument")) (SETQ *FORMAT-ARGUMENTS* (CL:NTHCDR CL:COUNT *FORMAT-ORIGINAL-ARGUMENTS*))) [COLON (LET ((CDRS (- (CL:LENGTH *FORMAT-ORIGINAL-ARGUMENTS*) (CL:LENGTH *FORMAT-ARGUMENTS*) CL:COUNT))) (CL:IF (MINUSP CDRS) - (FORMAT-ERROR "Skip to nonexistant argument") + (FORMAT-ERROR "Skip to nonexistant argument") (SETQ *FORMAT-ARGUMENTS* (CL:NTHCDR CDRS *FORMAT-ORIGINAL-ARGUMENTS*)))] (T (CL:IF (> CL:COUNT (CL:LENGTH *FORMAT-ARGUMENTS*)) - (FORMAT-ERROR "Skip to nonexistant argument") + (FORMAT-ERROR "Skip to nonexistant argument") (SETQ *FORMAT-ARGUMENTS* (CL:NTHCDR CL:COUNT *FORMAT-ARGUMENTS*)))]) (CL:DEFUN FORMAT-INDIRECTION (COLON ATSIGN PARMS) (* ;; "Indirection ~?") - (CL:WHEN COLON (FORMAT-ERROR "Colon modifier not allowed")) - (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) - [LET ((STRING (POP-FORMAT-ARG))) + (CL:WHEN COLON (FORMAT-ERROR "Colon modifier not allowed")) + (CL:WHEN PARMS (FORMAT-ERROR "Parameters not allowed")) + [LET ((STRING (POP-FORMAT-ARG))) (CL:UNLESS (CL:STRINGP STRING) - (FORMAT-ERROR "Indirected control string is not a string")) - (FORMAT-WITH-CONTROL-STRING STRING (CL:IF ATSIGN - (SUB-FORMAT 0 *FORMAT-LENGTH*) - (LET ((*FORMAT-ARGUMENTS* (POP-FORMAT-ARG))) - (SUB-FORMAT 0 *FORMAT-LENGTH*)))]) + (FORMAT-ERROR "Indirected control string is not a string")) + (FORMAT-WITH-CONTROL-STRING STRING (CL:IF ATSIGN + (SUB-FORMAT 0 *FORMAT-LENGTH*) + (LET ((*FORMAT-ARGUMENTS* (POP-FORMAT-ARG))) + (SUB-FORMAT 0 *FORMAT-LENGTH*)))]) (CL:DEFUN FORMAT-TAB (COLON ATSIGN PARMS) (* ;; "Tabulation ~T") - (WITH-FORMAT-PARAMETERS + (WITH-FORMAT-PARAMETERS PARMS ((COLNUM 1) (COLINC 1)) - (CL:WHEN COLON (FORMAT-ERROR "Tab-to in pixel units not supported")) + (CL:WHEN COLON (FORMAT-ERROR "Tab-to in pixel units not supported")) (CL:DOTIMES [X (LET ((POSITION (POSITION *STANDARD-OUTPUT*))) (* ;; "Note: the first column is numbered ZERO.") @@ -911,18 +911,18 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Ascii ~A *") - [LET ((ARG (POP-FORMAT-ARG))) + [LET ((ARG (POP-FORMAT-ARG))) (CL:IF (NULL PARMS) (CL:IF ARG (CL:PRINC ARG) (CL:IF COLON (WRITE-STRING* "()") (CL:PRINC NIL))) - (WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) + (WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) (COLINC 1) (MINPAD 0) (PADCHAR #\Space)) - (FORMAT-WRITE-FIELD (CL:IF ARG + (FORMAT-WRITE-FIELD (CL:IF ARG (CL:PRINC-TO-STRING ARG) (CL:IF COLON "()" @@ -933,18 +933,18 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "S-expression ~S") - [LET ((ARG (POP-FORMAT-ARG))) + [LET ((ARG (POP-FORMAT-ARG))) (CL:IF (NULL PARMS) (CL:IF ARG (CL:PRIN1 ARG) (CL:IF COLON (WRITE-STRING* "()") (CL:PRIN1 NIL))) - (WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) + (WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) (COLINC 1) (MINPAD 0) (PADCHAR #\Space)) - (FORMAT-WRITE-FIELD (CL:IF ARG + (FORMAT-WRITE-FIELD (CL:IF ARG (CL:PRIN1-TO-STRING ARG) (CL:IF COLON "()" @@ -955,26 +955,26 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Character ~C") - [WITH-FORMAT-PARAMETERS PARMS NIL (LET ((CL:CHAR (POP-FORMAT-ARG))) + [WITH-FORMAT-PARAMETERS PARMS NIL (LET ((CL:CHAR (POP-FORMAT-ARG))) (CL:UNLESS (CL:CHARACTERP CL:CHAR) - (FORMAT-ERROR "Argument must be a character")) + (FORMAT-ERROR "Argument must be a character")) (COND ((AND (NOT COLON) (NOT ATSIGN)) (CL:WRITE-CHAR CL:CHAR)) ((AND ATSIGN (NOT COLON)) (CL:PRIN1 CL:CHAR)) - (T (FORMAT-PRINT-NAMED-CHARACTER CL:CHAR COLON]) + (T (FORMAT-PRINT-NAMED-CHARACTER CL:CHAR COLON]) (CL:DEFUN FORMAT-PRINT-NAMED-CHARACTER (CHAR LONGP) [LET* ((CH (CL:CODE-CHAR (CL:CHAR-CODE CHAR))) (NAME (CL:CHAR-NAME CH))) (* ; - "The calls to CODE-CHAR and CHAR-CODE strip funny bits") + "The calls to CODE-CHAR and CHAR-CODE strip funny bits") (COND [NAME (WRITE-STRING* (CL:STRING-CAPITALIZE (CL:PRINC-TO-STRING NAME] [(<= 0 (CL:CHAR-CODE CHAR) 31) (* ; - "Print control characters as '^' ") + "Print control characters as '^' ") (CL:WRITE-CHAR #\^) (CL:WRITE-CHAR (CL:CODE-CHAR (+ 64 (CL:CHAR-CODE CHAR] (T (CL:WRITE-CHAR CH]) @@ -1018,17 +1018,17 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:UNLESS (AND (CL:INTEGERP MINCOL) (NOT (MINUSP MINCOL))) - (FORMAT-ERROR "Mincol must be a non-negative integer - ~S" MINCOL)) + (FORMAT-ERROR "Mincol must be a non-negative integer - ~S" MINCOL)) (CL:UNLESS (AND (CL:INTEGERP COLINC) (CL:PLUSP COLINC)) - (FORMAT-ERROR "Colinc must be a positive integer - ~S" COLINC)) + (FORMAT-ERROR "Colinc must be a positive integer - ~S" COLINC)) (CL:UNLESS (AND (CL:INTEGERP MINPAD) (NOT (MINUSP MINPAD))) - (FORMAT-ERROR "Minpad must be a non-negative integer - ~S" MINPAD)) + (FORMAT-ERROR "Minpad must be a non-negative integer - ~S" MINPAD)) (CL:UNLESS (CL:CHARACTERP PADCHAR) - (FORMAT-ERROR "Padchar must be a character - ~S" PADCHAR)) + (FORMAT-ERROR "Padchar must be a character - ~S" PADCHAR)) [LET* ((STRLEN (CL:LENGTH (THE STRING STRING))) - (WIDTH (FORMAT-ROUND-COLUMNS (+ STRLEN MINPAD) + (WIDTH (FORMAT-ROUND-COLUMNS (+ STRLEN MINPAD) MINCOL COLINC))) (COND (PADLEFT (CL:DOTIMES (I (- WIDTH STRLEN)) @@ -1042,11 +1042,11 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "This functions does most of the work for the numeric printing directives. The parameters are interpreted as defined for ~D.") - [WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) + [WITH-FORMAT-PARAMETERS PARMS ((MINCOL 0) (PADCHAR #\Space) (COMMACHAR #\,) (COMMA-INTERVAL 3)) (* ; - "comma-interval is an XCL extension.") + "comma-interval is an XCL extension.") (LET* ((*PRINT-BASE* RADIX) (*PRINT-RADIX* NIL) (TEXT (CL:PRINC-TO-STRING NUMBER))) @@ -1054,15 +1054,15 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (PROGN (* ;; "colinc = 1, minpad = 0, padleft = t ") - (FORMAT-WRITE-FIELD (CL:IF (AND (CL:PLUSP NUMBER) + (FORMAT-WRITE-FIELD (CL:IF (AND (CL:PLUSP NUMBER) PRINT-SIGN-P) (CL:IF PRINT-COMMAS-P (CL:CONCATENATE 'STRING "+" - (FORMAT-ADD-COMMAS TEXT COMMACHAR + (FORMAT-ADD-COMMAS TEXT COMMACHAR COMMA-INTERVAL)) (CL:CONCATENATE 'STRING "+" TEXT)) (CL:IF PRINT-COMMAS-P - (FORMAT-ADD-COMMAS TEXT COMMACHAR + (FORMAT-ADD-COMMAS TEXT COMMACHAR COMMA-INTERVAL) TEXT)) MINCOL 1 0 PADCHAR T)) @@ -1094,24 +1094,24 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (COND ((MINUSP N) (WRITE-STRING* "negative ") - (FORMAT-PRINT-CARDINAL-AUX (- N) + (FORMAT-PRINT-CARDINAL-AUX (- N) 0 N)) ((ZEROP N) (WRITE-STRING* "zero")) - (T (FORMAT-PRINT-CARDINAL-AUX N 0 N)))) + (T (FORMAT-PRINT-CARDINAL-AUX N 0 N)))) (CL:DEFUN FORMAT-PRINT-CARDINAL-AUX (N PERIOD ERR) [CL:MULTIPLE-VALUE-BIND (BEYOND HERE) (CL:TRUNCATE N 1000) (CL:UNLESS (<= PERIOD 10) - (FORMAT-ERROR "Number too large to print in English: ~:D" ERR)) + (FORMAT-ERROR "Number too large to print in English: ~:D" ERR)) (CL:UNLESS (ZEROP BEYOND) - (FORMAT-PRINT-CARDINAL-AUX BEYOND (CL:1+ PERIOD) + (FORMAT-PRINT-CARDINAL-AUX BEYOND (CL:1+ PERIOD) ERR)) (CL:UNLESS (ZEROP HERE) (CL:UNLESS (ZEROP BEYOND) (CL:WRITE-CHAR #\Space)) - (FORMAT-PRINT-SMALL-CARDINAL HERE) + (FORMAT-PRINT-SMALL-CARDINAL HERE) (WRITE-STRING* (CL:SVREF CARDINAL-PERIODS PERIOD)))]) (CL:DEFUN FORMAT-PRINT-ORDINAL (N) @@ -1121,7 +1121,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:MULTIPLE-VALUE-BIND (TOP BOT) (CL:TRUNCATE CL:NUMBER 100) (CL:UNLESS (ZEROP TOP) - (FORMAT-PRINT-CARDINAL (- CL:NUMBER BOT))) + (FORMAT-PRINT-CARDINAL (- CL:NUMBER BOT))) (CL:WHEN (AND (CL:PLUSP TOP) (CL:PLUSP BOT)) (CL:WRITE-CHAR #\Space)) @@ -1152,7 +1152,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Print Roman numerals") (CL:UNLESS (< 0 N 5000) - (FORMAT-ERROR "Number too large to print in old Roman numerals: ~:D" N)) + (FORMAT-ERROR "Number too large to print in old Roman numerals: ~:D" N)) (CL:DO [(CHAR-LIST '(#\D #\C #\L #\X #\V #\I) (CDR CHAR-LIST)) (VAL-LIST '(500 100 50 10 5 1) @@ -1167,7 +1167,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:DEFUN FORMAT-PRINT-ROMAN (N) (CL:UNLESS (< 0 N 4000) - (FORMAT-ERROR "Number too large to print in Roman numerals: ~:D" N)) + (FORMAT-ERROR "Number too large to print in Roman numerals: ~:D" N)) (CL:DO [(CHAR-LIST '(#\D #\C #\L #\X #\V #\I) (CDR CHAR-LIST)) (VAL-LIST '(500 100 50 10 5 1) @@ -1196,40 +1196,40 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Decimal ~D") - (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) + (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) 10 COLON ATSIGN PARMS)) (CL:DEFUN FORMAT-PRINT-BINARY (COLON ATSIGN PARMS) (* ;; "Binary ~B") - (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) + (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) 2 COLON ATSIGN PARMS)) (CL:DEFUN FORMAT-PRINT-OCTAL (COLON ATSIGN PARMS) (* ;; "Octal ~O") - (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) + (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) 8 COLON ATSIGN PARMS)) (CL:DEFUN FORMAT-PRINT-HEXADECIMAL (COLON ATSIGN PARMS) (* ;; "Hexadecimal ~X") - (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) + (FORMAT-PRINT-NUMBER (POP-FORMAT-ARG) 16 COLON ATSIGN PARMS)) (CL:DEFUN FORMAT-PRINT-RADIX (COLON ATSIGN PARMS) (* ;; "Radix ~R") - [LET ((CL:NUMBER (POP-FORMAT-ARG))) + [LET ((CL:NUMBER (POP-FORMAT-ARG))) (CL:IF (CAR PARMS) - (FORMAT-PRINT-NUMBER CL:NUMBER (pop PARMS) + (FORMAT-PRINT-NUMBER CL:NUMBER (pop PARMS) COLON ATSIGN PARMS) (CL:IF PARMS - (FORMAT-WRITE-FIELD (FORMAT-STRINGIFY-OUTPUT (FORMAT-PRINT-RADIX-AUX CL:NUMBER COLON + (FORMAT-WRITE-FIELD (FORMAT-STRINGIFY-OUTPUT (FORMAT-PRINT-RADIX-AUX CL:NUMBER COLON ATSIGN)) (CADR PARMS) 1 0 (COND @@ -1237,25 +1237,25 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (T #\Space) NIL) T) - (FORMAT-PRINT-RADIX-AUX CL:NUMBER COLON ATSIGN)))]) + (FORMAT-PRINT-RADIX-AUX CL:NUMBER COLON ATSIGN)))]) (CL:DEFUN FORMAT-PRINT-RADIX-AUX (CL:NUMBER COLON ATSIGN) (CL:IF (TYPEP CL:NUMBER 'INTEGER) (CL:IF ATSIGN (CL:IF COLON - (FORMAT-PRINT-OLD-ROMAN CL:NUMBER) - (FORMAT-PRINT-ROMAN CL:NUMBER)) + (FORMAT-PRINT-OLD-ROMAN CL:NUMBER) + (FORMAT-PRINT-ROMAN CL:NUMBER)) (CL:IF COLON - (FORMAT-PRINT-ORDINAL CL:NUMBER) - (FORMAT-PRINT-CARDINAL CL:NUMBER))) - (FORMAT-ERROR "Non-integer ~S can't be FORMATted ~~~:[~;:~]~:[~;@~]R" CL:NUMBER COLON ATSIGN))) + (FORMAT-PRINT-ORDINAL CL:NUMBER) + (FORMAT-PRINT-CARDINAL CL:NUMBER))) + (FORMAT-ERROR "Non-integer ~S can't be FORMATted ~~~:[~;:~]~:[~;@~]R" CL:NUMBER COLON ATSIGN))) (CL:DEFUN FORMAT-FIXED (COLON ATSIGN PARMS) (* ;; "Fixed-format floating point ~F") - (CL:WHEN COLON (FORMAT-ERROR "Colon flag not allowed")) - [WITH-FORMAT-PARAMETERS PARMS ((W NIL) + (CL:WHEN COLON (FORMAT-ERROR "Colon flag not allowed")) + [WITH-FORMAT-PARAMETERS PARMS ((W NIL) (D NIL) (K NIL) (OVF NIL) @@ -1263,14 +1263,14 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Note that the scale factor k defaults to nil. This is interpreted as zero by flonum-to-string, but more efficiently.") - (LET ((CL:NUMBER (POP-FORMAT-ARG))) + (LET ((CL:NUMBER (POP-FORMAT-ARG))) (CL:IF (FLOATP CL:NUMBER) - (FORMAT-FIXED-AUX CL:NUMBER W D K OVF PAD ATSIGN) + (FORMAT-FIXED-AUX CL:NUMBER W D K OVF PAD ATSIGN) (CL:IF (CL:RATIONALP CL:NUMBER) - (FORMAT-FIXED-AUX (COERCE CL:NUMBER 'FLOAT) + (FORMAT-FIXED-AUX (COERCE CL:NUMBER 'FLOAT) W D K OVF PAD ATSIGN) (LET ((*PRINT-BASE* 10)) - (FORMAT-WRITE-FIELD (CL:PRINC-TO-STRING CL:NUMBER) + (FORMAT-WRITE-FIELD (CL:PRINC-TO-STRING CL:NUMBER) W 1 0 #\Space T))))]) (CL:DEFUN FORMAT-FIXED-AUX (NUMBER W D K OVF PAD ATSIGN) @@ -1283,12 +1283,12 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:SETQ NUMBER (- NUMBER))) (* ;; - "When number is reasonable size, use FLONUM-TO-STRING, otherwise punt and PRINC it") + "When number is reasonable size, use FLONUM-TO-STRING, otherwise punt and PRINC it") (CL:IF (AND (>= NUMBER 0.001) (<= NUMBER 1.0E+7)) (CL:MULTIPLE-VALUE-BIND (STR LEN LPOINT TPOINT) - (FLONUM-TO-STRING NUMBER) + (FLONUM-TO-STRING NUMBER) (CL:WHEN LPOINT (CL:WRITE-CHAR #\0)) (WRITE-STRING* STR) (CL:WHEN TPOINT (CL:WRITE-CHAR #\0))) @@ -1297,11 +1297,11 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:WHEN (AND W (OR ATSIGN (MINUSP NUMBER))) (CL:DECF SPACELEFT)) (CL:MULTIPLE-VALUE-BIND (STR LEN LPOINT TPOINT) - (FLONUM-TO-STRING (ABS NUMBER) + (FLONUM-TO-STRING (ABS NUMBER) SPACELEFT D K) (* ;; - "if caller specifically requested no fraction digits, suppress the optional trailing zero") + "if caller specifically requested no fraction digits, suppress the optional trailing zero") (CL:WHEN (AND D (ZEROP D)) (SETQ TPOINT NIL)) @@ -1344,22 +1344,22 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "Exponential-format floating point ~E") - (CL:WHEN COLON (FORMAT-ERROR "Colon flag not allowed")) - [WITH-FORMAT-PARAMETERS PARMS ((W NIL) + (CL:WHEN COLON (FORMAT-ERROR "Colon flag not allowed")) + [WITH-FORMAT-PARAMETERS PARMS ((W NIL) (D NIL) (E NIL) (K 1) (OVF NIL) (PAD #\Space) (MARKER NIL)) - (LET ((CL:NUMBER (POP-FORMAT-ARG))) + (LET ((CL:NUMBER (POP-FORMAT-ARG))) (CL:IF (FLOATP CL:NUMBER) - (FORMAT-EXP-AUX CL:NUMBER W D E K OVF PAD MARKER ATSIGN) + (FORMAT-EXP-AUX CL:NUMBER W D E K OVF PAD MARKER ATSIGN) (CL:IF (CL:RATIONALP CL:NUMBER) - (FORMAT-EXP-AUX (COERCE CL:NUMBER 'FLOAT) + (FORMAT-EXP-AUX (COERCE CL:NUMBER 'FLOAT) W D E K OVF PAD MARKER ATSIGN) (LET ((*PRINT-BASE* 10)) - (FORMAT-WRITE-FIELD (CL:PRINC-TO-STRING CL:NUMBER) + (FORMAT-WRITE-FIELD (CL:PRINC-TO-STRING CL:NUMBER) W 1 0 #\Space T))))]) (CL:DEFUN FORMAT-EXPONENT-MARKER (CL:NUMBER) @@ -1376,7 +1376,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:IF (NOT (OR W D)) (CL:PRIN1 NUMBER) [CL:MULTIPLE-VALUE-BIND (NUM EXPT) - (SCALE-EXPONENT (ABS NUMBER)) + (SCALE-EXPONENT (ABS NUMBER)) (LET* ((EXPT (- EXPT K)) (ESTR (CL:PRINC-TO-STRING (ABS EXPT))) (ELEN (CL:IF E @@ -1403,7 +1403,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:DOTIMES (I W) (CL:WRITE-CHAR OVF))) [CL:MULTIPLE-VALUE-BIND (FSTR FLEN LPOINT TPOINT) - (FLONUM-TO-STRING NUM SPACELEFT FDIG K FMIN) + (FLONUM-TO-STRING NUM SPACELEFT FDIG K FMIN) (CL:WHEN W (CL:DECF SPACELEFT FLEN) (CL:WHEN LPOINT @@ -1431,7 +1431,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:WRITE-CHAR (CL:IF MARKER MARKER - (FORMAT-EXPONENT-MARKER NUMBER))) + (FORMAT-EXPONENT-MARKER NUMBER))) (CL:WRITE-CHAR (CL:IF (MINUSP EXPT) #\- #\+)) @@ -1447,37 +1447,37 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (* ;; "General Floating Point --- ~G") - (CL:WHEN COLON (FORMAT-ERROR "Colon flag not allowed")) - [WITH-FORMAT-PARAMETERS PARMS ((W NIL) + (CL:WHEN COLON (FORMAT-ERROR "Colon flag not allowed")) + [WITH-FORMAT-PARAMETERS PARMS ((W NIL) (D NIL) (E NIL) (K NIL) (OVF #\*) (PAD #\Space) (MARKER NIL)) - (LET ((CL:NUMBER (POP-FORMAT-ARG))) + (LET ((CL:NUMBER (POP-FORMAT-ARG))) (* ;; "The Excelsior edition does not say what to do if the argument is not a float. Here, we adopt the conventions used by ~F and ~E.") (CL:IF (FLOATP CL:NUMBER) - (FORMAT-GENERAL-AUX CL:NUMBER W D E K OVF PAD MARKER ATSIGN) + (FORMAT-GENERAL-AUX CL:NUMBER W D E K OVF PAD MARKER ATSIGN) (CL:IF (CL:RATIONALP CL:NUMBER) - (FORMAT-GENERAL-AUX (COERCE CL:NUMBER 'FLOAT) + (FORMAT-GENERAL-AUX (COERCE CL:NUMBER 'FLOAT) W D E K OVF PAD MARKER ATSIGN) (LET ((*PRINT-BASE* 10)) - (FORMAT-WRITE-FIELD (CL:PRINC-TO-STRING CL:NUMBER) + (FORMAT-WRITE-FIELD (CL:PRINC-TO-STRING CL:NUMBER) W 1 0 #\Space T))))]) (CL:DEFUN FORMAT-GENERAL-AUX (CL:NUMBER W D E K OVF PAD MARKER ATSIGN) [CL:MULTIPLE-VALUE-BIND (IGNORE N) - (SCALE-EXPONENT (ABS CL:NUMBER)) + (SCALE-EXPONENT (ABS CL:NUMBER)) (DECLARE (IGNORE IGNORE)) (* ;; "Default d if omitted. The procedure is taken directly from the definition given in the manual, and is not very efficient, since we generate the digits twice. Future maintainers are encouraged to improve on this.") (CL:UNLESS D [CL:MULTIPLE-VALUE-BIND (STR LEN) - (FLONUM-TO-STRING (ABS CL:NUMBER)) + (FLONUM-TO-STRING (ABS CL:NUMBER)) (DECLARE (IGNORE STR)) (LET [(Q (CL:IF (= LEN 1) 1 @@ -1492,28 +1492,28 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (DD (- D N))) (COND ((<= 0 DD D) - (FORMAT-FIXED-AUX CL:NUMBER WW DD NIL OVF PAD ATSIGN) + (FORMAT-FIXED-AUX CL:NUMBER WW DD NIL OVF PAD ATSIGN) (CL:DOTIMES (I EE) (CL:WRITE-CHAR #\Space))) - (T (FORMAT-EXP-AUX CL:NUMBER W D E (OR K 1) + (T (FORMAT-EXP-AUX CL:NUMBER W D E (OR K 1) OVF PAD MARKER ATSIGN]) (CL:DEFUN FORMAT-DOLLARS (COLON ATSIGN PARMS) (* ;; "Dollars floating-point format ~$") - [WITH-FORMAT-PARAMETERS PARMS ((D 2) + [WITH-FORMAT-PARAMETERS PARMS ((D 2) (N 1) (FW 0) (PAD #\Space)) - (LET* [(CL:NUMBER (POP-FORMAT-ARG)) + (LET* [(CL:NUMBER (POP-FORMAT-ARG)) (SIGNSTR (CL:IF (MINUSP CL:NUMBER) "-" (CL:IF ATSIGN "+" ""))] (CL:MULTIPLE-VALUE-BIND (STR NUMLENGTH IG2 IG3 POINTPLACE) - (FLONUM-TO-STRING (ABS CL:NUMBER) + (FLONUM-TO-STRING (ABS CL:NUMBER) NIL D NIL) (DECLARE (IGNORE IG2 IG3)) (CL:WHEN COLON (WRITE-STRING* SIGNSTR)) @@ -1546,7 +1546,7 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri "Bound to FORMAT control string") (CL:DEFVAR *FORMAT-DISPATCH-TABLE* - (MAKE-DISPATCH-VECTOR (#\B FORMAT-PRINT-BINARY) + (MAKE-DISPATCH-VECTOR (#\B FORMAT-PRINT-BINARY) (#\O FORMAT-PRINT-OCTAL) (#\D FORMAT-PRINT-DECIMAL) (#\X FORMAT-PRINT-HEXADECIMAL) @@ -1584,31 +1584,30 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (CL:DEFVAR *FORMAT-ORIGINAL-ARGUMENTS* NIL "List of original FORMAT arguments") -(CL:DEFVAR CARDINAL-ONES (NAME-ARRAY (NIL "one" "two" "three" "four" "five" "six" "seven" "eight" - "nine")) - "Table of strings used by ~R") +(CL:DEFVAR CARDINAL-ONES (NAME-ARRAY (NIL "one" "two" "three" "four" "five" "six" "seven" "eight" + "nine")) + "Table of strings used by ~R") -(CL:DEFVAR CARDINAL-TENS (NAME-ARRAY (NIL NIL "twenty" "thirty" "forty" "fifty" "sixty" "seventy" - "eighty" "ninety")) - "Table of strings used by ~R") +(CL:DEFVAR CARDINAL-TENS (NAME-ARRAY (NIL NIL "twenty" "thirty" "forty" "fifty" "sixty" "seventy" + "eighty" "ninety")) + "Table of strings used by ~R") -(CL:DEFVAR CARDINAL-TEENS (NAME-ARRAY ("ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" - "sixteen" "seventeen" "eighteen" "nineteen")) - "Table of strings used by ~R") +(CL:DEFVAR CARDINAL-TEENS (NAME-ARRAY ("ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" + "sixteen" "seventeen" "eighteen" "nineteen")) + "Table of strings used by ~R") -(CL:DEFVAR CARDINAL-PERIODS (NAME-ARRAY ("" " thousand" " million" " billion" " trillion" - " quadrillion" " quintillion" " sextillion" - " septillion" " octillion" " nonillion" " decillion") - ) - "Table of strings used by ~R") - -(CL:DEFVAR ORDINAL-ONES (NAME-ARRAY (NIL "first" "second" "third" "fourth" "fifth" "sixth" - "seventh" "eighth" "ninth")) +(CL:DEFVAR CARDINAL-PERIODS (NAME-ARRAY ("" " thousand" " million" " billion" " trillion" + " quadrillion" " quintillion" " sextillion" " septillion" + " octillion" " nonillion" " decillion")) "Table of strings used by ~R") -(CL:DEFVAR ORDINAL-TENS (NAME-ARRAY (NIL "tenth" "twentieth" "thirtieth" "fourtieth" "fiftieth" - "sixtieth" "seventieth" "eightieth" "ninetieth")) - "Table of strings used by ~R") +(CL:DEFVAR ORDINAL-ONES (NAME-ARRAY (NIL "first" "second" "third" "fourth" "fifth" "sixth" "seventh" + "eighth" "ninth")) + "Table of strings used by ~R") + +(CL:DEFVAR ORDINAL-TENS (NAME-ARRAY (NIL "tenth" "twentieth" "thirtieth" "fourtieth" "fiftieth" + "sixtieth" "seventieth" "eightieth" "ninetieth")) + "Table of strings used by ~R") (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -1626,5 +1625,39 @@ Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All ri (PUTPROPS CMLFORMAT FILETYPE CL:COMPILE-FILE) (PUTPROPS CMLFORMAT COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL))) + (FILEMAP (NIL (3085 4904 (MAKE-DISPATCH-VECTOR 3085 . 4904)) (4906 5011 (SCALE-EXPONENT 4906 . 5011)) +(5013 6006 (SCALE-EXPT-AUX 5013 . 6006)) (6008 6243 (FORMAT-ERROR 6008 . 6243)) (6433 10602 ( +FLONUM-TO-STRING 6433 . 10602)) (10604 11907 (FORMAT-WITH-CONTROL-STRING 10604 . 11907)) (11909 12184 +(FORMAT-STRINGIFY-OUTPUT 11909 . 12184)) (12186 12600 (POP-FORMAT-ARG 12186 . 12600)) (12602 13448 ( +WITH-FORMAT-PARAMETERS 12602 . 13448)) (13450 13816 (NEXTCHAR 13450 . 13816)) (13818 13993 ( +FORMAT-PEEK 13818 . 13993)) (13995 14295 (FORMAT-FIND-CHAR 13995 . 14295)) (14297 16213 ( +FORMAT-GET-PARAMETER 14297 . 16213)) (16215 18074 (PARSE-FORMAT-OPERATION 16215 . 18074)) (18076 20286 + (FORMAT-FIND-COMMAND 18076 . 20286)) (20288 21882 (CL:FORMAT 20288 . 21882)) (21884 23546 (SUB-FORMAT + 21884 . 23546)) (23548 25577 (FORMAT-CAPITALIZATION 23548 . 25577)) (25579 26667 (FORMAT-ESCAPE 25579 + . 26667)) (26669 26854 (FORMAT-SEMICOLON-ERROR 26669 . 26854)) (26856 28652 ( +FORMAT-UNTAGGED-CONDITION 26856 . 28652)) (28654 29161 (FORMAT-FUNNY-CONDITION 28654 . 29161)) (29163 +29920 (FORMAT-BOOLEAN-CONDITION 29163 . 29920)) (29922 30378 (FORMAT-CONDITION 29922 . 30378)) (30380 +31468 (FORMAT-ITERATION 30380 . 31468)) (31470 33889 (FORMAT-DO-ITERATION 31470 . 33889)) (33891 35210 + (FORMAT-GET-TRAILING-SEGMENTS 33891 . 35210)) (35212 36310 (FORMAT-GET-SEGMENTS 35212 . 36310)) ( +36312 37520 (MAKE-PAD-SEGS 36312 . 37520)) (37522 38015 (FORMAT-ROUND-COLUMNS 37522 . 38015)) (38017 +41910 (FORMAT-JUSTIFICATION 38017 . 41910)) (41912 42208 (FORMAT-TERPRI 41912 . 42208)) (42210 42565 ( +FORMAT-FRESHLINE 42210 . 42565)) (42567 42856 (FORMAT-PAGE 42567 . 42856)) (42858 43152 (FORMAT-TILDE +42858 . 43152)) (43154 43652 (FORMAT-EAT-WHITESPACE 43154 . 43652)) (43654 43976 (FORMAT-NEWLINE 43654 + . 43976)) (43978 44769 (FORMAT-PLURAL 43978 . 44769)) (44771 46026 (FORMAT-SKIP-ARGUMENTS 44771 . +46026)) (46028 46732 (FORMAT-INDIRECTION 46028 . 46732)) (46734 47917 (FORMAT-TAB 46734 . 47917)) ( +47919 48820 (FORMAT-PRINC 47919 . 48820)) (48822 49728 (FORMAT-PRIN1 48822 . 49728)) (49730 50556 ( +FORMAT-PRINT-CHARACTER 49730 . 50556)) (50558 51290 (FORMAT-PRINT-NAMED-CHARACTER 50558 . 51290)) ( +51292 52935 (FORMAT-ADD-COMMAS 51292 . 52935)) (52937 54401 (FORMAT-WRITE-FIELD 52937 . 54401)) (54403 + 56227 (FORMAT-PRINT-NUMBER 54403 . 56227)) (56229 57234 (FORMAT-PRINT-SMALL-CARDINAL 56229 . 57234)) +(57236 57499 (FORMAT-PRINT-CARDINAL 57236 . 57499)) (57501 58119 (FORMAT-PRINT-CARDINAL-AUX 57501 . +58119)) (58121 59655 (FORMAT-PRINT-ORDINAL 58121 . 59655)) (59657 60323 (FORMAT-PRINT-OLD-ROMAN 59657 + . 60323)) (60325 61507 (FORMAT-PRINT-ROMAN 60325 . 61507)) (61509 61676 (FORMAT-PRINT-DECIMAL 61509 + . 61676)) (61678 61842 (FORMAT-PRINT-BINARY 61678 . 61842)) (61844 62006 (FORMAT-PRINT-OCTAL 61844 . +62006)) (62008 62183 (FORMAT-PRINT-HEXADECIMAL 62008 . 62183)) (62185 62942 (FORMAT-PRINT-RADIX 62185 + . 62942)) (62944 63430 (FORMAT-PRINT-RADIX-AUX 62944 . 63430)) (63432 64483 (FORMAT-FIXED 63432 . +64483)) (64485 67230 (FORMAT-FIXED-AUX 64485 . 67230)) (67232 68253 (FORMAT-EXPONENTIAL 67232 . 68253) +) (68255 68469 (FORMAT-EXPONENT-MARKER 68255 . 68469)) (68471 72406 (FORMAT-EXP-AUX 68471 . 72406)) ( +72408 73593 (FORMAT-GENERAL-FLOAT 72408 . 73593)) (73595 74953 (FORMAT-GENERAL-AUX 73595 . 74953)) ( +74955 76181 (FORMAT-DOLLARS 74955 . 76181)) (76183 76354 (CHARPOS 76183 . 76354)) (76356 76509 ( +WHITESPACE-CHAR-P 76356 . 76509)) (76511 76642 (NAME-ARRAY 76511 . 76642))))) STOP diff --git a/sources/CMLFORMAT.LCOM b/sources/CMLFORMAT.LCOM index 9ea2eae1241742949ba6519b72568997506d3281..97a834f0e110d95c45608c53e2a4de5ae5c5cd02 100644 GIT binary patch delta 5964 zcmb^#d2m$qd6wJ{$U!#u^~(lu6L?{->=hF8vilM?*(-aP5Fi+m0BJ4~jzE!HDn%5+ zPeH9>tl%gRlCT;gH+Gy_YHgT0?bNnbs-4kJ3o=e;w4(I;_Pw{+(6n`?{pZ`?zW3et z@4d4p;`*M5L)AMNMpuB#@!wOHz z*Y|AfYiV0wZgJSFTpkDKD=yU(k{we8>dhK0$OHiji_75##aPs?RYBT8Y?a?`C*cYf z7Z)o?Yx4$BYdStAMd5$5ZiiW={=b<+3?`G#NX%{z|B%h)_p(;-DVU_@E-@*H=s@m&^Pswrp?{M#$QU{iFQ<(&Ja8JC(Fia$0-rWV_yOKDrO4HZ$8nWr3NF$tn7TE%jjcNjTAZj&0^Srzk zcz9+tzz=5Dr!hiSu)N3P^01tz+DptD<5)%Fz!U~4(on->rE3NI(@llM^W@l*eoP}X1K9=)01W^LrbG)*QAP$%sZo9zYgXCAU8KqW3%t23S z4ENbbkIBsI7?b)%glNUR3=UXwnez}Tbo57=m2mnn z6J5q+U5{aiPEC|bI#7^KzsN$|q=Ew4ko_Q>cI4zvdXnDG&W2~Ra zoL0_bWnF%s+wUtX1kI3obq+>Vb)a`SxcbVMifF}G0t2t|I*eMD6@refPIU*$zOD3?T;H4R&mU;8n!kc~b*8u!{z8+w&F-^d#eBi1q9V$x|;ze{N zBq#)2oLShO!VtBQD7;&`H#Bc1ZGC+`eV7&lyj)-~Qux^nVEEj^8i0RZh=QCf3L0b4 zr5~|an71{L#!6`nkK|&k4{Dp~Eq3M%4CbOVP@|9mi_C)iIF(AJ7Ti~{$Qh|p8}yVe zYA<4xx=@-!S-JUOADBv~6X@N3T_>9(enK4s!31Afy~0FR^0M^YK3X`0y4QFAUJ zOqiE~Hbw(2F71c57K*aP1)YcGCu2>ol_I|2F~A3p{Y!XZ+KJ&E>Ca67vkU~nVl<$I zdYV+49C&i^S7_qC2Tf5>S|$T+uPLCPJ-9eI)M$ee1y7Ci6KY>4r=1la1C5)*$v4U^ z0(g_l1bCOL6l={=S)M0x@H>56bu|z5>~dOdKAX!KwG7W8>;#N4p%_| z!*q_tgiuxy6SS^ms;a&qvi`i<8e(1Pa@l##c^_vb9a@}Ei(In}EJ-`ImTD?TO*1iO2N9`Fi7$x1=_dH$eutushS}h%Q3@1UF zYKhs2i=17ks$QoY%Ggen8sg?W4sRj)TL-QOlE5+NyXf(bI&2kVb&teCYXJrd3sv>! z(WM^PP3UtTY{9a6g&4hCo-f2iA|=#WpG~8DsX>JNXtBrvLo~G1kJDOKpL5t82{CmO zU9k5r^BDtw^&2r^=he>zSW}NJa92GJnS)v{y;Gn2?=n+XpDZd;*0A|MC*_TXBH#!0 zPY0Wdz(+b2{bkeg$tt+fFfSUs6{>Yam@ac~G~_1*(ZB#LdQPVzZaUJGLJu@ffP@vx zN`&nLwl_hyz`132Ww0Kpp;3#Gm8yllv!Vw&xJErq2aimqE1R%jMV%u+6n(F0#iYsu zk;x3UKv*!s)HY75_CTau9?V+^xG|`<5n~U{7i#T~E8j-yNmY*jW37pg2w;Xp^rl?X^p zwN_7XIC2&r?|}(Zx~3h3pW0naf3;>goK$P)g-RVT+#Z`?C04<<_EdUo?fPh;wNhE9 z3ihAieTA*^@ZKeMo0AX6{&5&)l7#8zszXRQbkFy8iD??wQ94J$@!9OwX_3C_FlI|g za4BQ!m)KzNyE%)1t)%(2d9<_h889TOi-51N!`(lnMU|a={Zxg!yB-&H`L=7a-?{C6 z4`&aV73k{LN^RgoPiK~-jknh3#?9RCfK66h&(ZDnbzKtre@J;5n}?W6>gs|1rv zN4z$(ncmry9yqt*B}}lTn{3hO3XO(ds58-$`pQ?SI<1hd7yWrCjHS|hp?5JBjz5n;g!Hr1|fIeq1k_h6K2 zb>TS)8yzk8r_vX;;TAg*l_RWFUv5i6W0)Ne0H}_p2AR;c zkBt+dvItz172j{`>roIBQFOPhY2MJjsg2-*S+Nfm$3WA*RT7i8e^{0&g%QK#V_hDr z%_(MVAbbB?(z^Tcfx1xbh?sUO>v1_aVg6G06N6%~{{93G-sYppf_aZV883-DdaxG_ ze^Nmg97=%`cPJeohWqwF5j}orvB+U?0Iyiz96~6)T{#f;HvK-OExxcK17@qIFq(+Y z5S)a(h7X6m%$dr^!&z+&Q+8wn-Agl|y7Wf+GTlE{S_{P{AUGmKHKnBk#dMQsU^F>9 z*wQBp5era*1*nGtqzR=dfzO`m!u+d0G9TdfBN*s!qQ%_5bmWF;96eeVs-7xa1AJo& zP88V9&OXzP^gYkwSpUJZEt8EF(I&6L_n!TU6yKjdUmJ3&bfvaUIyINtj~4~{UTDON zjash}=Sgta@ZhX~?E2(bYbZq|7OaEw)biprul2>JL7#uTr~sHVST2{G56F``^$d1P zd)%L1)`YUNns@ThN!j2W3mF=)AAbrhy?FvH{qjTyz+Evy;?bT#U10bXPWFIU7iz5* zYSz21xuq>sw^ok~%pD53SzAEfuf^PGMhMy6AD0Poek zuP>+W;n?qRDvbsg;DsE`L4{Aeff2v>2JW|_rx>{9^9}GB1JKZ}nlbcA@7StI6nb}z zfq(e6>m0cD9NK^^yUv9%qOs#CI582eV_Xgn$Nd@6I>zz-{q#6)yb~7-W8uq_SCp4b zza6*1&DmYt>a*w#u#2KPh61e%p@_jyZ^lUy89i! z_rCYN_r896fAE|8g9j_uQ_2dfjkCBp*2|UC3XM^;R z@1Yf1waVVut1{_njoPf$n$(f zhA`+=Ya>VR$t+6?rKpa!6HFuoZGt^pc1mP|eg zUJ0uhTM8)-al&e7Z6@fo6C(9xj$N&L@D+3%+Ih-c@#MlZ36jH z(DYSw2&}$|-Vbzu$_?Q^4^cEcPEo6Yn_=e4(|TI*@S;Tzn|D22x)K+=VfO(HLNAgt z@+#I*ZsXi}w8LtH57YAd;6qr<(ri$sqb*geo3(g3H*E;41ys}W^iUqTuREqr210Me z9tBz-X9Q}`$RHze=0wV4VIfz!I+xSIIlO|WKg4mN6qut(Mf|cEEM65`Qzxi=EZ!qa z<#`|gGb18s_(#G8F!D@dS}LWawT0jz@0thwTT|-YfG+lo{R@_7A8{_Hm9S;uJSrn9 zUX=@y(9U5N;z{ux%RLt)dSAGB3&;#DZUq{?!~k^Vk~A6RYgjTVTL`B~jUh)YD`=gb zHhVdb7h&;sH1{F!Ti9%2-dK>jFGpkCrdS!{|mHnHfTKo(13In=-F zoGt|uHR+tdNSRZPFgCk)8DFa0EPY@is+PN zJa%7WRj^bf+E(G&y|Zd5RC#_fQCXaha;w+sbOey@8I1H5 zR~uxawjH)AkeRe$QU1_24RJ2iF=WC%S^~+brOggh1PwFLo~%%xSierCjaF)CC|o!L zLELm0Lr~$n$JR9Atr^(`?Z)aw4SW3 z%^>k!oQLGKIbq^<0*45@ss{DQYcnHw&y+4&N6vW@$ri8C_g#$8%SsU zy1-EoIOPCKC}GGjUwR_n)`o~^3cSsq}y6Rm}r$Tzk22N}#%3{?6# zCyM-GeHXL<4fFFBP|_%5&`hWX<7}uUjVY2tB39r4teQEMOSFnT%)?dMVFD6{JwOha zFe41UcQ<~7+j6;43H1F&Z31Oyt2yX-q00RS`NI< z(ld1KI!||FQ;UBBgA8}Mt${OhbjzVIp^}lawuOXl$2m$kVHIx9Q)RO{xS8C^DaAB@e+^MYAc_Q>3BO1os%8OVr5WQXOjn)#FGQii}zvd8Y3?G_^wLnf|Io>kOnZD{-L&WQGm_|L*>@2wobBla7ozvVFJu z&te{K*lq=SVf!wi_wCphD{1huWdYCM-|>y;?d_c||L#C;I4nGqj~Osam9+ao`z#Jd zQu7s=*tJSj1599VJT%3hw&e6ff5McXaR-6v95@riyyb_Wr1GYi^Ju)T?vBV$9qr7Ksz*i{|yJ^9(x2YR+0M|pm0GH zSiSqNqZ;`Em<-9{130Ow4`m479zF1a80@m7bW2{KIw zH%T&YA6ns`b1`^cmD62rb%;6U%Q^gOsfB&^#A?v7FHDS2&5MiA=K%G6G?O7yN;lCLw%l45NP4~`A10}o_eL#wksJ<` zJkyDE&@NPC{5W6dkS$2a);=dG&1>ue%Xl%dY-~IeekKKKv6`#z$I7q^y||8zV&RiKa|pC z*%}CC7IB=<_w}D?K)tu0L%n}_t{Le11tPG`XHUZ84`&rXvxiC&r8t7JfWe-jPHDdS z^Ya>iCRB0`7+q{CzPAM2aGXDZcPPdnbsd=g)HFZiz*+hJS6lsvB?Z#;o%9UpeB&>$ zvL#Y|(`tX#Ov;@$8~!g6!$$i|7e14+b@9apio%oWa*7N`E>=^NQe&XucFwVO0Px90 zMG9401@nl<#acKOva4Kzx~xl?;x?6DDo&AZt`4|FLN#`?^#T`Okbip#2d1#gtS~p= ze~Z@3xbZzBN|JUmDmV{JF;~)wdN_)Fei@TNK3oQL^{~V>G#n4l$n)MXwjuej0#>oa zGy+wKI7f1T_KcWCp3g^O$R9_F;3<9-cW}q(W}qMO^w{VM(mB3>92&zrGc<8BI#vp+ z@zDE7;y4SdbH0VZ!NE%AGm^iJObd0 zTl3K(()~&(d_&ZT?ZsCxyKcRLb|D6l&^fre{5&BH2mu*SUJ*Z&pRPp0J9NJ5YB*VT z6~-=}qwA`~5qT{M?~TaP0gW>28b95Fl8$S5nLd3D$I+ey1`Ue!C7M+j} zqlPGwcLN7tK|>s@m@8l~f{fh2&AoSH9Z<(>xW$41z7;`|f4wI7%nOv<3MctDF^TTo zNGFfp#C`b9%{6|(2vTwjcl*wSGT@zTGM&6}3t1)iawj-B54C^GOr(Po=*yi6ygA7x o8)gVRIEj#MPVzq_z^B29a1t?vQR$vaBx|Pd;?g};BOHVO0KqqI8~^|S diff --git a/sources/FILEIO b/sources/FILEIO index ad5ac9a2..346ee7c0 100644 --- a/sources/FILEIO +++ b/sources/FILEIO @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 3-Jul-2022 08:55:45"  -{DSK}kaplan>local>medley3.5>working-medley>sources>FILEIO.;111 159022 +(FILECREATED " 6-Jul-2022 00:01:09"  +{DSK}kaplan>local>medley3.5>working-medley>sources>FILEIO.;113 159763 - :CHANGES-TO (VARS FILEIOCOMS) + :CHANGES-TO (FNS PUTSTREAMPROP GETSTREAMPROP \DO.PARAMS.AT.OPEN) + (RECORDS STREAM) - :PREVIOUS-DATE " 2-Jul-2022 18:55:29" -{DSK}kaplan>local>medley3.5>working-medley>sources>FILEIO.;110) + :PREVIOUS-DATE " 3-Jul-2022 08:55:45" +{DSK}kaplan>Local>medley3.5>working-medley>sources>FILEIO.;111) (* ; " @@ -229,7 +230,7 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. (DEVICE POINTER) (USERVISIBLE FLAG) (EOLCONVENTION BITS 2) - (NIL FLAG) + (READONLY-EXTERNALFORMAT FLAG) (VALIDATION POINTER) (CPAGE POINTER) (EPAGE POINTER) @@ -305,7 +306,9 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. (USERVISIBLE FLAG) (* ;  "Listed by OPENP; NIL for terminal, dribble ...") (EOLCONVENTION BITS 2) (* ; "End-of-line convention") - (NIL FLAG) (* ; "Was NOTXCCS.") + (READONLY-EXTERNALFORMAT FLAG) (* ; + "T if external format can only be set at open.") + (* ; "Was NOTXCCS.") (VALIDATION POINTER) (* ;  "A number somehow identifying file, used to determine if file has changed in our absence") (CPAGE POINTER) (* ; @@ -573,24 +576,29 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. (T (\ILLEGAL.ARG NIL]) (GETSTREAMPROP - [LAMBDA (STREAM PROP) (* ; "Edited 29-Jun-2021 17:06 by rmk:") + [LAMBDA (STREAM PROP) (* ; "Edited 5-Jul-2022 23:57 by rmk") + (* ; "Edited 29-Jun-2021 17:06 by rmk:") (* rda%: "22-Aug-84 16:17") (SELECTQ PROP - ((FORMAT EXTERNALFORMAT) + ((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT) (\EXTERNALFORMAT STREAM)) (ENDOFSTREAMOP (FETCH (STREAM ENDOFSTREAMOP) OF STREAM)) (LISTGET (fetch (STREAM OTHERPROPS) of STREAM) PROP]) (PUTSTREAMPROP - [LAMBDA (STREAM PROP VALUE) (* ; "Edited 29-Jun-2021 17:06 by rmk:") + [LAMBDA (STREAM PROP VALUE) (* ; "Edited 5-Jul-2022 23:56 by rmk") + (* ; "Edited 29-Jun-2021 17:06 by rmk:") (* rda%: "22-Aug-84 16:11") (SELECTQ PROP - ((FORMAT EXTERNALFORMAT) + ((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT) + (* ;; "Return the old name (=VALUE), not the format datum. Better design: the format should have it's name, and not have name as a separate property.") - (PROG1 (\EXTERNALFORMAT STREAM NIL) - (AND VALUE (\EXTERNALFORMAT STREAM VALUE)))) + [IF (FETCH (STREAM READONLY-EXTERNALFORMAT) OF STREAM) + THEN (ERROR "EXTERNALFORMAT CANNOT BE CHANGED" STREAM) + ELSE (PROG1 (\EXTERNALFORMAT STREAM NIL) + (AND VALUE (\EXTERNALFORMAT STREAM VALUE)))]) (ENDOFSTREAMOP (PROG1 (fetch (STREAM ENDOFSTREAMOP) of STREAM) (replace (STREAM ENDOFSTREAMOP) of STREAM with VALUE))) (PROG ((OLDDATA (fetch OTHERPROPS of STREAM)) @@ -608,12 +616,11 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. (T (for TAIL on (CDR OLDDATA) by (CDDR TAIL) when (EQ (CADR TAIL) - PROP) + PROP) do (FRPLACD TAIL (CDDDR TAIL)) - (RETURN] + (RETURN] OLDVALUE) - (VALUE (replace OTHERPROPS of STREAM with (LIST PROP - VALUE)) + (VALUE (replace OTHERPROPS of STREAM with (LIST PROP VALUE)) (* ; "know old value is NIL") NIL]) @@ -1425,10 +1432,11 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. (GO RETRY]) (\DO.PARAMS.AT.OPEN - [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 19-Dec-2021 09:30 by rmk") - (* ; "Edited 14-Dec-2021 16:10 by rmk") - (* ; "Edited 13-Dec-2021 15:20 by rmk") - (* ; "Edited 29-Jun-2021 17:07 by rmk:") + [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 6-Jul-2022 00:00 by rmk") + (* ; "Edited 19-Dec-2021 09:30 by rmk") + (* ; "Edited 14-Dec-2021 16:10 by rmk") + (* ; "Edited 13-Dec-2021 15:20 by rmk") + (* ; "Edited 29-Jun-2021 17:07 by rmk:") (* ; "Edited 5-Oct-92 13:45 by jds") (* ;; "Does generic parameters when a file/stream is open. Called by \OPENFILE and OPENSTREAM") @@ -1450,7 +1458,7 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. (BUFFERS (SETFILEINFO STREAM 'BUFFERS VAL)) (ENDOFSTREAMOP (SETFILEINFO STREAM 'ENDOFSTREAMOP VAL)) (CHARSET (CHARSET STREAM VAL)) - ((FORMAT EXTERNALFORMAT) + ((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT) (\EXTERNALFORMAT STREAM VAL)) (CONVHANKAKU (CONVHANKAKU STREAM VAL)) ((EOL EOLCONVENTION EOLC) @@ -3049,39 +3057,39 @@ update the map") (PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2020 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (27258 30736 (STREAMPROP 27268 . 27702) (GETSTREAMPROP 27704 . 28173) (PUTSTREAMPROP -28175 . 30584) (STREAMP 30586 . 30734)) (30779 33298 (\DEFPRINT.BY.NAME 30789 . 31941) ( -\STREAM.DEFPRINT 31943 . 32991) (\FDEV.DEFPRINT 32993 . 33296)) (33556 38597 (\GETACCESS 33566 . 34020 -) (\SETACCESS 34022 . 38595)) (58823 64792 (\DEFINEDEVICE 58833 . 61149) (\GETDEVICEFROMNAME 61151 . -61624) (\GETDEVICEFROMHOSTNAME 61626 . 62670) (\REMOVEDEVICE 62672 . 63795) (\REMOVEDEVICE.NAMES 63797 - . 64790)) (64832 89578 (\CLOSEFILE 64842 . 65667) (\DELETEFILE 65669 . 65963) (\DEVICEEVENT 65965 . -67735) (\GENERATEFILES 67737 . 68684) (\GENERATENEXTFILE 68686 . 69337) (\GENERATEFILEINFO 69339 . -69800) (\GETFILENAME 69802 . 70191) (\GENERIC.OUTFILEP 70193 . 70663) (\OPENFILE 70665 . 73243) ( -\DO.PARAMS.AT.OPEN 73245 . 75415) (\RENAMEFILE 75417 . 75841) (\REVALIDATEFILE 75843 . 78445) ( -\PAGED.REVALIDATEFILELST 78447 . 80005) (\PAGED.REVALIDATEFILES 80007 . 81726) (\PAGED.REVALIDATEFILE -81728 . 84011) (\BUFFERED.REVALIDATEFILE 84013 . 86299) (\BUFFERED.REVALIDATEFILELST 86301 . 87485) ( -\PRINT-REVALIDATION-RESULT 87487 . 87902) (\TRUNCATEFILE 87904 . 88295) (\FILE-CONFLICT 88297 . 89576) -) (89614 94277 (\GENERATENOFILES 89624 . 91720) (\NULLFILEGENERATOR 91722 . 91966) (\NOFILESNEXTFILEFN - 91968 . 93959) (\NOFILESINFOFN 93961 . 94275)) (94396 96304 (\FILE.NOT.OPEN 94406 . 94919) ( -\FILE.WONT.OPEN 94921 . 95249) (\ILLEGAL.DEVICEOP 95251 . 95533) (\IS.NOT.RANDACCESSP 95535 . 95981) ( -\STREAM.NOT.OPEN 95983 . 96302)) (96439 98737 (\FDEVINSTANCE 96449 . 98735)) (99939 107313 (CNDIR -99949 . 101254) (DIRECTORYNAME 101256 . 105439) (DIRECTORYNAMEP 105441 . 106057) (HOSTNAMEP 106059 . -106866) (\ADD.CONNECTED.DIR 106868 . 107311)) (107358 135238 (\BACKFILEPTR 107368 . 107556) ( -\BACKPEEKBIN 107558 . 107919) (\BACKBIN 107921 . 108272) (BIN 108274 . 108491) (\BIN 108493 . 108770) -(\BINS 108772 . 109058) (BOUT 109060 . 109422) (\BOUT 109424 . 109739) (\BOUTS 109741 . 110052) ( -COPYBYTES 110054 . 113386) (COPYCHARS 113388 . 117054) (COPYFILE 117056 . 117853) (\COPYOPENFILE -117855 . 120928) (\INFER.FILE.TYPE 120930 . 121884) (EOFP 121886 . 122183) (FORCEOUTPUT 122185 . -122432) (\FLUSH.OPEN.STREAMS 122434 . 122790) (CHARSET 122792 . 124456) (ACCESS-CHARSET 124458 . -124675) (GETEOFPTR 124677 . 124927) (GETFILEINFO 124929 . 128122) (\TYPE.FROM.FILETYPE 128124 . 128594 -) (\FILETYPE.FROM.TYPE 128596 . 128775) (GETFILEPTR 128777 . 129029) (SETFILEINFO 129031 . 133137) ( -SETFILEPTR 133139 . 134858) (BOUT16 134860 . 135045) (BIN16 135047 . 135236)) (135341 140546 ( -\GENERIC.BINS 135351 . 135631) (\GENERIC.BOUTS 135633 . 135898) (\GENERIC.RENAMEFILE 135900 . 137731) -(\GENERIC.OPENP 137733 . 139048) (\GENERIC.READP 139050 . 140091) (\GENERIC.CHARSET 140093 . 140544)) -(140547 140886 (\MAP-OPEN-STREAMS 140557 . 140884)) (142670 144750 (\EOF.ACTION 142680 . 142931) ( -\EOSERROR 142933 . 143126) (\GETEOFPTR 143128 . 143310) (\INCFILEPTR 143312 . 143662) (\PEEKBIN 143664 - . 143855) (\SETCLOSEDFILELENGTH 143857 . 144191) (\SETEOFPTR 144193 . 144381) (\SETFILEPTR 144383 . -144748)) (144751 145293 (\FIXPOUT 144761 . 145061) (\FIXPIN 145063 . 145291)) (145294 145860 (\BOUTEOL - 145304 . 145858)) (148756 158620 (\BUFFERED.BIN 148766 . 149618) (\BUFFERED.PEEKBIN 149620 . 150402) -(\BUFFERED.BOUT 150404 . 151264) (\BUFFERED.BINS 151266 . 154951) (\BUFFERED.BOUTS 154953 . 156754) ( -\BUFFERED.COPYBYTES 156756 . 158618))))) + (FILEMAP (NIL (27526 31332 (STREAMPROP 27536 . 27970) (GETSTREAMPROP 27972 . 28567) (PUTSTREAMPROP +28569 . 31180) (STREAMP 31182 . 31330)) (31375 33894 (\DEFPRINT.BY.NAME 31385 . 32537) ( +\STREAM.DEFPRINT 32539 . 33587) (\FDEV.DEFPRINT 33589 . 33892)) (34152 39193 (\GETACCESS 34162 . 34616 +) (\SETACCESS 34618 . 39191)) (59419 65388 (\DEFINEDEVICE 59429 . 61745) (\GETDEVICEFROMNAME 61747 . +62220) (\GETDEVICEFROMHOSTNAME 62222 . 63266) (\REMOVEDEVICE 63268 . 64391) (\REMOVEDEVICE.NAMES 64393 + . 65386)) (65428 90319 (\CLOSEFILE 65438 . 66263) (\DELETEFILE 66265 . 66559) (\DEVICEEVENT 66561 . +68331) (\GENERATEFILES 68333 . 69280) (\GENERATENEXTFILE 69282 . 69933) (\GENERATEFILEINFO 69935 . +70396) (\GETFILENAME 70398 . 70787) (\GENERIC.OUTFILEP 70789 . 71259) (\OPENFILE 71261 . 73839) ( +\DO.PARAMS.AT.OPEN 73841 . 76156) (\RENAMEFILE 76158 . 76582) (\REVALIDATEFILE 76584 . 79186) ( +\PAGED.REVALIDATEFILELST 79188 . 80746) (\PAGED.REVALIDATEFILES 80748 . 82467) (\PAGED.REVALIDATEFILE +82469 . 84752) (\BUFFERED.REVALIDATEFILE 84754 . 87040) (\BUFFERED.REVALIDATEFILELST 87042 . 88226) ( +\PRINT-REVALIDATION-RESULT 88228 . 88643) (\TRUNCATEFILE 88645 . 89036) (\FILE-CONFLICT 89038 . 90317) +) (90355 95018 (\GENERATENOFILES 90365 . 92461) (\NULLFILEGENERATOR 92463 . 92707) (\NOFILESNEXTFILEFN + 92709 . 94700) (\NOFILESINFOFN 94702 . 95016)) (95137 97045 (\FILE.NOT.OPEN 95147 . 95660) ( +\FILE.WONT.OPEN 95662 . 95990) (\ILLEGAL.DEVICEOP 95992 . 96274) (\IS.NOT.RANDACCESSP 96276 . 96722) ( +\STREAM.NOT.OPEN 96724 . 97043)) (97180 99478 (\FDEVINSTANCE 97190 . 99476)) (100680 108054 (CNDIR +100690 . 101995) (DIRECTORYNAME 101997 . 106180) (DIRECTORYNAMEP 106182 . 106798) (HOSTNAMEP 106800 . +107607) (\ADD.CONNECTED.DIR 107609 . 108052)) (108099 135979 (\BACKFILEPTR 108109 . 108297) ( +\BACKPEEKBIN 108299 . 108660) (\BACKBIN 108662 . 109013) (BIN 109015 . 109232) (\BIN 109234 . 109511) +(\BINS 109513 . 109799) (BOUT 109801 . 110163) (\BOUT 110165 . 110480) (\BOUTS 110482 . 110793) ( +COPYBYTES 110795 . 114127) (COPYCHARS 114129 . 117795) (COPYFILE 117797 . 118594) (\COPYOPENFILE +118596 . 121669) (\INFER.FILE.TYPE 121671 . 122625) (EOFP 122627 . 122924) (FORCEOUTPUT 122926 . +123173) (\FLUSH.OPEN.STREAMS 123175 . 123531) (CHARSET 123533 . 125197) (ACCESS-CHARSET 125199 . +125416) (GETEOFPTR 125418 . 125668) (GETFILEINFO 125670 . 128863) (\TYPE.FROM.FILETYPE 128865 . 129335 +) (\FILETYPE.FROM.TYPE 129337 . 129516) (GETFILEPTR 129518 . 129770) (SETFILEINFO 129772 . 133878) ( +SETFILEPTR 133880 . 135599) (BOUT16 135601 . 135786) (BIN16 135788 . 135977)) (136082 141287 ( +\GENERIC.BINS 136092 . 136372) (\GENERIC.BOUTS 136374 . 136639) (\GENERIC.RENAMEFILE 136641 . 138472) +(\GENERIC.OPENP 138474 . 139789) (\GENERIC.READP 139791 . 140832) (\GENERIC.CHARSET 140834 . 141285)) +(141288 141627 (\MAP-OPEN-STREAMS 141298 . 141625)) (143411 145491 (\EOF.ACTION 143421 . 143672) ( +\EOSERROR 143674 . 143867) (\GETEOFPTR 143869 . 144051) (\INCFILEPTR 144053 . 144403) (\PEEKBIN 144405 + . 144596) (\SETCLOSEDFILELENGTH 144598 . 144932) (\SETEOFPTR 144934 . 145122) (\SETFILEPTR 145124 . +145489)) (145492 146034 (\FIXPOUT 145502 . 145802) (\FIXPIN 145804 . 146032)) (146035 146601 (\BOUTEOL + 146045 . 146599)) (149497 159361 (\BUFFERED.BIN 149507 . 150359) (\BUFFERED.PEEKBIN 150361 . 151143) +(\BUFFERED.BOUT 151145 . 152005) (\BUFFERED.BINS 152007 . 155692) (\BUFFERED.BOUTS 155694 . 157495) ( +\BUFFERED.COPYBYTES 157497 . 159359))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index a5c05ff7bc653d80d6352332870894eca7e89848..89c41e62225402054e2558141b69924885dbb18f 100644 GIT binary patch delta 1187 zcmZuwOHUI~6mF-9hJg@G5s)Yz1}t>ZI(Md>KGdc|J1s-YOf#J#s4=OuVg-RvSrOB? zWJAQ8Ahhm{k3_UPG-=|Jg=@nvaLFGqdfVxg@<=9gzjM#yJNLWiZX8md4yo5OcEL5d zw&>zmjsunrvM9&~wifOo-U$qNk9`~p^5hFJKtEp1&n-V+DJNL zK+-f-Bhn**Gy6px+kz}_!a&RK_n3P=Z~MuB9F1@J&OhX!qb>|{s&ho3m|O_hrgveYIcsKG~FHrxtE#v$tkQ^tNd}F#~pM;Y35A zy;<|NCJpf6Y=~fZcFYty5kYOhx6F|yHiY}`P zAdk-o;n|bb(b>5I#CqVA+5s;#N5a?Q1|iV6%C6%n6%hXI;Hu-J@@gM>Q&Ck(&bm&P z!kfDTJv4b$k(3yhAf?I*nQCI=AG=CFeQd`(?M|i~x6-&!zJWK&B0&e`>-bM&?^dNB OPgE2uUEQt}FaHPI4m>6R delta 1231 zcmZux&rcIk5Z>Jel|oPgCPIQvY7CGF+4tHlZBJd7ZCSeP*6o%+PBe3SX+z5OoS{VqIQU_=;v zl%KDVaqxkEVs<@0K}AYI6eIpnL=5`Cd%l!iDPCR8<+B;c-dHWIor*xASiY1iT!dT! ze6h5y!~eOHlaoHkESE8UpPGdD#=T=PO;;65m2Gvp8N{eCz;5xe1OXz2n*bupjBLc! z)P!xq*t~3|z}w8xOvRi_jYA}9sq>ndPEAZ>4J<)-v6E0lk|LDdqfqEBj4=fy5qW@wPH8Rm08zPA7}}$TkqDn=z(UrL<t8rPMl&v_>0500HObaM3e<`loEh-RXg<=}> z$isx3NCQDebWjI~NCAmzrBoY26!39KYQ#(k;<8k`vZE8RGaFY={RGUk!xoC9myJcB z7^ql!3`iKMgimM+b$oV~Po{ADrmg@9`W*p5s)ntZ1|ARcz|?`@C=Pa|4W8hXduR^? z8@U$%;oT{wf*s5XhS9;Z@`vwPJO dyq9fMW%jc=f>L)a&d%13p_Ho`^-s06{(s3@MehIr