github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-26 20:31:53 +00:00
Code Issues Projects Releases Wiki Activity

Format implementation functions set a known variable *BYTECOUNTER* (#402)

Browse Source 
* Format implementation functions set a known variable *BYTECOUNTER*

The generic functions deal with updating the application variable.
\INCHAR eliminated in favor of \INCCODE.EOLC to make clear what it does.
OPENSTRINGSTREAM streams have their own format, and the string is always fattened.
READBITMAP doesn't mix character and byte reading

* AOFD: Don't execute \STRINGSTREAM.INIT

This creates a file device that is not used anywhere.  The function OPENSTRINGSTREAM provides the functionality that this file device suggests that it would provide, but that functionality seems suspect at best.  The function is left in the system for now, probably should be deleted at some point in the future so we don't try to maintain it if we trip over it.

* TTYIN:  Fix an ancient coding error

but still doesn't solve the  (DIRECTORY ?=  problem #402

* LLREAD, FILEIO, XCCS:  Improve charcode backing, copychars

Added \BACKCCODE.EOLC that backs up over EOL encoding bytes, simplifies \RSTRING2.
\XCCSBACKCCODE returns T/NIL according to whether it succeeded.
\XCCSOUTCHAR uses IPLUS16 for CHARPOSITION
COPYCHARS makes no assumptions about EOL encoding
But still no solution for #402

* LLREAD, TTYIN.LCOM    fix #402

The bug showed up in TTYIN, but it was actually a bad edit in the generic backccode.

TTYIN.LCOM is just a recompile--that had never been done with various new declarations.
This commit is contained in:
rmkaplan
2021-08-15 18:45:04 -07:00
committed by GitHub
parent d6d47953d9
commit 0d2c6622bb
24 changed files with 1320 additions and 798 deletions
Download Patch File Download Diff File Expand all files Collapse all files

364
sources/LLREAD
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "29-Jul-2021 22:16:26" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;50 97706
(FILECREATED "14-Aug-2021 00:27:49" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;85 102555
changes to%: (VARS CHARACTERSETNAMES)
changes to%: (FNS \BACKCCODE \BACKCCODE.EOLC)
previous date%: "29-Jul-2021 22:14:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;48)
previous date%: "13-Aug-2021 14:19:45"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;84)
(* ; "
@@ -25,7 +25,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(FNS RSTRING READ-EXTENDED-TOKEN \RSTRING2))
[COMS (* ; "Core of the reader")
(FNS \TOP-LEVEL-READ \SUBREAD \SUBREADCONCAT \ORIG-READ.SYMBOL \ORIG-INVALID.SYMBOL
\APPLYREADMACRO INREADMACROP \CHECKEOLC.CRLF)
\APPLYREADMACRO INREADMACROP)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD? '\ORIG-READ.SYMBOL '\READ.SYMBOL)
(MOVD? '\ORIG-INVALID.SYMBOL '\INVALID.SYMBOL]
(COMS (* ; "Read macro for '")
@@ -43,8 +43,8 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(COMS
(* ;; "Generic functions not compiled open")
(FNS \OUTCHAR \INCCODE \BACKCCODE \PEEKCCODE \PEEKCCODE.NOEOLC \INCHAR \INCCODE.EOLC
\FORMATBYTESTREAM)
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC
\INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
(MACROS \CHECKEOLC))
(COMS (INITVARS (*REPLACE-NO-FONT-CODE* T)
(*DEFAULT-NOT-CONVERTED-FAT-CODE* 8739))
@@ -124,11 +124,11 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(\TOP-LEVEL-READ FILE NIL NIL NIL T])
(READC
[LAMBDA (FILE RDTBL) (* ; "Edited 22-Jun-2021 09:50 by rmk:")
[LAMBDA (FILE RDTBL) (* ; "Edited 6-Aug-2021 21:38 by rmk:")
(SETQ FILE (\GETSTREAM FILE 'INPUT))
(LET ((*READTABLE* (\GTREADTABLE RDTBL))
(\RefillBufferFn (FUNCTION \READCREFILL))
(CODE (\INCHAR FILE)))
(CODE (\INCCODE.EOLC FILE)))
(DECLARE (SPECVARS *READTABLE* \RefillBufferFn))
(CL:WHEN (\CHARCODEP CODE) (* ;
 "If not a charcode, we must have run off the end with an ENDOFSTREAMOP")
@@ -136,14 +136,14 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(FCHARACTER CODE))])
(READCCODE
[LAMBDA (STREAM RDTBL) (* ; "Edited 22-Jun-2021 09:47 by rmk:")
[LAMBDA (STREAM RDTBL) (* ; "Edited 6-Aug-2021 21:39 by rmk:")
(* ;;; "returns a 16 bit character code. \INCHAR does the EOL conversion. Saves the character for LASTC as well.")
(SETQ STREAM (\GETSTREAM STREAM 'INPUT))
(LET ((*READTABLE* (\GTREADTABLE RDTBL))
(\RefillBufferFn (FUNCTION \READCREFILL))
(CODE (\INCHAR STREAM)))
(CODE (\INCCODE.EOLC STREAM)))
(DECLARE (SPECVARS *READTABLE* \RefillBufferFn))
(CL:WHEN (\CHARCODEP CODE) (* ;
 "If not a charcode, we must have run off the end with an ENDOFSTREAMOP")
@@ -399,7 +399,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
\PNAMESTRING])
(READ-EXTENDED-TOKEN
[LAMBDA (STRM RDTBL ESCAPE-ALLOWED-P) (* ; "Edited 23-Jun-2021 13:04 by rmk:")
[LAMBDA (STRM RDTBL ESCAPE-ALLOWED-P) (* ; "Edited 6-Aug-2021 21:39 by rmk:")
(* ;; "This is a cross between RSTRING and \SUBREAD. Read a %"token%" from STREAM, as defined by the Common Lisp reader and the syntax in RDTBL. EOF terminates as well. If ESCAPE-ALLOWED-P is true, escapes are honored and if one appears, a second value of T is returned. Otherwise, escapes are treated as vanilla chars and the caller can barf on them itself if it desires.")
@@ -419,7 +419,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(SETQ SNX (\SYNCODE SA CH))
[COND
((AND ESCAPE-ALLOWED-P (SELECTC SNX
(ESCAPE.RC (SETQ CH (\INCHAR STRM))
(ESCAPE.RC (SETQ CH (\INCCODE.EOLC STRM))
(SETQ ESCAPE-APPEARED T))
(MULTIPLE-ESCAPE.RC
(SETQ ESCAPING (NOT ESCAPING))
@@ -461,7 +461,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
else J])
(\RSTRING2
[LAMBDA (STRM SA RSFLG PNSTR) (* ; "Edited 23-Jun-2021 13:02 by rmk:")
[LAMBDA (STRM SA RSFLG PNSTR) (* ; "Edited 13-Aug-2021 13:35 by rmk:")
(* ;;; "The main string reader. Reads characters from STREAM according to the syntax table SA and returns a string. PNSTR is an instance of the global resource \PNAMESTRING, which we can use all to ourselves as a buffer.")
@@ -473,29 +473,23 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(J 0)
CH SNX ANSLIST ANSTAIL LASTC FATSEEN SKIPPING)
RS2LP
(SETQ CH (\INCCODE STRM))
(SETQ CH (\INCCODE.EOLC STRM))
[COND
((OR (EQ CH (CHARCODE LF))
(EQ CH (CHARCODE CR)))
((EQ CH (CHARCODE EOL))
(* ;; "We just read a potential (first) EOL character, so we have to turn it into our EOL. Most places do this with \CHECKEOLC, but we can't do that here, because if the eol happens to be a CR-LF sequence and would terminate the read, \BACKCCODE won't work right.")
(* ;; "We have eaten a CR, LF, or CRLF depending on the EOL convention of STRM, and recognized it as an EOL. If EOL is a stopatom character, we terminate the read and backup over the just read character(s) so they can be read again.")
(* ;; "An escaped LF is handled below, stays as LF even from an LF file.")
(COND
([AND (EQ RSFLG T)
(fetch STOPATOM of (\SYNCODE SA (CHARCODE CR]
(* ;
 "From RSTRING, eol terminates read. Leave (the first) eol in buffer")
(\BACKCCODE STRM)
(GO FINISH))
(T (COND
((AND (OR (EQ EOLC CRLF.EOLC)
(EQ EOLC ANY.EOLC))
(EQ (\PEEKBIN STRM T)
(CHARCODE LF))) (* ; "Eat the LF after the CR")
(\BIN STRM)))
(SETQ CH (CHARCODE EOL]
(fetch STOPATOM of (\SYNCODE SA (CHARCODE EOL]
(* ;;
 "From RSTRING, eol terminates read, but EOL character(s) is/are left to be read again. ")
(\BACKCCODE.EOLC STRM)
(GO FINISH]
(SETQ SNX (\SYNCODE SA CH))
(SELECTC SNX
(OTHER.RC (* ; "Normal case, nothing to do"))
@@ -635,7 +629,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(\SUBREAD
[LAMBDA (STRM SA READTYPE PNSTR CASEBASE EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE)
(* ; "Edited 23-Jun-2021 13:00 by rmk:")
(* ; "Edited 6-Aug-2021 21:40 by rmk:")
(* ;; "Values of READTYPE are: --- READ.RT for top level of READ, --- NOPROPRB.RT if right-bracket isn't to be propagated -- sublist beginning with left-bracket --- PROPRB.RT if propagation is not suppressed -- sublist beginning with left-paren --- RATOM.RT for call from RATOM")
@@ -733,7 +727,8 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
 "Take next character to be alphabetic, case exact")
(COND
((fetch ESCAPEFLG of *READTABLE*)
(SETQ CH (\INCHAR STRM)) (* ;
(SETQ CH (\INCCODE.EOLC STRM))
(* ;
 "No EOFP check needed -- it's an error to have escape char with nothing following")
(SETQ ESCAPEFLG T)
(GO PUTATOMCHAR))))
@@ -741,7 +736,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(* ;; "Take characters up to next multiple escape to be alphabetic, except that single escape chars still escape the next char")
(SETQ ESCAPEFLG T)
[bind ESCFLG do (SETQ CH (\INCHAR STRM))
[bind ESCFLG do (SETQ CH (\INCCODE.EOLC STRM))
(COND
([NOT (COND
(ESCFLG (SETQ ESCFLG NIL))
@@ -1116,56 +1111,6 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
TEM)
(RELSTK TEM)
(RETURN \READDEPTH])
(\CHECKEOLC.CRLF
[LAMBDA (STREAM PEEKBINFLG BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 23-Jun-2021 13:08 by rmk:")
(* ;; "This is called only when a CR has been read and EOLC is either any or CRLF. This returns EOL if the next code is an LF")
(* ;; "If BYTECOUNTVAR, decrements that free variable by the number of bytes read.")
(LET (CH (NUM 0))
[SETQ CH (COND
[PEEKBINFLG
(* ;;
 "T from PEEKC. In this case, must leave the fileptr where it was.")
(* ;; "The CR itself hasn't been read, just peeked. So here we have to read it, then peek at the next character to see if it is an LF, and then back out the CR")
(COND
([EQ (CHARCODE LF)
(UNINTERRUPTABLY
(* ;; " Since we are going to \BACKCCODE back the peeked character, we don't need to update the counter variable")
(\INCCODE STREAM)
(PROG1 (\PEEKCCODE STREAM T 'NOEOLC)
(* ;;
 "This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")
(* ;;
 "LF must be the next char after the CR. We back up over the CR that \INCCODE just read.")
(\BACKCCODE STREAM)))]
(* ;; "Got the CRLF, it's an EOL")
(CHARCODE EOL))
(T (CHARCODE CR]
((EQ (CHARCODE LF)
(\PEEKCCODE STREAM T 'NOEOLC))
(* ;; "Since we aren't peeking, the CR has actually been read, and we are entitled to read the LF that we just peeked at.")
(\INCCODE STREAM BYTECOUNTVAR BYTECOUNTVAL)
(CHARCODE EOL))
(T (CHARCODE CR]
(CL:WHEN BYTECOUNTVAR
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
NUM)))
CH])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@@ -1653,21 +1598,109 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(DEFINEQ
(\OUTCHAR
[LAMBDA (STREAM CODE) (* ; "Edited 14-Jun-2021 16:20 by rmk:")
[LAMBDA (STREAM CODE) (* ; "Edited 10-Aug-2021 10:29 by rmk:")
(* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit. We have to pass the EOL character to the stream's function")
(* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.")
(* ;; "Maybe the implementation function does something else, like move the X and Y positions. At best we could convert the EOL into either CR or LF, or into a CR-LF sequence that we pass by two calls to the lower implementation function.")
(* ;; "")
(* ;; "This would make CHARPOSITION generic:")
(* (FREPLACE (STREAM CHARPOSITION)
 OF STREAM WITH (CL:IF
 (EQ CODE (CHARCODE EOL)) 0
 (IPLUS16 1 (FFETCH
 (STREAM CHARPOSITION) OF STREAM)))))
(CL:FUNCALL (OR (ffetch (STREAM OUTCHARFN) of STREAM)
\DEFAULTOUTCHAR)
STREAM CODE])
STREAM CODE)
CODE])
(\INCCODE
(\INCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 7-Aug-2021 00:11 by rmk:")
(* ;; "Calling functions pass the name of the BYTECOUNTVAR, or NIL. If non-NIL, implementing functions are required to SETQ *BYTECOUNTER* to the number of bytes read (positive) or backed up (negative).")
(* ;; "Caller must bind BYTECOUNTVAR as a SPECVAR. BYTECOUNTVAL can be passed as the current value of BYTECOUNTVAR, to save a call to \EVALV1.")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM
'*BYTECOUNTER*)
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM])
(\BACKCCODE
(* ;; "Calling functions pass the name of the BYTECOUNTVAR, or NIL. If non-NIL, implementing functions are required to")
(* ;; " (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAR num-bytes-read))")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:26 by rmk:")
(* ;;
"Format function returns T if the backup succeed, NIL otherwise (e.g at the beginning of the file)")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM])
(\BACKCCODE.EOLC
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:27 by rmk:")
(* ;; "If the EOLCONVENTION is CRLF, and the first backup is over an LF encoding, this looks to see whether the preceding bytes encode a CR and if so, backs up over those.")
(* ;; "Within this we operate at the external-format implementation level.")
(* ;; "Counting is unusual in general (mostly just COPYCHARS and PFCOPYBYTES) , and counting while backing up is even rarer. So for simplicity here we just count by looking at the byte pointer.")
(LET [(STARTPOS (CL:WHEN BYTECOUNTVAR (\GETFILEPTR STREAM]
(* ;; "In almost all cases, we just execute the first backup")
(PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM)
(IF (AND (EQ CRLF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM))
(EQ (CHARCODE LF)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
STREAM)))
THEN
(* ;;
 "We just backed over an LF in a CRLF file. If we go one more, do we get a CR?")
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM
)
\DEFAULTBACKCCODE)
STREAM)
(CL:UNLESS (EQ (CHARCODE CR)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
of STREAM)
\DEFAULTPEEKCCODE)
STREAM))
(* ;; "Not a preceding CR, reread it.")
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM))
T)
ELSE T))
(CL:WHEN BYTECOUNTVAR
[SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
(\PEEKCCODE
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 14-Jun-2021 12:40 by rmk:")
@@ -1682,35 +1715,46 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
\DEFAULTPEEKCCODE)
STREAM NOERROR])
(\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
STREAM NOERROR)
EOL STREAM T])
(\PEEKCCODE.NOEOLC
[LAMBDA (STREAM NOERROR) (* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
STREAM NOERROR])
(\INCHAR
[LAMBDA (STREAM BYTECOUNTVAR EOLC BYTECOUNTVAL) (* ; "Edited 22-Jun-2021 10:48 by rmk:")
(* ;; "EOL conversion around essentially what \INCCODE does, without the extra function call.")
(\INCCODE.EOLC
(* ;; " EOLC of NIL means all patterns go to EOL")
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:")
(CL:WHEN BYTECOUNTVAR
(* ;;
 "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; " EOLC of NIL means all patterns go to EOL")
STREAM BYTECOUNTVAR BYTECOUNTVAL)
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM NIL BYTECOUNTVAR BYTECOUNTVAL])
(\INCCODE.EOLC
[LAMBDA (STREAM BYTECOUNTVAR EOLC BYTECOUNTVAL) (* ; "Edited 22-Jun-2021 10:48 by rmk:")
(IF BYTECOUNTVAR
THEN [LET (*BYTECOUNTER* CODE)
(DECLARE (SPECVARS *BYTECOUNTER*))
(* ;; "The INCCODEFN first sets *BYTECOUNTER*")
(CL:UNLESS BYTECOUNTVAL
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
(SETQ CODE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM T))
(* ;; "Update according to the number of first-char (CR or LF) bytes")
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
(SETQ *BYTECOUNTER* 0)
(* ;;
 "*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")
(PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH (STREAM EOLCONVENTION)
OF STREAM))
STREAM NIL T)
(* ;; "Post the results")
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
ELSE (\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM)
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM])
(\FORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 17:26 by rmk:")
@@ -1735,10 +1779,63 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(APPLY* (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
STREAM BYTESTREAM))
BYTESTREAM])
(\CHECKEOLC.CRLF
[LAMBDA (STREAM PEEKBINFLG COUNTP) (* ; "Edited 6-Aug-2021 23:30 by rmk:")
(* ;; "This is called only when a CR has been read and EOLC is either any or CRLF. This returns EOL if the next code is an LF")
(* ;; "If COUNTP, that sets *BYTECOUNTER* freely with the number of LF bytes.")
(DECLARE (USEDFREE *BYTECOUNTER*))
(LET (CH)
[SETQ CH (COND
[PEEKBINFLG
(* ;;
 "T from PEEKC. In this case, must leave the fileptr where it was.")
(* ;; "The CR itself hasn't been read, just peeked. So here we have to read it, then peek at the next character to see if it is an LF, and then back out the CR")
(COND
([EQ (CHARCODE LF)
(UNINTERRUPTABLY
(* ;; " Since we are going to \BACKCCODE back the peeked character, we don't need to update the counter variable")
(\INCCODE STREAM)
(PROG1 (\PEEKCCODE STREAM T 'NOEOLC)
(* ;;
 "This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")
(* ;;
 "LF must be the next char after the CR. We back up over the CR that \INCCODE just read.")
(\BACKCCODE STREAM)))]
(* ;; "Got the CRLF, it's an EOL")
(CHARCODE EOL))
(T (CHARCODE CR]
((EQ (CHARCODE LF)
(\PEEKCCODE STREAM T 'NOEOLC))
(* ;; "Since we aren't peeking, the CR has actually been read, and we are entitled to read the LF that we just peeked at.")
(IF COUNTP
THEN (LET (NUMLFBYTES)
(DECLARE (SPECVARS NUMLFBYTES))
(\INCCODE STREAM 'NUMLFBYTES 0)
(ADD *BYTECOUNTER* NUMLFBYTES))
ELSE (\INCCODE STREAM))
(CHARCODE EOL))
(T (CHARCODE CR]
CH])
)
(DECLARE%: EVAL@COMPILE
LF.EOLC)))
(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP)
(COND
((EQ EOLC 'NOEOLC)
CH)
@@ -1757,7 +1854,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(CR.EOLC (CHARCODE EOL))
((LIST ANY.EOLC CRLF.EOLC)
(\CHECKEOLC.CRLF STRM PEEKBINFLG
OF STRM))
COUNTP))
(CHARCODE CR)))
CH])
)
@@ -1794,19 +1891,20 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 1993 2021))
(DECLARE%: DONTCOPY
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
)
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3485 11702 (LASTC 3495 . 3801) (PEEKC 3803 . 4191) (PEEKCCODE 4193 . 4486) (RATOM 4488
. 5569) (READ 5571 . 6131) (READC 6133 . 6768) (READCCODE 6770 . 7523) (READP 7525 . 8077) (
SETREADMACROFLG 8079 . 8378) (SKIPSEPRCODES 8380 . 9363) (SKIPSEPRS 9365 . 9751) (SKREAD 9753 . 11700)
) (11748 20423 (CL:READ 11758 . 12307) (CL:READ-PRESERVING-WHITESPACE 12309 . 13031) (
(FILEMAP (NIL (3501 11730 (LASTC 3511 . 3817) (PEEKC 3819 . 4207) (PEEKCCODE 4209 . 4502) (RATOM 4504
. 5585) (READ 5587 . 6147) (READC 6149 . 6790) (READCCODE 6792 . 7551) (READP 7553 . 8105) (
SETREADMACROFLG 8107 . 8406) (SKIPSEPRCODES 8408 . 9391) (SKIPSEPRS 9393 . 9779) (SKREAD 9781 . 11728)
) (11776 20451 (CL:READ 11786 . 12335) (CL:READ-PRESERVING-WHITESPACE 12337 . 13059) (
CL:READ-DELIMITED-LIST 13061 . 13976) (CL:PARSE-INTEGER 13978 . 20449)) (20544 33021 (RSTRING 20554 .
21286) (READ-EXTENDED-TOKEN 21288 . 25160) (\RSTRING2 25162 . 33019)) (33057 64197 (\TOP-LEVEL-READ
33067 . 35050) (\SUBREAD 35052 . 60613) (\SUBREADCONCAT 60615 . 61238) (\ORIG-READ.SYMBOL 61240 .
62308) (\ORIG-INVALID.SYMBOL 62310 . 63209) (\APPLYREADMACRO 63211 . 63627) (INREADMACROP 63629 .
64195)) (64356 64531 (READQUOTE 64366 . 64529)) (64556 76460 (READVBAR 64566 . 65897) (READHASHMACRO
65899 . 71709) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71711 . 71931) (DIGITBASEP 71933 . 72667) (
READNUMBERINBASE 72669 . 74555) (ESTIMATE-DIMENSIONALITY 74557 . 74882) (SKIP.HASH.COMMENT 74884 .
75852) (CMLREAD.FEATURE.PARSER 75854 . 76458)) (76504 83037 (CHARACTER.READ 76514 . 77768) (
CHARCODE.DECODE 77770 . 83035)) (87505 99999 (\OUTCHAR 87515 . 88651) (\INCCODE 88653 . 89839) (
\BACKCCODE 89841 . 90735) (\BACKCCODE.EOLC 90737 . 93500) (\PEEKCCODE 93502 . 93818) (
\PEEKCCODE.NOEOLC 93820 . 94082) (\INCCODE.EOLC 94084 . 95943) (\FORMATBYTESTREAM 95945 . 97431) (
\CHECKEOLC.CRLF 97433 . 99997)))))
STOP