github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-05 23:54:46 +00:00
Code Issues Projects Releases Wiki Activity

Rmk51 end game of external format integration (#814)

Browse Source 
* Compile device-creation functions for new default interface

* UNICODE:  minor bug

* LLINTERP: MOVD? APPLY* to SPREADAPPLY*

* External format interface: a few more adjustments

* CLSTREAMS: Recompile, no source change

* PRETTYFILEINDEX: suppress when printing gitmaps to a non-display stream

* UNIXCOMM: Default format comes from device

Also, I seemed to have reverted back to LCOM with FAKE-COMPILE-FILE
This commit is contained in:
rmkaplan
2022-07-03 18:49:04 -07:00
committed by GitHub
parent f86be45834
commit d7ca40ebeb
28 changed files with 1037 additions and 802 deletions
Download Patch File Download Diff File Expand all files Collapse all files

350
sources/EXTERNALFORMAT
View File

@@ -1,30 +1,30 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Jun-2022 14:32:42" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;32 32949
(FILECREATED " 3-Jul-2022 08:55:41" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;56 36413
:CHANGES-TO (VARS EXTERNALFORMATCOMS)
(MACROS \CHECKEOLC)
:PREVIOUS-DATE "22-Jun-2022 11:09:34"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;30)
:PREVIOUS-DATE " 3-Jul-2022 00:35:47"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;55)
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
(RPAQQ EXTERNALFORMATCOMS
[(COMS (* ;
[[COMS (* ;
 "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
(INITRECORDS EXTERNALFORMAT)
(SYSRECORDS EXTERNALFORMAT)
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT)
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT \EXTERNALFORMAT.DEFPRINT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(INITVARS (*EXTERNALFORMATS* NIL)
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
(*DEFAULT-EXTERNALFORMAT* :XCCS))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'EXTERNALFORMAT (FUNCTION
\EXTERNALFORMAT.DEFPRINT
]
(COMS
(* ;; "Generic functions not compiled open (originally on LLREAD)")
@@ -33,6 +33,9 @@
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC))
(RESOURCES \FORMATBYTESTRING.STREAM))
(INITRESOURCES \FORMATBYTESTRING.STREAM))
[COMS (* ; "NULL device, from FILEIO")
(FNS \NULLDEVICE \NULL.OPENFILE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
(COMS
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
@@ -124,6 +127,8 @@
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME)
(* ;; "Edited 2-Jul-2022 19:17 by rmk: Fast case: NEWFORMAT/NAME is an external format")
(* ;; "Edited 22-Jun-2022 09:40 by rmk: NEWFORMAT/NAME can be a stream, picks its externalformat")
(* ;; "Edited 10-Sep-2021 20:44 by rmk:")
@@ -138,31 +143,29 @@
(* ;;; "")
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice. If a different format is not specified when the device is created, it will default to the value of *DEFAULT-EXTERNALFORMAT*, initialized in FILEIO.")
(\DTEST STREAM 'STREAM)
(CL:WHEN NEWFORMAT/NAME
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
[LET (EXTFORMAT)
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
then (SETQ EXTFORMAT NEWFORMAT/NAME)
elseif (\GETSTREAM NEWFORMAT/NAME NIL T)
then (SETQ EXTFORMAT (ffetch (STREAM EXTERNALFORMAT) of NEWFORMAT/NAME))
else (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
of (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMATS*))
(fetch (FDEV DEFAULTEXTERNALFORMAT)
of (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMAT*)))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
"is not a registered external format name")))
[LET ((EXTFORMAT NEWFORMAT/NAME))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT))
(* ;; "Try for coercions")
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
then (SETQ EXTFORMAT NEWFORMAT/NAME)
elseif (\GETSTREAM NEWFORMAT/NAME NIL T)
then (SETQ EXTFORMAT (ffetch (STREAM EXTERNALFORMAT) of NEWFORMAT/NAME))
else (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
(SETQ NEWFORMAT/NAME (fetch (FDEV DEFAULTEXTERNALFORMAT)
of (fetch (STREAM DEVICE) of STREAM))))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME NIL STREAM))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
"is not a registered external format name")))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT)))
(UNINTERRUPTABLY
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
@@ -179,11 +182,28 @@
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE)
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE
FORMATBYTESTRINGFN DEFAULT) (* ; "Edited 3-Jul-2022 00:35 by rmk")
(* ; "Edited 10-Sep-2021 19:47 by rmk:")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL. Fills in missing functions from DEFAULT if given. If DEFAULT is T, use *DEFAULT-EXTERNALFORMAT*.")
(CL:WHEN DEFAULT
[LET [(DEF (FIND-FORMAT (CL:IF (EQ DEFAULT T)
*DEFAULT-EXTERNALFORMAT*
DEFAULT)]
(CL:UNLESS INCCODEFN
(SETQ INCCODEFN (FETCH (EXTERNALFORMAT INCCODEFN)
DEF)))
(CL:UNLESS PEEKCCODEFN
(SETQ PEEKCCODEFN (FETCH (EXTERNALFORMAT PEEKCCODEFN)
DEF)))
(CL:UNLESS BACKCCODEFN
(SETQ BACKCCODEFN (FETCH (EXTERNALFORMAT BACKCCODEFN)
DEF)))
(CL:UNLESS OUTCHARFN
(SETQ OUTCHARFN (FETCH (EXTERNALFORMAT OUTCHARFN)
DEF)))])
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
@@ -194,15 +214,25 @@
(NIL)
(SHOULDNT)))
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC)
UNSTABLE _ UNSTABLE])
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC)
UNSTABLE _ UNSTABLE
FORMATBYTESTRINGFN _ FORMATBYTESTRINGFN])
(\EXTERNALFORMAT.DEFPRINT
[LAMBDA (EXTERNALFORMAT STREAM) (* ; "Edited 2-Jul-2022 11:40 by rmk")
(* ; "Edited 8-May-87 15:55 by bvm")
(* ;; "Print device using its name, for example, #<EXTERNALFORMAT:UTF-8/76,5432>")
(\DEFPRINT.BY.NAME EXTERNALFORMAT STREAM (fetch (EXTERNALFORMAT NAME) of EXTERNALFORMAT)
"EXTERNALFORMAT"])
)
(DEFINEQ
@@ -248,31 +278,28 @@
*EXTERNALFORMATS*])
(FIND-FORMAT
[LAMBDA (NAME NOERROR) (* ; "Edited 7-Aug-2021 09:29 by rmk:")
[LAMBDA (NAME NOERROR) (* ; "Edited 2-Jul-2022 18:55 by rmk")
(* ; "Edited 7-Aug-2021 09:29 by rmk:")
(IF (TYPE? EXTERNALFORMAT NAME)
THEN NAME
ELSE (SETQ NAME (MKATOM NAME)) (* ;
 "The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (
EXTERNALFORMAT
NAME)
OF EF)))
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
ELSE (SETQ NAME (MKATOM NAME)) (* ;
 "The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (EXTERNALFORMAT NAME)
OF EF)))
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(RPAQ? *EXTERNALFORMATS* NIL)
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(DEFPRINT 'EXTERNALFORMAT (FUNCTION \EXTERNALFORMAT.DEFPRINT))
)
@@ -281,7 +308,8 @@
(DEFINEQ
(\OUTCHAR
[LAMBDA (STREAM CODE) (* ; "Edited 10-Aug-2021 10:29 by rmk:")
[LAMBDA (STREAM CODE) (* ; "Edited 30-Jun-2022 10:02 by rmk")
(* ; "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.")
@@ -290,18 +318,18 @@
(* ;; "")
(* ;; "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)
(* (FREPLACE (STREAM CHARPOSITION) OF
 STREAM WITH (CL:IF (EQ CODE
 (CHARCODE EOL)) 0 (IPLUS16 1
 (FFETCH (STREAM CHARPOSITION) OF
 STREAM)))))
(CL:FUNCALL (ffetch (STREAM OUTCHARFN) of STREAM)
STREAM CODE)
CODE])
(\INCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 7-Aug-2021 00:11 by rmk:")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:04 by rmk")
(* ; "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).")
@@ -309,37 +337,35 @@
(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])
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM
'*BYTECOUNTER*)
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM])
(\BACKCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:26 by rmk:")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:00 by rmk")
(* ; "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)")
 "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])
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM])
(\BACKCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 18-Jun-2022 18:45 by rmk")
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:02 by rmk")
(* ; "Edited 18-Jun-2022 18:45 by rmk")
(* ; "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.")
@@ -352,32 +378,27 @@
(* ;; "In almost all cases, we just execute the first backup")
(PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
(PROG1 (CL:WHEN (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM)
(SELECTC (OR EOLC (ffetch (STREAM EOLCONVENTION) OF STREAM))
((LIST CRLF.EOLC ANY.EOLC 'CRLF 'ANY)
(CL:WHEN (EQ (CHARCODE LF)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM))
(* ;;
 "We just backed over an LF with EOLC= CRLF or ANY. If we go one more, do we get a CR?")
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
(CL:WHEN (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM)
(CL:UNLESS (EQ (CHARCODE CR)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
of STREAM)
\DEFAULTPEEKCCODE)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN)
of STREAM)
STREAM))
(* ;; "Not a preceding CR, reread it.")
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
(CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM)))))
NIL)
T)
@@ -386,58 +407,54 @@
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
(\PEEKCCODE
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 14-Jun-2021 12:40 by rmk:")
(\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 14-Jun-2021 12:40 by rmk:")
(\CHECKEOLC (CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
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)
[LAMBDA (STREAM NOERROR) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM NOERROR])
(\INCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:")
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:12 by rmk")
(* ; "Edited 8-Aug-2021 14:52 by rmk:")
(* ;;
 "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; " EOLC of NIL means all patterns go to EOL")
(* ;; " EOLC of ANY means all patterns go to EOL")
(IF BYTECOUNTVAR
THEN [LET (*BYTECOUNTER* CODE)
(DECLARE (SPECVARS *BYTECOUNTER*))
(DECLARE (SPECVARS *BYTECOUNTER*))
(* ;; "The INCCODEFN first sets *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))
(CL:UNLESS BYTECOUNTVAL
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
(SETQ CODE (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM T))
(* ;; "Update according to the number of first-char (CR or LF) bytes")
(* ;; "Update according to the number of first-char (CR or LF) bytes")
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
(SETQ *BYTECOUNTER* 0)
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
(SETQ *BYTECOUNTER* 0)
(* ;;
 "*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")
(* ;; "*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)
(PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM NIL T)
(* ;; "Post the results")
(* ;; "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])
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
ELSE (\CHECKEOLC (CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM)
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM])
(\FORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 22-Jun-2022 11:09 by rmk")
@@ -574,6 +591,59 @@
(* ; "NULL device, from FILEIO")
(DEFINEQ
(\NULLDEVICE
[LAMBDA NIL (* bvm%: "30-Jan-85 22:06")
(* ;; "Defines the NULL device, an infinite source or sink")
(\DEFINEDEVICE 'NULL (create FDEV
DEVICENAME _ 'NULL
RANDOMACCESSP _ T
NODIRECTORIES _ T
CLOSEFILE _ (FUNCTION NILL)
DELETEFILE _ (FUNCTION NILL)
OPENFILE _ (FUNCTION \NULL.OPENFILE)
REOPENFILE _ (FUNCTION \NULL.OPENFILE)
BIN _ (FUNCTION \EOF.ACTION)
BOUT _ (FUNCTION NILL)
PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
(AND (NULL NOERRORFLG)
(BIN STREAM]
READP _ (FUNCTION NILL)
BACKFILEPTR _ (FUNCTION NILL)
EOFP _ (FUNCTION TRUE)
RENAMEFILE _ (FUNCTION NILL)
GETFILENAME _ (FUNCTION NILL)
EVENTFN _ (FUNCTION NILL)
BLOCKIN _ (FUNCTION \EOF.ACTION)
BLOCKOUT _ (FUNCTION NILL)
GENERATEFILES _ (FUNCTION \NULLFILEGENERATOR)
GETFILEPTR _ (FUNCTION ZERO)
GETEOFPTR _ (FUNCTION ZERO)
SETFILEPTR _ (FUNCTION NILL)
GETFILEINFO _ (FUNCTION NILL)
SETFILEINFO _ (FUNCTION NILL)
SETEOFPTR _ (FUNCTION NILL])
(\NULL.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM) (* bvm%: "30-Jan-85 22:05")
(OR OLDSTREAM (create STREAM
USERCLOSEABLE _ T
ACCESS _ ACCESS
FULLFILENAME _ NIL
DEVICE _ DEVICE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\NULLDEVICE)
)
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
(DEFINEQ
@@ -625,11 +695,13 @@
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6252 11542 (\EXTERNALFORMAT 6262 . 10227) (MAKE-EXTERNALFORMAT 10229 . 11540)) (11543
14656 (\INSTALL.EXTERNALFORMAT 11553 . 13002) (\REMOVE.EXTERNALFORMAT 13004 . 13835) (FIND-FORMAT
13837 . 14654)) (15105 29364 (\OUTCHAR 15115 . 16251) (\INCCODE 16253 . 17439) (\BACKCCODE 17441 .
18335) (\BACKCCODE.EOLC 18337 . 21214) (\PEEKCCODE 21216 . 21532) (\PEEKCCODE.NOEOLC 21534 . 21796) (
\INCCODE.EOLC 21798 . 23657) (\FORMATBYTESTREAM 23659 . 25292) (\FORMATBYTESTRING 25294 . 26796) (
\CHECKEOLC.CRLF 26798 . 29362)) (31010 32853 (\CREATE.THROUGH.EXTERNALFORMAT 31020 . 31822) (
\THROUGHIN 31824 . 32244) (\THROUGHBACKCCODE 32246 . 32513) (\THROUGHOUTCHARFN 32515 . 32851)))))
(FILEMAP (NIL (6535 13170 (\EXTERNALFORMAT 6545 . 10323) (MAKE-EXTERNALFORMAT 10325 . 12697) (
\EXTERNALFORMAT.DEFPRINT 12699 . 13168)) (13171 16212 (\INSTALL.EXTERNALFORMAT 13181 . 14630) (
\REMOVE.EXTERNALFORMAT 14632 . 15463) (FIND-FORMAT 15465 . 16210)) (16561 30496 (\OUTCHAR 16571 .
17788) (\INCCODE 17790 . 18943) (\BACKCCODE 18945 . 19808) (\BACKCCODE.EOLC 19810 . 22397) (\PEEKCCODE
22399 . 22773) (\PEEKCCODE.NOEOLC 22775 . 23107) (\INCCODE.EOLC 23109 . 24789) (\FORMATBYTESTREAM
24791 . 26424) (\FORMATBYTESTRING 26426 . 27928) (\CHECKEOLC.CRLF 27930 . 30494)) (32098 34334 (
\NULLDEVICE 32108 . 34010) (\NULL.OPENFILE 34012 . 34332)) (34474 36317 (
\CREATE.THROUGH.EXTERNALFORMAT 34484 . 35286) (\THROUGHIN 35288 . 35708) (\THROUGHBACKCCODE 35710 .
35977) (\THROUGHOUTCHARFN 35979 . 36315)))))
STOP