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

Localize external format implementation in new EXTERNALFORMAT file

Browse Source 
Pieces moved from FILEIO and LLREAD, EXTERNALFORMAT added to FILESETS
This commit is contained in:
rmkaplan
2021-09-25 22:48:04 -07:00
parent c89ac61d34
commit db3ca49564
7 changed files with 659 additions and 2489 deletions
Download Patch File Download Diff File Expand all files Collapse all files

604
sources/EXTERNALFORMAT Normal file
View File

@@ -0,0 +1,604 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Sep-2021 08:59:42" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;16 31868
changes to%: (VARS EXTERNALFORMATCOMS)
previous date%: "11-Sep-2021 09:44:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;15)
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
(RPAQQ EXTERNALFORMATCOMS
[(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 \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(INITVARS (*EXTERNALFORMATS* NIL)
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
[COMS
(* ;; "Generic functions not compiled open (originally on LLREAD)")
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC
\INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC]
(COMS
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
(FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE \THROUGHOUTCHARFN)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT])
(* ; "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
(EOL BITS 2)
(UNSTABLE FLAG) (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")
(INCCODEFN POINTER) (* ;
 "Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
(PEEKCCODEFN POINTER) (* ;
 "Called with three arguments -- STREAM, NOERROR, and EOL")
(BACKCCODEFN POINTER) (* ;
 "Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
(OUTCHARFN POINTER) (* ;
 "Called with two arguments -- STREAM and CHARCODE")
(NAME POINTER) (* ;
 "keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
(EF1 POINTER) (* ;
 "Extra fields for use of particular formats. Possibly to hold standardized translation tables")
(EF2 POINTER)))
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (FLAGBITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(* "END EXPORTED DEFINITIONS")
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (FLAGBITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(ADDTOVAR SYSTEMRECLST
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
(EOL BITS 2)
(UNSTABLE FLAG)
(INCCODEFN POINTER)
(PEEKCCODEFN POINTER)
(BACKCCODEFN POINTER)
(OUTCHARFN POINTER)
(NAME POINTER)
(FORMATBYTESTREAMFN POINTER)
(EF1 POINTER)
(EF2 POINTER)))
)
(DEFINEQ
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 10-Sep-2021 20:44 by rmk:")
(* ; "Edited 26-Feb-91 13:20 by nm")
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
(* ;;; "")
(* ;;; "If NEWFORMAT/NAME is nil, just returns the current external format name of STREAM. If NEWFORMAT/NAME is supplied and it is or names an external format, then the external format of STREAM is set to that format.")
(* ;;; "")
(* ;;; ":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. ")
(\DTEST STREAM 'STREAM)
(SETQ SAVEDNAME (fetch DEVICENAME of (fetch DEVICE of STREAM)))
(SETQ SAVEDDEFAULTFORMATNAME (fetch (FDEV DEFAULTEXTERNALFORMAT) of (fetch DEVICE
of STREAM)))
(SETQ FOUNDFORMAT (FIND-FORMAT SAVEDDEFAULTFORMATNAME T))
(CL:WHEN NEWFORMAT/NAME
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
[LET (EXTFORMAT)
[COND
((type? EXTERNALFORMAT NEWFORMAT/NAME)
(SETQ EXTFORMAT NEWFORMAT/NAME))
(T (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"))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
(UNINTERRUPTABLY
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch
(EXTERNALFORMAT
EOL) of
EXTFORMAT
)))
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT
OUTCHARFN)
of EXTFORMAT))
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
INCCODEFN)
of EXTFORMAT))
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
PEEKCCODEFN)
of EXTFORMAT))
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
BACKCCODEFN)
of EXTFORMAT)))])
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE)
(* ; "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")
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
((LIST 'CR CR.EOLC)
CR.EOLC)
((LIST 'CRLF CRLF.EOLC)
CRLF.EOLC)
(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])
)
(DEFINEQ
(\INSTALL.EXTERNALFORMAT
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-Aug-2021 14:22 by rmk:")
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
(* ;;; "For backward compatibility, the first argument can be a NAME with the second argument being the format. If so, the NAME must match the name inside the format")
(LET (NAME)
(IF EXTERNALFORMAT
THEN
(* ;; "Backwards compatibility")
(SETQ NAME (MKATOM EXTFORMAT/NAME))
(IF (EQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT))
ELSEIF (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)
THEN (ERROR "Mismatch of specified name and name of the external format")
ELSE (REPLACE (EXTERNALFORMAT NAME) OF EXTERNALFORMAT WITH
NAME))
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
THEN (\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
EXTERNALFORMAT])
(\REMOVE.EXTERNALFORMAT
[LAMBDA (NAME/EXTFORMAT) (* ; "Edited 5-May-2021 15:42 by rmk:")
(* ;;; "Deregisters external format EXTERNALFORMAT .")
(SETQ NAME/EXTFORMAT (IF (TYPE? EXTERNALFORMAT NAME/EXTFORMAT)
THEN (FETCH (EXTERNALFORMAT NAME) OF NAME/EXTFORMAT)
ELSE (MKATOM NAME/EXTFORMAT)))
(SETQ *EXTERNALFORMATS* (DREMOVE (FIND EF IN *EXTERNALFORMATS*
SUCHTHAT (EQ NAME/EXTFORMAT (FETCH (EXTERNALFORMAT
NAME)
OF EF)))
*EXTERNALFORMATS*])
(FIND-FORMAT
[LAMBDA (NAME NOERROR) (* ; "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"])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(RPAQ? *EXTERNALFORMATS* NIL)
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
(* ;; "Generic functions not compiled open (originally on LLREAD)")
(DEFINEQ
(\OUTCHAR
[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.")
(* ;; "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)
CODE])
(\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
[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:")
(\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])
(\INCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:")
(* ;;
 "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; " EOLC of NIL means all patterns go to EOL")
(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:")
(* ;; "Create or modify a stream that will simulate the current character input/output byte sequences of STREAM. The set up here does what is common to all formats: an IO stream starting with STREAM external format and EOL.")
(* ;; "If the format has its own FORMATBYTESTREAMFN function, that is applied to copy any other state. (Currently that function is a property of the format, not carried over into a stream field that can be changed dynamically.)")
(CL:UNLESS (AND (STREAMP BYTESTREAM)
(\IOMODEP STREAM 'BOTH))
(SETQ BYTESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH)))
(LET ((FORMAT (FETCH (STREAM EXTERNALFORMAT) OF STREAM))
(EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)))
(\EXTERNALFORMAT BYTESTREAM FORMAT)
(CL:WHEN (EQ EOLC ANY.EOLC)
(SETQ EOLC (OR (FETCH (EXTERNALFORMAT EOL) OF FORMAT)
LF.EOLC)))
(REPLACE (STREAM EOLCONVENTION) OF BYTESTREAM WITH EOLC)
(SETFILEPTR BYTESTREAM 0)
(SETFILEINFO BYTESTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
(CL:WHEN (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
(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%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP)
(COND
((EQ EOLC 'NOEOLC)
CH)
(T (SELCHARQ CH
(LF (SELECTC (OR EOLC (FFETCH (STREAM
EOLCONVENTION
)
OF STRM))
((LIST LF.EOLC ANY.EOLC)
(CHARCODE EOL))
(CHARCODE LF)))
(CR (SELECTC (OR EOLC (FFETCH (STREAM
EOLCONVENTION
)
OF STRM))
(CR.EOLC (CHARCODE EOL))
((LIST ANY.EOLC CRLF.EOLC)
(\CHECKEOLC.CRLF STRM PEEKBINFLG
COUNTP))
(CHARCODE CR)))
CH])
)
(* "END EXPORTED DEFINITIONS")
)
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
(DEFINEQ
(\CREATE.THROUGH.EXTERNALFORMAT
[LAMBDA NIL (* ; "Edited 23-Jun-2021 13:34 by rmk:")
(* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :THROUGH as its name. EOL is adjusted to CR so as not to do any eol conversion on this stream.")
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT
NAME _ :THROUGH
INCCODEFN _ (FUNCTION \THROUGHIN)
PEEKCCODEFN _ (FUNCTION \PEEKBIN)
BACKCCODEFN _ (FUNCTION \THROUGHBACKCCODE)
OUTCHARFN _ (FUNCTION \THROUGHOUTCHARFN)
EOL _ CR.EOLC])
(\THROUGHIN
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
(* ;;; "If COUNTP is non-NIL, the byte counter is always set to 1.")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
(\BIN STREAM])
(\THROUGHBACKCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
T)])
(\THROUGHOUTCHARFN
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
(* ;;; "Encoder for THROUGH format.")
(COND
((> CHARCODE 255)
(\BOUT OUTSTREAM (\CHARSET CHARCODE))
(\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))
(T (\BOUT OUTSTREAM CHARCODE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5657 12044 (\EXTERNALFORMAT 5667 . 10729) (MAKE-EXTERNALFORMAT 10731 . 12042)) (12045
15158 (\INSTALL.EXTERNALFORMAT 12055 . 13504) (\REMOVE.EXTERNALFORMAT 13506 . 14337) (FIND-FORMAT
14339 . 15156)) (15488 27986 (\OUTCHAR 15498 . 16634) (\INCCODE 16636 . 17822) (\BACKCCODE 17824 .
18718) (\BACKCCODE.EOLC 18720 . 21483) (\PEEKCCODE 21485 . 21801) (\PEEKCCODE.NOEOLC 21803 . 22065) (
\INCCODE.EOLC 22067 . 23926) (\FORMATBYTESTREAM 23928 . 25418) (\CHECKEOLC.CRLF 25420 . 27984)) (29929
31772 (\CREATE.THROUGH.EXTERNALFORMAT 29939 . 30741) (\THROUGHIN 30743 . 31163) (\THROUGHBACKCCODE
31165 . 31432) (\THROUGHOUTCHARFN 31434 . 31770)))))
STOP

BIN
sources/EXTERNALFORMAT.LCOM Normal file
View File

Binary file not shown.

410
sources/FILEIO
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Sep-2021 15:54:14" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;92 178421
(FILECREATED "25-Sep-2021 21:02:29" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;99 162362
changes to%: (RECORDS FDEV)
changes to%: (VARS FILEIOCOMS)
(RECORDS FDEV)
previous date%: "13-Aug-2021 18:39:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;91)
previous date%: "25-Sep-2021 17:25:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;98)
(* ; "
@@ -51,20 +52,6 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(RECORDS FDEV FILEGENOBJ)))
(INITRECORDS FDEV)
(SYSRECORDS FDEV))
[COMS (* ;
 "EXTERNALFORMAT declaration and related functions")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
(FNS MAKE-EXTERNALFORMAT)
(INITRECORDS EXTERNALFORMAT)
(SYSRECORDS EXTERNALFORMAT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT \EXTERNALFORMAT)
(INITVARS [*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*EXTERNALFORMATS* NIL))
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(EXPORT (INITVARS (*DEFAULT-EXTERNALFORMAT* :XCCS)))
(COMS (FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE
\THROUGHOUTCHARFN)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT]
(COMS (* ; "Device operations")
(FNS \DEFINEDEVICE \GETDEVICEFROMNAME \GETDEVICEFROMHOSTNAME \REMOVEDEVICE
\REMOVEDEVICE.NAMES)
@@ -573,9 +560,9 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(DEFINEQ
(STREAMPROP
[LAMBDA X (* rda%: "22-Aug-84 14:24")
[LAMBDA X (* rda%: "22-Aug-84 14:24")
(* ;; "general top level entry for both fetching and setting stream properties.")
(* ;; "general top level entry for both fetching and setting stream properties.")
(COND
((IGREATERP X 2)
@@ -588,24 +575,24 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(T (\ILLEGAL.ARG NIL])
(GETSTREAMPROP
[LAMBDA (STREAM PROP) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:17")
[LAMBDA (STREAM PROP) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:17")
(SELECTQ PROP
((FORMAT EXTERNALFORMAT)
(\EXTERNALFORMAT STREAM))
(\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:")
(* rda%: "22-Aug-84 16:11")
[LAMBDA (STREAM PROP VALUE) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:11")
(SELECTQ PROP
((FORMAT EXTERNALFORMAT)
(* ;; "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.")
(* ;; "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))))
(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))
@@ -614,7 +601,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
[COND
(VALUE (LISTPUT OLDDATA PROP VALUE))
(OLDVALUE (* ; "Remove the property")
(OLDVALUE (* ; "Remove the property")
(COND
((EQ (CAR OLDDATA)
PROP)
@@ -629,7 +616,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
OLDVALUE)
(VALUE (replace OTHERPROPS of STREAM with (LIST PROP
VALUE))
(* ; "know old value is NIL")
(* ; "know old value is NIL")
NIL])
(STREAMP
@@ -957,8 +944,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
OPENP _ (FUNCTION NILL)
UNREGISTERFILE _ (FUNCTION NILL)
CHARSETFN _ (FUNCTION \GENERIC.CHARSET)
BREAKCONNECTION _ (FUNCTION NILL)
DEFAULTEXTERNALFORMAT _ *DEFAULT-EXTERNALFORMAT*)
BREAKCONNECTION _ (FUNCTION NILL))
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
)
@@ -1182,288 +1168,6 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(* ; "EXTERNALFORMAT declaration and related functions")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
(EOL BITS 2)
(NIL BITS 1)
(INCCODEFN POINTER) (* ;
 "Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
(PEEKCCODEFN POINTER) (* ;
 "Called with three arguments -- STREAM, NOERROR, and EOL")
(BACKCCODEFN POINTER) (* ;
 "Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
(OUTCHARFN POINTER) (* ;
 "Called with two arguments -- STREAM and CHARCODE")
(NAME POINTER) (* ;
 "keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
(EF1 POINTER) (* ;
 "Extra fields for use of particular formats. Possibly to hold standardized translation tables")
(EF2 POINTER)))
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
(BITS 1)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (BITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(* "END EXPORTED DEFINITIONS")
)
(DEFINEQ
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL)
(* ; "Edited 1-Aug-2021 23:13 by rmk:")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
((LIST 'CR CR.EOLC)
CR.EOLC)
((LIST 'CRLF CRLF.EOLC)
CRLF.EOLC)
(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])
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
(BITS 1)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (BITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(ADDTOVAR SYSTEMRECLST
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
(EOL BITS 2)
(NIL BITS 1)
(INCCODEFN POINTER)
(PEEKCCODEFN POINTER)
(BACKCCODEFN POINTER)
(OUTCHARFN POINTER)
(NAME POINTER)
(FORMATBYTESTREAMFN POINTER)
(EF1 POINTER)
(EF2 POINTER)))
)
(DEFINEQ
(\INSTALL.EXTERNALFORMAT
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-Aug-2021 14:22 by rmk:")
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
(* ;;; "For backward compatibility, the first argument can be a NAME with the second argument being the format. If so, the NAME must match the name inside the format")
(LET (NAME)
(IF EXTERNALFORMAT
THEN
(* ;; "Backwards compatibility")
(SETQ NAME (MKATOM EXTFORMAT/NAME))
(IF (EQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT))
ELSEIF (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)
THEN (ERROR "Mismatch of specified name and name of the external format")
ELSE (REPLACE (EXTERNALFORMAT NAME) OF EXTERNALFORMAT WITH
NAME))
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
THEN (\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
EXTERNALFORMAT])
(\REMOVE.EXTERNALFORMAT
[LAMBDA (NAME/EXTFORMAT) (* ; "Edited 5-May-2021 15:42 by rmk:")
(* ;;; "Deregisters external format EXTERNALFORMAT .")
(SETQ NAME/EXTFORMAT (IF (TYPE? EXTERNALFORMAT NAME/EXTFORMAT)
THEN (FETCH (EXTERNALFORMAT NAME) OF NAME/EXTFORMAT)
ELSE (MKATOM NAME/EXTFORMAT)))
(SETQ *EXTERNALFORMATS* (DREMOVE (FIND EF IN *EXTERNALFORMATS*
SUCHTHAT (EQ NAME/EXTFORMAT (FETCH (EXTERNALFORMAT
NAME)
OF EF)))
*EXTERNALFORMATS*])
(FIND-FORMAT
[LAMBDA (NAME NOERROR) (* ; "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"])
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 8-Aug-2021 14:30 by rmk:")
(* ; "Edited 26-Feb-91 13:20 by nm")
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
(* ;;; "")
(* ;;; "If NEWFORMAT/NAME is nil, just returns the current external format name of STREAM. If NEWFORMAT/NAME is supplied and it is or names an external format, then the external format of STREAM is set to that format.")
(* ;;; "")
(* ;;; ":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. ")
(\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)
[COND
((type? EXTERNALFORMAT NEWFORMAT/NAME)
(SETQ EXTFORMAT NEWFORMAT/NAME))
(T (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"))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
(UNINTERRUPTABLY
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch
(EXTERNALFORMAT
EOL) of
EXTFORMAT
)))
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT
OUTCHARFN)
of EXTFORMAT))
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
INCCODEFN)
of EXTFORMAT))
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
PEEKCCODEFN)
of EXTFORMAT))
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
BACKCCODEFN)
of EXTFORMAT)))])
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
)
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
(RPAQ? *EXTERNALFORMATS* NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(* "FOLLOWING DEFINITIONS EXPORTED")
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
(* "END EXPORTED DEFINITIONS")
(DEFINEQ
(\CREATE.THROUGH.EXTERNALFORMAT
[LAMBDA NIL (* ; "Edited 23-Jun-2021 13:34 by rmk:")
(* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :THROUGH as its name. EOL is adjusted to CR so as not to do any eol conversion on this stream.")
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT
NAME _ :THROUGH
INCCODEFN _ (FUNCTION \THROUGHIN)
PEEKCCODEFN _ (FUNCTION \PEEKBIN)
BACKCCODEFN _ (FUNCTION \THROUGHBACKCCODE)
OUTCHARFN _ (FUNCTION \THROUGHOUTCHARFN)
EOL _ CR.EOLC])
(\THROUGHIN
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
(* ;;; "If COUNTP is non-NIL, the byte counter is always set to 1.")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
(\BIN STREAM])
(\THROUGHBACKCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
T)])
(\THROUGHOUTCHARFN
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
(* ;;; "Encoder for THROUGH format.")
(COND
((> CHARCODE 255)
(\BOUT OUTSTREAM (\CHARSET CHARCODE))
(\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))
(T (\BOUT OUTSTREAM CHARCODE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(* ; "Device operations")
(DEFINEQ
@@ -3396,44 +3100,40 @@ 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))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (28396 31886 (STREAMPROP 28406 . 28840) (GETSTREAMPROP 28842 . 29315) (PUTSTREAMPROP
29317 . 31734) (STREAMP 31736 . 31884)) (31929 34448 (\DEFPRINT.BY.NAME 31939 . 33091) (
\STREAM.DEFPRINT 33093 . 34141) (\FDEV.DEFPRINT 34143 . 34446)) (34706 39747 (\GETACCESS 34716 . 35170
) (\SETACCESS 35172 . 39745)) (63132 64385 (MAKE-EXTERNALFORMAT 63142 . 64383)) (65618 73447 (
\INSTALL.EXTERNALFORMAT 65628 . 67077) (\REMOVE.EXTERNALFORMAT 67079 . 67910) (FIND-FORMAT 67912 .
68729) (\EXTERNALFORMAT 68731 . 73445)) (73770 75633 (\CREATE.THROUGH.EXTERNALFORMAT 73780 . 74582) (
\THROUGHIN 74584 . 75008) (\THROUGHBACKCCODE 75010 . 75281) (\THROUGHOUTCHARFN 75283 . 75631)) (75741
81710 (\DEFINEDEVICE 75751 . 78067) (\GETDEVICEFROMNAME 78069 . 78542) (\GETDEVICEFROMHOSTNAME 78544
. 79588) (\REMOVEDEVICE 79590 . 80713) (\REMOVEDEVICE.NAMES 80715 . 81708)) (81750 106410 (\CLOSEFILE
81760 . 82585) (\DELETEFILE 82587 . 82881) (\DEVICEEVENT 82883 . 84653) (\GENERATEFILES 84655 . 85133
) (\GENERATENEXTFILE 85135 . 85786) (\GENERATEFILEINFO 85788 . 86249) (\GETFILENAME 86251 . 86640) (
\GENERIC.OUTFILEP 86642 . 87112) (\OPENFILE 87114 . 89692) (\DO.PARAMS.AT.OPEN 89694 . 92247) (
\RENAMEFILE 92249 . 92673) (\REVALIDATEFILE 92675 . 95277) (\PAGED.REVALIDATEFILELST 95279 . 96837) (
\PAGED.REVALIDATEFILES 96839 . 98558) (\PAGED.REVALIDATEFILE 98560 . 100843) (\BUFFERED.REVALIDATEFILE
100845 . 103131) (\BUFFERED.REVALIDATEFILELST 103133 . 104317) (\PRINT-REVALIDATION-RESULT 104319 .
104734) (\TRUNCATEFILE 104736 . 105127) (\FILE-CONFLICT 105129 . 106408)) (106446 111109 (
\GENERATENOFILES 106456 . 108552) (\NULLFILEGENERATOR 108554 . 108798) (\NOFILESNEXTFILEFN 108800 .
110791) (\NOFILESINFOFN 110793 . 111107)) (111228 113136 (\FILE.NOT.OPEN 111238 . 111751) (
\FILE.WONT.OPEN 111753 . 112081) (\ILLEGAL.DEVICEOP 112083 . 112365) (\IS.NOT.RANDACCESSP 112367 .
112813) (\STREAM.NOT.OPEN 112815 . 113134)) (113271 115569 (\FDEVINSTANCE 113281 . 115567)) (117119
124493 (CNDIR 117129 . 118434) (DIRECTORYNAME 118436 . 122619) (DIRECTORYNAMEP 122621 . 123237) (
HOSTNAMEP 123239 . 124046) (\ADD.CONNECTED.DIR 124048 . 124491)) (124538 151925 (\BACKFILEPTR 124548
. 124736) (\BACKPEEKBIN 124738 . 125099) (\BACKBIN 125101 . 125452) (BIN 125454 . 125671) (\BIN
125673 . 125950) (\BINS 125952 . 126238) (BOUT 126240 . 126602) (\BOUT 126604 . 126919) (\BOUTS 126921
. 127232) (COPYBYTES 127234 . 130566) (COPYCHARS 130568 . 134234) (COPYFILE 134236 . 135033) (
\COPYOPENFILE 135035 . 138108) (\INFER.FILE.TYPE 138110 . 139064) (EOFP 139066 . 139363) (FORCEOUTPUT
139365 . 139612) (\FLUSH.OPEN.STREAMS 139614 . 139970) (CHARSET 139972 . 141636) (ACCESS-CHARSET
141638 . 141855) (GETEOFPTR 141857 . 142107) (GETFILEINFO 142109 . 145302) (\TYPE.FROM.FILETYPE 145304
. 145774) (\FILETYPE.FROM.TYPE 145776 . 145955) (GETFILEPTR 145957 . 146209) (SETFILEINFO 146211 .
149824) (SETFILEPTR 149826 . 151545) (BOUT16 151547 . 151732) (BIN16 151734 . 151923)) (152028 157233
(\GENERIC.BINS 152038 . 152318) (\GENERIC.BOUTS 152320 . 152585) (\GENERIC.RENAMEFILE 152587 . 154418)
(\GENERIC.OPENP 154420 . 155735) (\GENERIC.READP 155737 . 156778) (\GENERIC.CHARSET 156780 . 157231))
(157234 157573 (\MAP-OPEN-STREAMS 157244 . 157571)) (159443 161523 (\EOF.ACTION 159453 . 159704) (
\EOSERROR 159706 . 159899) (\GETEOFPTR 159901 . 160083) (\INCFILEPTR 160085 . 160435) (\PEEKBIN 160437
. 160628) (\SETCLOSEDFILELENGTH 160630 . 160964) (\SETEOFPTR 160966 . 161154) (\SETFILEPTR 161156 .
161521)) (161524 162066 (\FIXPOUT 161534 . 161834) (\FIXPIN 161836 . 162064)) (162067 162633 (\BOUTEOL
162077 . 162631)) (165725 175589 (\BUFFERED.BIN 165735 . 166587) (\BUFFERED.PEEKBIN 166589 . 167371)
(\BUFFERED.BOUT 167373 . 168233) (\BUFFERED.BINS 168235 . 171920) (\BUFFERED.BOUTS 171922 . 173723) (
\BUFFERED.COPYBYTES 173725 . 175587)) (175618 177970 (\NULLDEVICE 175628 . 177646) (\NULL.OPENFILE
177648 . 177968)))))
(FILEMAP (NIL (27462 30940 (STREAMPROP 27472 . 27906) (GETSTREAMPROP 27908 . 28377) (PUTSTREAMPROP
28379 . 30788) (STREAMP 30790 . 30938)) (30983 33502 (\DEFPRINT.BY.NAME 30993 . 32145) (
\STREAM.DEFPRINT 32147 . 33195) (\FDEV.DEFPRINT 33197 . 33500)) (33760 38801 (\GETACCESS 33770 . 34224
) (\SETACCESS 34226 . 38799)) (59682 65651 (\DEFINEDEVICE 59692 . 62008) (\GETDEVICEFROMNAME 62010 .
62483) (\GETDEVICEFROMHOSTNAME 62485 . 63529) (\REMOVEDEVICE 63531 . 64654) (\REMOVEDEVICE.NAMES 64656
. 65649)) (65691 90351 (\CLOSEFILE 65701 . 66526) (\DELETEFILE 66528 . 66822) (\DEVICEEVENT 66824 .
68594) (\GENERATEFILES 68596 . 69074) (\GENERATENEXTFILE 69076 . 69727) (\GENERATEFILEINFO 69729 .
70190) (\GETFILENAME 70192 . 70581) (\GENERIC.OUTFILEP 70583 . 71053) (\OPENFILE 71055 . 73633) (
\DO.PARAMS.AT.OPEN 73635 . 76188) (\RENAMEFILE 76190 . 76614) (\REVALIDATEFILE 76616 . 79218) (
\PAGED.REVALIDATEFILELST 79220 . 80778) (\PAGED.REVALIDATEFILES 80780 . 82499) (\PAGED.REVALIDATEFILE
82501 . 84784) (\BUFFERED.REVALIDATEFILE 84786 . 87072) (\BUFFERED.REVALIDATEFILELST 87074 . 88258) (
\PRINT-REVALIDATION-RESULT 88260 . 88675) (\TRUNCATEFILE 88677 . 89068) (\FILE-CONFLICT 89070 . 90349)
) (90387 95050 (\GENERATENOFILES 90397 . 92493) (\NULLFILEGENERATOR 92495 . 92739) (\NOFILESNEXTFILEFN
92741 . 94732) (\NOFILESINFOFN 94734 . 95048)) (95169 97077 (\FILE.NOT.OPEN 95179 . 95692) (
\FILE.WONT.OPEN 95694 . 96022) (\ILLEGAL.DEVICEOP 96024 . 96306) (\IS.NOT.RANDACCESSP 96308 . 96754) (
\STREAM.NOT.OPEN 96756 . 97075)) (97212 99510 (\FDEVINSTANCE 97222 . 99508)) (101060 108434 (CNDIR
101070 . 102375) (DIRECTORYNAME 102377 . 106560) (DIRECTORYNAMEP 106562 . 107178) (HOSTNAMEP 107180 .
107987) (\ADD.CONNECTED.DIR 107989 . 108432)) (108479 135866 (\BACKFILEPTR 108489 . 108677) (
\BACKPEEKBIN 108679 . 109040) (\BACKBIN 109042 . 109393) (BIN 109395 . 109612) (\BIN 109614 . 109891)
(\BINS 109893 . 110179) (BOUT 110181 . 110543) (\BOUT 110545 . 110860) (\BOUTS 110862 . 111173) (
COPYBYTES 111175 . 114507) (COPYCHARS 114509 . 118175) (COPYFILE 118177 . 118974) (\COPYOPENFILE
118976 . 122049) (\INFER.FILE.TYPE 122051 . 123005) (EOFP 123007 . 123304) (FORCEOUTPUT 123306 .
123553) (\FLUSH.OPEN.STREAMS 123555 . 123911) (CHARSET 123913 . 125577) (ACCESS-CHARSET 125579 .
125796) (GETEOFPTR 125798 . 126048) (GETFILEINFO 126050 . 129243) (\TYPE.FROM.FILETYPE 129245 . 129715
) (\FILETYPE.FROM.TYPE 129717 . 129896) (GETFILEPTR 129898 . 130150) (SETFILEINFO 130152 . 133765) (
SETFILEPTR 133767 . 135486) (BOUT16 135488 . 135673) (BIN16 135675 . 135864)) (135969 141174 (
\GENERIC.BINS 135979 . 136259) (\GENERIC.BOUTS 136261 . 136526) (\GENERIC.RENAMEFILE 136528 . 138359)
(\GENERIC.OPENP 138361 . 139676) (\GENERIC.READP 139678 . 140719) (\GENERIC.CHARSET 140721 . 141172))
(141175 141514 (\MAP-OPEN-STREAMS 141185 . 141512)) (143384 145464 (\EOF.ACTION 143394 . 143645) (
\EOSERROR 143647 . 143840) (\GETEOFPTR 143842 . 144024) (\INCFILEPTR 144026 . 144376) (\PEEKBIN 144378
. 144569) (\SETCLOSEDFILELENGTH 144571 . 144905) (\SETEOFPTR 144907 . 145095) (\SETFILEPTR 145097 .
145462)) (145465 146007 (\FIXPOUT 145475 . 145775) (\FIXPIN 145777 . 146005)) (146008 146574 (\BOUTEOL
146018 . 146572)) (149666 159530 (\BUFFERED.BIN 149676 . 150528) (\BUFFERED.PEEKBIN 150530 . 151312)
(\BUFFERED.BOUT 151314 . 152174) (\BUFFERED.BINS 152176 . 155861) (\BUFFERED.BOUTS 155863 . 157664) (
\BUFFERED.COPYBYTES 157666 . 159528)) (159559 161911 (\NULLDEVICE 159569 . 161587) (\NULL.OPENFILE
161589 . 161909)))))
STOP

BIN
sources/FILEIO.LCOM
View File

Binary file not shown.

169
sources/FILESETS
View File

@@ -1,169 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jun-2021 10:21:40" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;6 6395
changes to%: (VARS 0LISPSET)
previous date%: "19-Jun-2021 12:13:31"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;5)
(* ; "
Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT FILESETSCOMS)
(RPAQQ FILESETSCOMS
(
(* ;;; "contains all of the lists of files which are used in various ways")
(* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel")
(* ;; "The file with the default EXTERNALFORMAT should come right after FILEIO, and particularly before ATERM.")
(VARS * FILESETS)
(VARS EXPORTFILES)
(VARS MAKEINITFILES MAKEINITTYPES RENAMETYPES ABCFILES READSYSFILES DATABASEFILES)
(VARS DEADFNS)))
(* ;;; "contains all of the lists of files which are used in various ways")
(* ;;
"I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel"
)
(* ;;
"The file with the default EXTERNALFORMAT should come right after FILEIO, and particularly before ATERM."
)
(RPAQQ FILESETS (0LISPSET 1LISPSET 2LISPSET 3LISPSET))
(RPAQQ 0LISPSET (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO IMAGEIO LLBASIC LLGC
LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS
LLARITH LLFLOAT LLBIGNUM LLREAD XCCS LLCHAR LLSTK LLDATATYPE IOCHAR LLKEY
LLTIMER))
(RPAQQ 1LISPSET
(ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC
AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART
LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY
DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST
CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT))
(RPAQQ 2LISPSET (MACHINEINDEPENDENT POSTLOADUP))
(RPAQQ 3LISPSET (MACROS DLAP BYTECOMPILER COMPILE))
(RPAQQ EXPORTFILES
(MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR
LLSTK PMAP LLGC ATBL FILEIO LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT
RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER IMAGEIO PROC XCCS
LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS))
(RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW))
(RPAQQ MAKEINITTYPES
((NIL INIT (0 1)
2LISPSET 1600)
(SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO LLBASIC LLGC LLINTERP LLARITH LLREAD
LLCHAR TINYPATCH))
(MACROTEST MACROTEST ((MACROTEST)
0 1)
2LISPSET)
(MICROTEST MICROTEST ((MICROTEST LLFAULT LLSTK LLSUBRS LLKEY LLBFS)))
(NANOTEST NANOTEST ((MICROTEST LLSUBRS)))
(NULL NULL ((DUMMY)))
(MILLITEST MILLITEST
((MACROTEST LLFAULT LLSUBRS LLNEW LLBASIC LLGC LLINTERP LLARITH LLFLOAT LLARRAYELT
LLSTK LLDATATYPE LLKEY ABASIC LLCHAR ASTACK MISC APUTDQ)))
(CHECKARRAYS CHECKARRAYS (CHECKARRAYSPACE 0 1)
2LISPSET)))
(RPAQQ RENAMETYPES
((I (FILES LLPARAMS LLCODE LLARRAYELT LLCHAR LLNEW LLBASIC LLDATATYPE LLGC LLSTK RENAMEMACROS
MODARITH LLFAULT LLKEY LLBFS LLTIMER)
(RENAMEDFILE . I-NEW)
(SUBNAME . MKI.SUBFNS)
(COMSNAME . INEWCOMS)
(EXTRACOMS (VARS INITPTRS INITVALUES)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
MAKEINIT)))
(MKI.SUBFNS)
(INEWCOMS)
(VALUES . INITVALUES)
(PTRS . INITPTRS)
(PREFIX . I.)
(VAG2FN . I.VAG2))
(R (FILES LLCODE LLPARAMS LLBASIC LLDATATYPE LLNEW ACODE LLARRAYELT LLCHAR LLINTERP LLSTK
RENAMEMACROS MODARITH LLFAULT)
(RENAMEDFILE . RDSYS)
(SUBNAME . RD.SUBFNS)
(COMSNAME . RDCOMS)
(EXTRACOMS
(* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)")
(FILES VMEM)
(VARS RDVALS RDPTRS)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
VMEM)))
(RD.SUBFNS (\CALLME . *))
(RDCOMS)
(PTRS . RDPTRS)
(PREFIX . V)
(VAG2FN . VVAG2)
(VALUES . RDVALS)
(RDPTRS)
(RDVALUES))))
(RPAQQ ABCFILES (LOADABC COMPILEBANG SAMEDIR WHEREIS COMPILEFORMSLIST CHECKSET CMACROS DCODEFOR10
DTDECLARE BYTECOMPILER DLAP LLCODE ACODE MACROAUX))
(RPAQQ READSYSFILES (RDSYS READSYS VMEM REMOTEVMEM))
(RPAQQ DATABASEFILES (0LISPSET 1LISPSET (2LISPSET ACODE)
(3LISPSET DLAP)
(4LISPSET DFILE DMISC)
7LISPSET
(8LISPSET MAKEINIT MEM)
9LISPSET
(10LISPSET LLPARAMS)
(NIL CHECKARRAYSPACE MAKEINEW PMEMSTATS PPAGESTATS LLFCOMPILE)))
(RPAQQ DEADFNS
((PUTBASE \PUTBASE)
(GETBASE \GETBASE)
(ADDBASE \ADDBASE)
(GETBASEBYTE \GETBASEBYTE)
(PUTBASEBYTE \PUTBASEBYTE)
(PUTBASEPTR \PUTBASEPTR)
(HILOC \HILOC)
(LOLOC \LOLOC)
(VAG2 \VAG2)
(PAGEBASE NIL)
(PAGELOC NIL)
(WordsPerPage WORDSPERPAGE)
(ALTOMACRO DMACRO)
(\STACKSPACE ??)
(GETBASEPTR \GETBASEPTR)
(FPLUS2)
(FTIMES2)
(CREATECELL \CREATECELL)))
(PUTPROPS FILESETS COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990
1998 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

1965
sources/LLREAD
View File

File diff suppressed because it is too large Load Diff

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.