github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-18 01:22:09 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'Miscellaneous-format-stuff'

Browse Source
This commit is contained in:
Larry Masinter 2021-08-06 13:38:26 -07:00
commit 9ab24c044d
6 changed files with 1022 additions and 1029 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
library/UNICODE
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 3-Jul-2021 13:37:33" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;175 66483
(FILECREATED " 6-Aug-2021 10:30:15" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;185 64537
changes to%: (FNS READ-UNICODE-MAPPING MAKE-UNICODE-FORMATS)
changes to%: (FNS \UTF16.BACKCCODEFN)
previous date%: " 3-Jul-2021 11:41:05"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;173)
previous date%: " 5-Aug-2021 22:34:22"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;184)
(PRETTYCOMPRINT UNICODECOMS)
@ -14,8 +14,8 @@
[(COMS
(* ;; "External formats")
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCHARFN)
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCHARFN)
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
(INITVARS (EXTERNALEOL 'LF))
(FNS MAKE-UNICODE-FORMATS)
(P (MAKE-UNICODE-FORMATS EXTERNALEOL))
@ -78,22 +78,16 @@
(DEFINEQ
(UTF8.OUTCHARFN
[LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 1-Feb-2021 15:50 by rmk:")
[LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 5-Aug-2021 22:34 by rmk:")
(* ; "Edited 17-Aug-2020 08:45 by rmk:")
(* ; "Edited 30-Jan-2020 23:08 by rmk:")
(* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream")
(* ;; "PRINT UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.")
(* ;; "Print UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.")
(IF (EQ CHARCODE (CHARCODE EOL))
THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
(\BOUT STREAM (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM)
(LF.EOLC (CHARCODE LF))
(CR.EOLC (CHARCODE CR))
(CRLF.EOLC (\BOUT STREAM (CHARCODE CR))
(CHARCODE LF))
(SHOULDNT)))
THEN (\BOUTEOL STREAM)
ELSE (CHANGE (FETCH (STREAM CHARPOSITION) OF STREAM)
(IPLUS DATUM 1)) (* ; "Avoid overflow")
(FOR C INSIDE (CL:IF RAW
@ -131,7 +125,17 @@
(UTF8.PEEKCCODEFN [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:53 by rmk:") (* ;; "Modeled this after \EUCPEEK on LLREAD. In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0. Returns NIL if NOERROR and either invalid UTF8 or end of file.") (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.") (* ;; "Do not do UNICODE to XCCS translation if RAW") (PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE) (SETQ BYTE1 (\PEEKBIN STREAM NOERROR)) (* ;; "Distinguish on header bytex") (CL:UNLESS BYTE1 (RETURN NIL)) [IF (ILESSP BYTE1 128) THEN (* ;;  "Test first: Ascii is the common case. No need to back up, since we peeked.") (SETQ CODE BYTE1) ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (\BIN STREAM) (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (IGEQ BYTE2 128)) (\BACKFILEPTR STREAM) (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (RETURN CODE)) (\BIN STREAM) (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) (IGEQ BYTE3 128)) (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (RETURN CODE)) (\BIN STREAM) (SETQ BYTE4 (\PEEKBIN STREAM NOERROR)) (* ;  "PEEK the last, no need to back it up") (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (IF (AND BYTE4 (IGEQ BYTE4 128)) THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6))) ELSEIF NOERROR ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (\BIN STREAM) (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (IGEQ BYTE2 128)) (\BACKFILEPTR STREAM) (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (RETURN CODE)) (\BIN STREAM) (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) (IF (AND BYTE3 (IGEQ BYTE3 128)) THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6))) ELSEIF NOERROR ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) ELSE (* ; "Must be 2 bytes") (\BIN STREAM) (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM) (IF (AND BYTE2 (IGEQ BYTE2 128)) THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6))) ELSEIF NOERROR ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2] (CL:WHEN (AND CODE (NOT RAW)) (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) (RETURN CODE])
(\UTF8.BACKCHARFN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:38 by rmk:") (* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT") (BIND (C _ 0) WHILE (CL:WHEN (\BACKFILEPTR STREAM) (ADD C 1) (EQ 2 (LRSH (\PEEKBIN STREAM) 6))) REPEATUNTIL (EQ C 4) FINALLY (CL:WHEN BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL C)))])
(\UTF8.BACKCCODEFN
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:38 by rmk:")
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT")
(BIND (C _ 0) WHILE (CL:WHEN (\BACKFILEPTR STREAM)
(ADD C 1)
(EQ 2 (LRSH (\PEEKBIN STREAM)
6))) REPEATUNTIL (EQ C 4)
FINALLY (CL:WHEN BYTECOUNTVAR
(SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL C)))])
)
(DEFINEQ
@ -155,61 +159,57 @@
(UTF16BE.PEEKCCODEFN [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:58 by rmk:") (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.") (* ;; "Do not do UNICODE to XCCS translation if RAW") (LET (BYTE1 BYTE2 CODE) (SETQ BYTE1 (\PEEKBIN STREAM NOERROR)) (IF BYTE1 THEN (\BIN STREAM) (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) (\BACKFILEPTR STREAM) (IF BYTE2 THEN (SETQ CODE (LOGOR (LLSH BYTE1 8) BYTE2)) (CL:IF RAW CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)) ELSEIF NOERROR THEN NIL) ELSEIF NOERROR THEN NIL ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
(\UTF16.BACKCHARFN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:35 by rmk:") (* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.") (* ;; "Common for big-ending and little-ending") (IF (NOT (\BACKFILEPTR STREAM)) ELSEIF (\BACKFILEPTR STREAM) THEN (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2))) ELSE (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL])
(\UTF16.BACKCCODEFN
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 6-Aug-2021 10:15 by rmk:")
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")
(* ;; "Common for big-ending and little-ending")
(CL:WHEN (\BACKFILEPTR STREAM)
[IF (\BACKFILEPTR STREAM)
THEN (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2)))
ELSE (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL])])
)
(RPAQ? EXTERNALEOL 'LF)
(DEFINEQ
(MAKE-UNICODE-FORMATS
[LAMBDA (EXTERNALEOL) (* ; "Edited 3-Jul-2021 13:17 by rmk:")
[LAMBDA (EXTERNALEOL) (* ; "Edited 1-Aug-2021 23:18 by rmk:")
(* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")
(* ;; "The EXTERNALEOL specifies the EOLCONVENTION of the stream, particularly to produce output files with the desired convention. On input the macro \CHECKEOLC (LLREAD) coerces only that coding to the internal EOL, which is a mistake.")
(SETQ EXTERNALEOL (SELECTQ EXTERNALEOL
(LF LF.EOLC)
(CR CR.EOLC)
(CRLF CRLF.EOLC)
(SHOULDNT)))
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ :UTF16BE
EOL _ EXTERNALEOL
INCCODEFN _ (FUNCTION UTF16BE.INCCODEFN)
PEEKCCODEFN _ (FUNCTION UTF16BE.PEEKCCODEFN)
BACKCCODEFN _ (FUNCTION \UTF16.BACKCHARFN)
OUTCHARFN _ (FUNCTION UTF16BE.OUTCHARFN)))
[\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ :UTF16BE-RAW
EOL _ EXTERNALEOL
INCCODEFN _ [FUNCTION (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
(UTF16BE.INCCODEFN STREAM
BYTECOUNTVAR BYTECOUNTVAL T]
PEEKCCODEFN _ [FUNCTION (LAMBDA (STREAM NOERROR)
(UTF16BE.PEEKCCODEFN STREAM NOERROR
T]
BACKCCODEFN _ (FUNCTION \UTF16.BACKCHARFN)
OUTCHARFN _ (FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF16BE.OUTCHARFN STREAM CHARCODE T]
[\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ :UTF-8-RAW
EOL _ EXTERNALEOL
INCCODEFN _ [FUNCTION (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
(UTF8.INCCODEFN STREAM BYTECOUNTVAR
BYTECOUNTVAL T]
PEEKCCODEFN _ [FUNCTION (LAMBDA (STREAM NOERROR)
(UTF8.PEEKCCODEFN STREAM NOERROR T]
BACKCCODEFN _ (FUNCTION \UTF8.BACKCHARFN)
OUTCHARFN _ (FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF8.OUTCHARFN STREAM CHARCODE T]
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ :UTF-8
EOL _ EXTERNALEOL
INCCODEFN _ (FUNCTION UTF8.INCCODEFN)
PEEKCCODEFN _ (FUNCTION UTF8.PEEKCCODEFN)
BACKCCODEFN _ (FUNCTION \UTF8.BACKCHARFN)
OUTCHARFN _ (FUNCTION UTF8.OUTCHARFN])
(MAKE-EXTERNALFORMAT :UTF-8 (FUNCTION UTF8.INCCODEFN)
(FUNCTION UTF8.PEEKCCODEFN)
(FUNCTION \UTF8.BACKCCODEFN)
(FUNCTION UTF8.OUTCHARFN)
NIL EXTERNALEOL)
(MAKE-EXTERNALFORMAT :UTF-8-RAW [FUNCTION (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
(UTF8.INCCODEFN STREAM BYTECOUNTVAR BYTECOUNTVAL
T]
[FUNCTION (LAMBDA (STREAM NOERROR)
(UTF8.PEEKCCODEFN STREAM NOERROR T]
(FUNCTION \UTF8.BACKCCODEFN)
[FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF8.OUTCHARFN STREAM CHARCODE T]
NIL EXTERNALEOL)
(MAKE-EXTERNALFORMAT :UTF-16BE (FUNCTION UTF16BE.INCCODEFN)
(FUNCTION UTF16BE.PEEKCCODEFN)
(FUNCTION \UTF16.BACKCCODEFN)
(FUNCTION UTF16BE.OUTCHARFN)
NIL EXTERNALEOL)
(MAKE-EXTERNALFORMAT :UTF-16BE-RAW [FUNCTION (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL)
(UTF16BE.INCCODEFN STREAM BYTECOUNTVAR
BYTECOUNTVAL T]
[FUNCTION (LAMBDA (STREAM NOERROR)
(UTF16BE.PEEKCCODEFN STREAM NOERROR T]
(FUNCTION \UTF16.BACKCCODEFN)
[FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF16BE.OUTCHARFN STREAM CHARCODE T]
NIL EXTERNALEOL])
)
(MAKE-UNICODE-FORMATS EXTERNALEOL)
@ -993,15 +993,15 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4126 17801 (UTF8.OUTCHARFN 4136 . 7332) (UTF8.INCCODEFN 7334 . 12450) (UTF8.PEEKCCODEFN
12452 . 17226) (\UTF8.BACKCHARFN 17228 . 17799)) (17802 20994 (UTF16BE.OUTCHARFN 17812 . 18545) (
UTF16BE.INCCODEFN 18547 . 19430) (UTF16BE.PEEKCCODEFN 19432 . 20503) (\UTF16.BACKCHARFN 20505 . 20992)
) (21024 24537 (MAKE-UNICODE-FORMATS 21034 . 24535)) (24633 25939 (UNICODE.UNMAPPED 24643 . 25937)) (
25940 26476 (XCCS-UTF8-AFTER-OPEN 25950 . 26474)) (27546 27895 (XTOUCODE 27556 . 27724) (UTOXCODE
27726 . 27893)) (27935 44118 (READ-UNICODE-MAPPING-FILENAMES 27945 . 29107) (READ-UNICODE-MAPPING
29109 . 32407) (WRITE-UNICODE-MAPPING 32409 . 36626) (WRITE-UNICODE-INCLUDED 36628 . 41350) (
WRITE-UNICODE-MAPPING-HEADER 41352 . 42584) (WRITE-UNICODE-MAPPING-FILENAME 42586 . 44116)) (47455
55928 (MAKE-UNICODE-TRANSLATION-TABLES 47465 . 55926)) (56349 64253 (HEXSTRING 56359 . 57520) (
UTF8HEXSTRING 57522 . 59727) (NUTF8CODEBYTES 59729 . 60392) (NUTF8STRINGBYTES 60394 . 60875) (
XTOUSTRING 60877 . 63888) (XCCSSTRING 63890 . 64251)) (64254 65723 (SHOWCHARS 64264 . 65721)))))
(FILEMAP (NIL (4105 17365 (UTF8.OUTCHARFN 4115 . 6895) (UTF8.INCCODEFN 6897 . 12013) (UTF8.PEEKCCODEFN
12015 . 16789) (\UTF8.BACKCCODEFN 16791 . 17363)) (17366 20563 (UTF16BE.OUTCHARFN 17376 . 18109) (
UTF16BE.INCCODEFN 18111 . 18994) (UTF16BE.PEEKCCODEFN 18996 . 20067) (\UTF16.BACKCCODEFN 20069 . 20561
)) (20593 22591 (MAKE-UNICODE-FORMATS 20603 . 22589)) (22687 23993 (UNICODE.UNMAPPED 22697 . 23991)) (
23994 24530 (XCCS-UTF8-AFTER-OPEN 24004 . 24528)) (25600 25949 (XTOUCODE 25610 . 25778) (UTOXCODE
25780 . 25947)) (25989 42172 (READ-UNICODE-MAPPING-FILENAMES 25999 . 27161) (READ-UNICODE-MAPPING
27163 . 30461) (WRITE-UNICODE-MAPPING 30463 . 34680) (WRITE-UNICODE-INCLUDED 34682 . 39404) (
WRITE-UNICODE-MAPPING-HEADER 39406 . 40638) (WRITE-UNICODE-MAPPING-FILENAME 40640 . 42170)) (45509
53982 (MAKE-UNICODE-TRANSLATION-TABLES 45519 . 53980)) (54403 62307 (HEXSTRING 54413 . 55574) (
UTF8HEXSTRING 55576 . 57781) (NUTF8CODEBYTES 57783 . 58446) (NUTF8STRINGBYTES 58448 . 58929) (
XTOUSTRING 58931 . 61942) (XCCSSTRING 61944 . 62305)) (62308 63777 (SHOWCHARS 62318 . 63775)))))
STOP

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

143
sources/FILEIO
View File

@ -1,12 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 2-Aug-2021 10:13:47" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;68 180948
(FILECREATED " 6-Aug-2021 10:31:59" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;75 181074
changes to%: (FNS \INSTALL.EXTERNALFORMAT \EXTERNALFORMAT)
(RECORDS FDEV STREAM)
changes to%: (FNS \THROUGHIN)
previous date%: " 1-Aug-2021 23:16:14"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;64)
previous date%: " 5-Aug-2021 22:31:41"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;74)
(* ; "
@ -1278,7 +1277,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(DEFINEQ
(\INSTALL.EXTERNALFORMAT
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 2-Aug-2021 10:13 by rmk:")
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-Aug-2021 14:22 by rmk:")
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
@ -1299,9 +1298,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
(\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
NAME
THEN (\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
EXTERNALFORMAT])
@ -1328,7 +1326,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 2-Aug-2021 10:11 by rmk:")
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 5-Aug-2021 20:39 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.")
@ -1346,21 +1344,24 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(\DTEST STREAM 'STREAM)
(CL:WHEN NEWFORMAT/NAME
[LET (EXTFORMAT)
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
then (SETQ EXTFORMAT 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"))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT)))
[COND
((type? EXTERNALFORMAT NEWFORMAT/NAME)
(SETQ EXTFORMAT NEWFORMAT/NAME))
[(AND (TYPE? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ EXTFORMAT (FETCH (READER-ENVIRONMENT REFORMAT) OF 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)
@ -1414,13 +1415,14 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
EOL _ CR.EOLC])
(\THROUGHIN
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:49 by rmk:")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 6-Aug-2021 10:31 by rmk:")
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
(* ;;; "If COUNP is non-NIL, always -1 is returned as the second value.")
[CL:WHEN (BYTECOUNTVAR (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL]
(CL:WHEN BYTECOUNTVAR
(SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL)))
(\BIN STREAM])
(\THROUGHBACKCCODE
@ -3080,10 +3082,11 @@ update the map")
(DEFINEQ
(\BOUTEOL
[LAMBDA (STREAM) (* ; "Edited 1-Aug-2021 10:08 by rmk:")
[LAMBDA (STREAM) (* ; "Edited 5-Aug-2021 22:31 by rmk:")
(* ;; "Convenient closed function to put out EOL characters without depending on EXPORTS.ALL for constants. This could also set the position back to 0.")
(* ;; "Convenient closed function to put out EOL characters without depending on EXPORTS.ALL for constants. This also sets the position back to 0.")
(REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
(SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM)
(LF.EOLC (\BOUT STREAM (CHARCODE LF)))
(CR.EOLC (\BOUT STREAM (CHARCODE CR)))
@ -3417,44 +3420,44 @@ 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 (28483 31973 (STREAMPROP 28493 . 28927) (GETSTREAMPROP 28929 . 29402) (PUTSTREAMPROP
29404 . 31821) (STREAMP 31823 . 31971)) (32016 34535 (\DEFPRINT.BY.NAME 32026 . 33178) (
\STREAM.DEFPRINT 33180 . 34228) (\FDEV.DEFPRINT 34230 . 34533)) (34793 39834 (\GETACCESS 34803 . 35257
) (\SETACCESS 35259 . 39832)) (62838 64091 (MAKE-EXTERNALFORMAT 62848 . 64089)) (65277 72720 (
\INSTALL.EXTERNALFORMAT 65287 . 66748) (\REMOVE.EXTERNALFORMAT 66750 . 67581) (FIND-FORMAT 67583 .
68134) (\EXTERNALFORMAT 68136 . 72718)) (73043 74862 (\CREATE.THROUGH.EXTERNALFORMAT 73053 . 73855) (
\THROUGHIN 73857 . 74263) (\THROUGHBACKCCODE 74265 . 74510) (\THROUGHOUTCHARFN 74512 . 74860)) (74970
80939 (\DEFINEDEVICE 74980 . 77296) (\GETDEVICEFROMNAME 77298 . 77771) (\GETDEVICEFROMHOSTNAME 77773
. 78817) (\REMOVEDEVICE 78819 . 79942) (\REMOVEDEVICE.NAMES 79944 . 80937)) (80979 105639 (\CLOSEFILE
80989 . 81814) (\DELETEFILE 81816 . 82110) (\DEVICEEVENT 82112 . 83882) (\GENERATEFILES 83884 . 84362
) (\GENERATENEXTFILE 84364 . 85015) (\GENERATEFILEINFO 85017 . 85478) (\GETFILENAME 85480 . 85869) (
\GENERIC.OUTFILEP 85871 . 86341) (\OPENFILE 86343 . 88921) (\DO.PARAMS.AT.OPEN 88923 . 91476) (
\RENAMEFILE 91478 . 91902) (\REVALIDATEFILE 91904 . 94506) (\PAGED.REVALIDATEFILELST 94508 . 96066) (
\PAGED.REVALIDATEFILES 96068 . 97787) (\PAGED.REVALIDATEFILE 97789 . 100072) (\BUFFERED.REVALIDATEFILE
100074 . 102360) (\BUFFERED.REVALIDATEFILELST 102362 . 103546) (\PRINT-REVALIDATION-RESULT 103548 .
103963) (\TRUNCATEFILE 103965 . 104356) (\FILE-CONFLICT 104358 . 105637)) (105675 110338 (
\GENERATENOFILES 105685 . 107781) (\NULLFILEGENERATOR 107783 . 108027) (\NOFILESNEXTFILEFN 108029 .
110020) (\NOFILESINFOFN 110022 . 110336)) (110457 112365 (\FILE.NOT.OPEN 110467 . 110980) (
\FILE.WONT.OPEN 110982 . 111310) (\ILLEGAL.DEVICEOP 111312 . 111594) (\IS.NOT.RANDACCESSP 111596 .
112042) (\STREAM.NOT.OPEN 112044 . 112363)) (112500 114798 (\FDEVINSTANCE 112510 . 114796)) (116348
123722 (CNDIR 116358 . 117663) (DIRECTORYNAME 117665 . 121848) (DIRECTORYNAMEP 121850 . 122466) (
HOSTNAMEP 122468 . 123275) (\ADD.CONNECTED.DIR 123277 . 123720)) (123767 154410 (\BACKFILEPTR 123777
. 123965) (\BACKPEEKBIN 123967 . 124328) (\BACKBIN 124330 . 124681) (BIN 124683 . 124900) (\BIN
124902 . 125179) (\BINS 125181 . 125467) (BOUT 125469 . 125831) (\BOUT 125833 . 126148) (\BOUTS 126150
. 126461) (COPYBYTES 126463 . 129795) (COPYCHARS 129797 . 136719) (COPYFILE 136721 . 137518) (
\COPYOPENFILE 137520 . 140593) (\INFER.FILE.TYPE 140595 . 141549) (EOFP 141551 . 141848) (FORCEOUTPUT
141850 . 142097) (\FLUSH.OPEN.STREAMS 142099 . 142455) (CHARSET 142457 . 144121) (ACCESS-CHARSET
144123 . 144340) (GETEOFPTR 144342 . 144592) (GETFILEINFO 144594 . 147787) (\TYPE.FROM.FILETYPE 147789
. 148259) (\FILETYPE.FROM.TYPE 148261 . 148440) (GETFILEPTR 148442 . 148694) (SETFILEINFO 148696 .
152309) (SETFILEPTR 152311 . 154030) (BOUT16 154032 . 154217) (BIN16 154219 . 154408)) (154513 159718
(\GENERIC.BINS 154523 . 154803) (\GENERIC.BOUTS 154805 . 155070) (\GENERIC.RENAMEFILE 155072 . 156903)
(\GENERIC.OPENP 156905 . 158220) (\GENERIC.READP 158222 . 159263) (\GENERIC.CHARSET 159265 . 159716))
(159719 160058 (\MAP-OPEN-STREAMS 159729 . 160056)) (161928 164008 (\EOF.ACTION 161938 . 162189) (
\EOSERROR 162191 . 162384) (\GETEOFPTR 162386 . 162568) (\INCFILEPTR 162570 . 162920) (\PEEKBIN 162922
. 163113) (\SETCLOSEDFILELENGTH 163115 . 163449) (\SETEOFPTR 163451 . 163639) (\SETFILEPTR 163641 .
164006)) (164009 164551 (\FIXPOUT 164019 . 164319) (\FIXPIN 164321 . 164549)) (164552 165160 (\BOUTEOL
164562 . 165158)) (168252 178116 (\BUFFERED.BIN 168262 . 169114) (\BUFFERED.PEEKBIN 169116 . 169898)
(\BUFFERED.BOUT 169900 . 170760) (\BUFFERED.BINS 170762 . 174447) (\BUFFERED.BOUTS 174449 . 176250) (
\BUFFERED.COPYBYTES 176252 . 178114)) (178145 180497 (\NULLDEVICE 178155 . 180173) (\NULL.OPENFILE
180175 . 180495)))))
(FILEMAP (NIL (28412 31902 (STREAMPROP 28422 . 28856) (GETSTREAMPROP 28858 . 29331) (PUTSTREAMPROP
29333 . 31750) (STREAMP 31752 . 31900)) (31945 34464 (\DEFPRINT.BY.NAME 31955 . 33107) (
\STREAM.DEFPRINT 33109 . 34157) (\FDEV.DEFPRINT 34159 . 34462)) (34722 39763 (\GETACCESS 34732 . 35186
) (\SETACCESS 35188 . 39761)) (62767 64020 (MAKE-EXTERNALFORMAT 62777 . 64018)) (65206 72777 (
\INSTALL.EXTERNALFORMAT 65216 . 66665) (\REMOVE.EXTERNALFORMAT 66667 . 67498) (FIND-FORMAT 67500 .
68051) (\EXTERNALFORMAT 68053 . 72775)) (73100 74928 (\CREATE.THROUGH.EXTERNALFORMAT 73110 . 73912) (
\THROUGHIN 73914 . 74329) (\THROUGHBACKCCODE 74331 . 74576) (\THROUGHOUTCHARFN 74578 . 74926)) (75036
81005 (\DEFINEDEVICE 75046 . 77362) (\GETDEVICEFROMNAME 77364 . 77837) (\GETDEVICEFROMHOSTNAME 77839
. 78883) (\REMOVEDEVICE 78885 . 80008) (\REMOVEDEVICE.NAMES 80010 . 81003)) (81045 105705 (\CLOSEFILE
81055 . 81880) (\DELETEFILE 81882 . 82176) (\DEVICEEVENT 82178 . 83948) (\GENERATEFILES 83950 . 84428
) (\GENERATENEXTFILE 84430 . 85081) (\GENERATEFILEINFO 85083 . 85544) (\GETFILENAME 85546 . 85935) (
\GENERIC.OUTFILEP 85937 . 86407) (\OPENFILE 86409 . 88987) (\DO.PARAMS.AT.OPEN 88989 . 91542) (
\RENAMEFILE 91544 . 91968) (\REVALIDATEFILE 91970 . 94572) (\PAGED.REVALIDATEFILELST 94574 . 96132) (
\PAGED.REVALIDATEFILES 96134 . 97853) (\PAGED.REVALIDATEFILE 97855 . 100138) (\BUFFERED.REVALIDATEFILE
100140 . 102426) (\BUFFERED.REVALIDATEFILELST 102428 . 103612) (\PRINT-REVALIDATION-RESULT 103614 .
104029) (\TRUNCATEFILE 104031 . 104422) (\FILE-CONFLICT 104424 . 105703)) (105741 110404 (
\GENERATENOFILES 105751 . 107847) (\NULLFILEGENERATOR 107849 . 108093) (\NOFILESNEXTFILEFN 108095 .
110086) (\NOFILESINFOFN 110088 . 110402)) (110523 112431 (\FILE.NOT.OPEN 110533 . 111046) (
\FILE.WONT.OPEN 111048 . 111376) (\ILLEGAL.DEVICEOP 111378 . 111660) (\IS.NOT.RANDACCESSP 111662 .
112108) (\STREAM.NOT.OPEN 112110 . 112429)) (112566 114864 (\FDEVINSTANCE 112576 . 114862)) (116414
123788 (CNDIR 116424 . 117729) (DIRECTORYNAME 117731 . 121914) (DIRECTORYNAMEP 121916 . 122532) (
HOSTNAMEP 122534 . 123341) (\ADD.CONNECTED.DIR 123343 . 123786)) (123833 154476 (\BACKFILEPTR 123843
. 124031) (\BACKPEEKBIN 124033 . 124394) (\BACKBIN 124396 . 124747) (BIN 124749 . 124966) (\BIN
124968 . 125245) (\BINS 125247 . 125533) (BOUT 125535 . 125897) (\BOUT 125899 . 126214) (\BOUTS 126216
. 126527) (COPYBYTES 126529 . 129861) (COPYCHARS 129863 . 136785) (COPYFILE 136787 . 137584) (
\COPYOPENFILE 137586 . 140659) (\INFER.FILE.TYPE 140661 . 141615) (EOFP 141617 . 141914) (FORCEOUTPUT
141916 . 142163) (\FLUSH.OPEN.STREAMS 142165 . 142521) (CHARSET 142523 . 144187) (ACCESS-CHARSET
144189 . 144406) (GETEOFPTR 144408 . 144658) (GETFILEINFO 144660 . 147853) (\TYPE.FROM.FILETYPE 147855
. 148325) (\FILETYPE.FROM.TYPE 148327 . 148506) (GETFILEPTR 148508 . 148760) (SETFILEINFO 148762 .
152375) (SETFILEPTR 152377 . 154096) (BOUT16 154098 . 154283) (BIN16 154285 . 154474)) (154579 159784
(\GENERIC.BINS 154589 . 154869) (\GENERIC.BOUTS 154871 . 155136) (\GENERIC.RENAMEFILE 155138 . 156969)
(\GENERIC.OPENP 156971 . 158286) (\GENERIC.READP 158288 . 159329) (\GENERIC.CHARSET 159331 . 159782))
(159785 160124 (\MAP-OPEN-STREAMS 159795 . 160122)) (161994 164074 (\EOF.ACTION 162004 . 162255) (
\EOSERROR 162257 . 162450) (\GETEOFPTR 162452 . 162634) (\INCFILEPTR 162636 . 162986) (\PEEKBIN 162988
. 163179) (\SETCLOSEDFILELENGTH 163181 . 163515) (\SETEOFPTR 163517 . 163705) (\SETFILEPTR 163707 .
164072)) (164075 164617 (\FIXPOUT 164085 . 164385) (\FIXPIN 164387 . 164615)) (164618 165286 (\BOUTEOL
164628 . 165284)) (168378 178242 (\BUFFERED.BIN 168388 . 169240) (\BUFFERED.PEEKBIN 169242 . 170024)
(\BUFFERED.BOUT 170026 . 170886) (\BUFFERED.BINS 170888 . 174573) (\BUFFERED.BOUTS 174575 . 176376) (
\BUFFERED.COPYBYTES 176378 . 178240)) (178271 180623 (\NULLDEVICE 178281 . 180299) (\NULL.OPENFILE
180301 . 180621)))))
STOP

BIN
sources/FILEIO.LCOM
View File

Binary file not shown.

1764
sources/MACHINEINDEPENDENT
View File

File diff suppressed because it is too large Load Diff

BIN
sources/MACHINEINDEPENDENT.LCOM
View File

Binary file not shown.