From 07ac38107be0415e3758383c1a7e7fddb4d24d9f Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 8 Aug 2021 15:37:11 -0700 Subject: [PATCH 1/5] 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 --- library/UNICODE | 203 ++++++++++++++++----- library/UNICODE.LCOM | Bin 22362 -> 22204 bytes lispusers/ISO8859IO | 167 ++++++++++-------- lispusers/ISO8859IO.LCOM | Bin 11107 -> 7442 bytes sources/AOFD | 142 +++++++++------ sources/AOFD.LCOM | Bin 13676 -> 14423 bytes sources/ATERM | 49 +++--- sources/ATERM.LCOM | Bin 16336 -> 16374 bytes sources/FILEIO | 169 +++++++++--------- sources/FILEIO.LCOM | Bin 49849 -> 49672 bytes sources/JAPANESE | 368 +++++++++++++++++++++++++++------------ sources/JAPANESE.LCOM | Bin 24744 -> 23585 bytes sources/LLDISPLAY | 108 ++++++------ sources/LLDISPLAY.LCOM | 36 ++-- sources/LLREAD | 187 +++++++++++++------- sources/LLREAD.LCOM | Bin 25415 -> 25489 bytes sources/PMAP | 42 ++--- sources/PMAP.LCOM | Bin 14155 -> 14177 bytes sources/PRINTFN | 158 +++++++++++++++-- sources/PRINTFN.LCOM | Bin 5316 -> 5304 bytes sources/XCCS | 60 +++---- sources/XCCS.LCOM | Bin 3610 -> 3458 bytes 22 files changed, 1093 insertions(+), 596 deletions(-) diff --git a/library/UNICODE b/library/UNICODE index 3e9de6498..81a05d267 100644 --- a/library/UNICODE +++ b/library/UNICODE @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 6-Aug-2021 10:30:15"  -{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;185 64537 +(FILECREATED " 8-Aug-2021 13:10:17"  +{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;191 64912 - changes to%: (FNS \UTF16.BACKCCODEFN) + changes to%: (FNS UTF8.OUTCHARFN UTF16BE.OUTCHARFN) - previous date%: " 5-Aug-2021 22:34:22" -{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;184) + previous date%: " 7-Aug-2021 13:56:58" +{DSK}kaplan>Local>medley3.5>git-medley>library>UNICODE.;190) (PRETTYCOMPRINT UNICODECOMS) @@ -19,7 +19,7 @@ (INITVARS (EXTERNALEOL 'LF)) (FNS MAKE-UNICODE-FORMATS) (P (MAKE-UNICODE-FORMATS EXTERNALEOL)) - (ADDVARS (*DEFAULT-EXTERNALFORMATS* (UNIX :UTF8))) + (ADDVARS (*DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8))) (FNS UNICODE.UNMAPPED) (FNS XCCS-UTF8-AFTER-OPEN) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE)) @@ -78,18 +78,19 @@ (DEFINEQ (UTF8.OUTCHARFN - [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 5-Aug-2021 22:34 by rmk:") + [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:02 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") + (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.") (* ;; "Print UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.") (IF (EQ CHARCODE (CHARCODE EOL)) - THEN (\BOUTEOL STREAM) - ELSE (CHANGE (FETCH (STREAM CHARPOSITION) OF STREAM) - (IPLUS DATUM 1)) (* ; "Avoid overflow") + THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + (\BOUTEOL STREAM) + ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) (FOR C INSIDE (CL:IF RAW CHARCODE (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) @@ -121,62 +122,170 @@ (LOADBYTE C 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" C]) -(UTF8.INCCODEFN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL RAW) (* ; "Edited 15-Jun-2021 13:35 by rmk:") (* ; "Edited 6-Aug-2020 17:13 by rmk:") (* ;; "Do not do UNICODE to XCSS translation if RAW.") (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error") (LET (BYTE1 BYTE2 BYTE3 BYTE4 CODE (COUNT 1)) (SETQ BYTE1 (\BIN STREAM)) (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1") (CL:WHEN (SMALLP BYTE1) [SETQ CODE (IF (ILESSP BYTE1 128) THEN (* ;;  "Test first: Ascii is the common case. EOL requires its own translation") (SELCHARQ BYTE1 (CR (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM) (CR.EOLC (* ; "Also eq BYTE1") (CHARCODE EOL)) (CRLF.EOLC (IF (EQ (CHARCODE LF) (\PEEKBIN STREAM T)) THEN (\BIN STREAM) (CL:WHEN BYTECOUNTVAR (SETQ BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL 2))) (CHARCODE EOL) ELSE BYTE1)) BYTE1)) (LF (CL:IF (EQ LF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)) (CHARCODE EOL) BYTE1)) BYTE1) ELSEIF (IGEQ BYTE1 (LLSH 15 4)) THEN (* ; "4 bytes") (SETQ BYTE2 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE2)) (ILESSP BYTE2 128)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE3)) (ILESSP BYTE3 128)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ BYTE4 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE4)) (ILESSP BYTE4 128)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (SETQ COUNT 4) (LOGOR (LLSH (LOADBYTE BYTE1 0 3) 18) (LLSH (LOADBYTE BYTE2 0 6) 12) (LLSH (LOADBYTE BYTE3 0 6) 6) (LOADBYTE BYTE4 0 6)) ELSEIF (IGEQ BYTE1 (LLSH 7 5)) THEN (* ; "3 bytes") (SETQ BYTE2 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE2)) (ILESSP BYTE2 128)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (SETQ BYTE3 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE3)) (ILESSP BYTE3 128)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (SETQ COUNT 3) (LOGOR (LLSH (LOADBYTE BYTE1 0 4) 12) (LLSH (LOADBYTE BYTE2 0 6) 6) (LOADBYTE BYTE3 0 6)) ELSE (* ; "Must be 2 bytes") (SETQ COUNT 2) (SETQ BYTE2 (\BIN STREAM)) (CL:WHEN (OR (NOT (SMALLP BYTE2)) (ILESSP BYTE2 128)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (LOGOR (LLSH (LOADBYTE BYTE1 0 5) 6) (LOADBYTE BYTE2 0 6]) (CL:UNLESS (OR RAW (NOT (SMALLP CODE))) (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) (CL:WHEN BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL COUNT))) CODE]) +(UTF8.INCCODEFN + [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:02 by rmk:") + (* ; "Edited 6-Aug-2020 17:13 by rmk:") + + (* ;; "Do not do UNICODE to XCSS translation if RAW.") + + (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (LET (BYTE1 BYTE2 BYTE3 BYTE4 CODE (COUNT 1)) + (SETQ BYTE1 (\BIN STREAM)) + + (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1") + + (CL:WHEN (SMALLP BYTE1) + [SETQ CODE (IF (ILESSP BYTE1 128) + THEN + + (* ;; + "Test first: Ascii is the common case. EOL requires its own translation") + + (SELCHARQ BYTE1 + (CR (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM) + (CR.EOLC (* ; "Also eq BYTE1") + (CHARCODE EOL)) + (CRLF.EOLC (IF (EQ (CHARCODE LF) + (\PEEKBIN STREAM T)) + THEN (\BIN STREAM) + (CL:WHEN COUNTP (SETQ COUNT 2)) + (CHARCODE EOL) + ELSE BYTE1)) + BYTE1)) + (LF (CL:IF (EQ LF.EOLC (FETCH (STREAM EOLCONVENTION) + OF STREAM)) + (CHARCODE EOL) + BYTE1)) + BYTE1) + ELSEIF (IGEQ BYTE1 (LLSH 15 4)) + THEN (* ; "4 bytes") + (SETQ BYTE2 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE2)) + (ILESSP BYTE2 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (SETQ BYTE3 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE3)) + (ILESSP BYTE3 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + (SETQ BYTE4 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE4)) + (ILESSP BYTE4 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) + (SETQ COUNT 4) + (LOGOR (LLSH (LOADBYTE BYTE1 0 3) + 18) + (LLSH (LOADBYTE BYTE2 0 6) + 12) + (LLSH (LOADBYTE BYTE3 0 6) + 6) + (LOADBYTE BYTE4 0 6)) + ELSEIF (IGEQ BYTE1 (LLSH 7 5)) + THEN (* ; "3 bytes") + (SETQ BYTE2 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE2)) + (ILESSP BYTE2 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (SETQ BYTE3 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE3)) + (ILESSP BYTE3 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + (SETQ COUNT 3) + (LOGOR (LLSH (LOADBYTE BYTE1 0 4) + 12) + (LLSH (LOADBYTE BYTE2 0 6) + 6) + (LOADBYTE BYTE3 0 6)) + ELSE (* ; "Must be 2 bytes") + (SETQ COUNT 2) + (SETQ BYTE2 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE2)) + (ILESSP BYTE2 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (LOGOR (LLSH (LOADBYTE BYTE1 0 5) + 6) + (LOADBYTE BYTE2 0 6]) + (CL:UNLESS (OR RAW (NOT (SMALLP CODE))) + (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT)) + CODE]) (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.BACKCCODEFN - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:38 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:04 by rmk:") (* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT") + (DECLARE (USEDFREE *BYTECOUNTER*)) (BIND (C _ 0) WHILE (CL:WHEN (\BACKFILEPTR STREAM) - (ADD C 1) + (ADD C -1) (EQ 2 (LRSH (\PEEKBIN STREAM) - 6))) REPEATUNTIL (EQ C 4) - FINALLY (CL:WHEN BYTECOUNTVAR - (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL C)))]) + 6))) REPEATUNTIL (EQ C -4) + FINALLY (CL:WHEN COUNTP (SETQ *BYTECOUNTER* C]) ) (DEFINEQ (UTF16BE.OUTCHARFN - [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 17-Aug-2020 08:48 by rmk:") + [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:09 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ;; "PRINT UTF16 sequence for CHARCODE. Do not do XCCS to UNICODE translation if RAW.") - (CHANGE (FETCH (STREAM CHARPOSITION) OF STREAM) - (CL:IF (EQ CHARCODE (CHARCODE EOL)) - 0 - (IPLUS DATUM 1))) + (* ;; "Not sure about EOL conversion if truly %"raw%"") + + (IF (EQ CHARCODE (CHARCODE EOL)) + THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM))) (FOR C INSIDE (CL:IF RAW CHARCODE (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) - DO (\BOUT STREAM (LRSH C 8)) - (\BOUT STREAM (LOGAND C 255]) + DO (\WOUT STREAM C]) -(UTF16BE.INCCODEFN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL RAW) (* ; "Edited 15-Jun-2021 13:36 by rmk:") (* ;;  "Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior") (LET (CODE BYTE1 BYTE2 COUNT) (IF [AND (SMALLP (SETQ BYTE1 (\BIN STREAM))) (SMALLP (SETQ BYTE2 (\BIN STREAM] THEN (SETQ COUNT 2) (SETQ CODE (LOGOR (LLSH (\BIN STREAM) 8) (\BIN STREAM))) (CL:UNLESS RAW (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL COUNT))) CODE ELSE (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM]) +(UTF16BE.INCCODEFN + [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:05 by rmk:") + + (* ;; + "Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (LET (CODE BYTE1 BYTE2 COUNT) + (IF [AND (SMALLP (SETQ BYTE1 (\BIN STREAM))) + (SMALLP (SETQ BYTE2 (\BIN STREAM] + THEN (SETQ COUNT 2) + (SETQ CODE (LOGOR (LLSH (\BIN STREAM) + 8) + (\BIN STREAM))) + (CL:UNLESS RAW + (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT)) + CODE + ELSE (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM]) (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.BACKCCODEFN - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 6-Aug-2021 10:15 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:07 by rmk:") (* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.") (* ;; "Common for big-ending and little-ending") + (DECLARE (USEDFREE *BYTECOUNTER*)) (CL:WHEN (\BACKFILEPTR STREAM) - [IF (\BACKFILEPTR STREAM) - THEN (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2))) - ELSE (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL])]) + (IF (\BACKFILEPTR STREAM) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)))]) ) (RPAQ? EXTERNALEOL 'LF) (DEFINEQ (MAKE-UNICODE-FORMATS - [LAMBDA (EXTERNALEOL) (* ; "Edited 1-Aug-2021 23:18 by rmk:") + [LAMBDA (EXTERNALEOL) (* ; "Edited 6-Aug-2021 16:08 by rmk:") (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.") @@ -187,9 +296,8 @@ (FUNCTION \UTF8.BACKCCODEFN) (FUNCTION UTF8.OUTCHARFN) NIL EXTERNALEOL) - (MAKE-EXTERNALFORMAT :UTF-8-RAW [FUNCTION (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) - (UTF8.INCCODEFN STREAM BYTECOUNTVAR BYTECOUNTVAL - T] + (MAKE-EXTERNALFORMAT :UTF-8-RAW [FUNCTION (LAMBDA (STREAM COUNTP) + (UTF8.INCCODEFN STREAM COUNTP T] [FUNCTION (LAMBDA (STREAM NOERROR) (UTF8.PEEKCCODEFN STREAM NOERROR T] (FUNCTION \UTF8.BACKCCODEFN) @@ -201,9 +309,8 @@ (FUNCTION \UTF16.BACKCCODEFN) (FUNCTION UTF16BE.OUTCHARFN) NIL EXTERNALEOL) - (MAKE-EXTERNALFORMAT :UTF-16BE-RAW [FUNCTION (LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) - (UTF16BE.INCCODEFN STREAM BYTECOUNTVAR - BYTECOUNTVAL T] + (MAKE-EXTERNALFORMAT :UTF-16BE-RAW [FUNCTION (LAMBDA (STREAM COUNTP) + (UTF16BE.INCCODEFN STREAM COUNTP T] [FUNCTION (LAMBDA (STREAM NOERROR) (UTF16BE.PEEKCCODEFN STREAM NOERROR T] (FUNCTION \UTF16.BACKCCODEFN) @@ -214,7 +321,7 @@ (MAKE-UNICODE-FORMATS EXTERNALEOL) -(ADDTOVAR *DEFAULT-EXTERNALFORMATS* (UNIX :UTF8)) +(ADDTOVAR *DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8)) (DEFINEQ (UNICODE.UNMAPPED @@ -993,15 +1100,15 @@ ) ) (DECLARE%: DONTCOPY - (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))))) + (FILEMAP (NIL (4120 17800 (UTF8.OUTCHARFN 4130 . 6961) (UTF8.INCCODEFN 6963 . 12453) (UTF8.PEEKCCODEFN + 12455 . 17229) (\UTF8.BACKCCODEFN 17231 . 17798)) (17801 21127 (UTF16BE.OUTCHARFN 17811 . 18635) ( +UTF16BE.INCCODEFN 18637 . 19536) (UTF16BE.PEEKCCODEFN 19538 . 20609) (\UTF16.BACKCCODEFN 20611 . 21125 +)) (21157 22965 (MAKE-UNICODE-FORMATS 21167 . 22963)) (23062 24368 (UNICODE.UNMAPPED 23072 . 24366)) ( +24369 24905 (XCCS-UTF8-AFTER-OPEN 24379 . 24903)) (25975 26324 (XTOUCODE 25985 . 26153) (UTOXCODE +26155 . 26322)) (26364 42547 (READ-UNICODE-MAPPING-FILENAMES 26374 . 27536) (READ-UNICODE-MAPPING +27538 . 30836) (WRITE-UNICODE-MAPPING 30838 . 35055) (WRITE-UNICODE-INCLUDED 35057 . 39779) ( +WRITE-UNICODE-MAPPING-HEADER 39781 . 41013) (WRITE-UNICODE-MAPPING-FILENAME 41015 . 42545)) (45884 +54357 (MAKE-UNICODE-TRANSLATION-TABLES 45894 . 54355)) (54778 62682 (HEXSTRING 54788 . 55949) ( +UTF8HEXSTRING 55951 . 58156) (NUTF8CODEBYTES 58158 . 58821) (NUTF8STRINGBYTES 58823 . 59304) ( +XTOUSTRING 59306 . 62317) (XCCSSTRING 62319 . 62680)) (62683 64152 (SHOWCHARS 62693 . 64150))))) STOP diff --git a/library/UNICODE.LCOM b/library/UNICODE.LCOM index bf542ebdf04686a5078a8d37fc6d75947a498cb2..2ed2e52c45b675e55cd7e8cc94ac830058f7bb0b 100644 GIT binary patch delta 1392 zcmaKqO>7%Q6vubgvEwepahj-Qrjrj&g`z&>sDgd_FA@@tQ~)-EmUe++q7}* zr1S%oQ+hx>z=dY0kbn~x1QkfNgVY03Bu)rXgbJr#5EUG_Aotco)i7&&+I*>ddH;QH zy#Bx6{O^B|hS*N_sj{Az^Df^kh z2wb?>cyDp}%B8*;_OlS^TUcoEq?Vu?C@mT?&4`&-6ptWytkziXGqZWuXYLW$6Ex48 zKly(9oqjE5(D(E|@%{=1yHqNafF$B@GR24h(Fs?Y#+8!biuoU$!v^o+1m-gBBGFF*ua7dMKn#t3b>zS}Au{bsC;onVM=ltxcHPfE%>KB#4u>l|FVbZnAK^KK`r|CdnJa_ zRnwxPyA3fSb+7wB99h_%DBey~kP#BZ<^&Q3vFaSiwKx8_GkAH>e;B`;x%T5;=TB?R zm#c~A7$idIwXt_zy2^vOYBsMA19{iCPH%}8wF8IBn1>F_JUDuMM{wAdIy2^?sjw9E zQx#>|-QHs7Sgh^^vh&Z6jkaUSrkBNL!t}7zcu}Wn!dt93E%9v={xae3<0-l{epp#O zT9b0YWj7~gKP_xgEGxtN-6iqN&A;P^yzG(;o$d=BL{j%i@B`%R&YoTQ)-($sF!lq~ zYx@WFQ)?~Ieo_;HjCFg1RUu5@*qih7Ptwn)UK>fo@(x{?3eyLBf89I@cOOl@iP20~ Nx9^RzvS)5y`X4iaZQ}p{ delta 1619 zcmbu9O>7%g5XX1d9|H_M4MAVT)3G7M-Xp!y=hBx3GBgdJn!x7 z%y0hlzW$8f`<(uuGcTXiu3S3Fb36jX6$P${q-$4O14YU}3Z#ddJSuWx5%DQl+wNT4 zdZXWUI(7^?SNq#LCyKDzw#rD(>6)=<7>$xyu0wYdQss8729Jix<#H*oFI?`}2ZmQt znOM49t$}GYP0cb(OG3TX~IxuHHqktd->-Npa?KH9tYV-)|) zYRvFcJQLa*$Y3^`jVAB~1gmYGMY#Yi(*jWvpTGn{UYa&aK>IBt z*r&}y;?zP4A6TS(e^*jqb=fo*^=duCrbUtPY}ZeDeXtrX>@0|!@gGPl6wWp5$q>DglumUP6m78sGo-^?wH`m^tc2ZzB*u;a_@h`iDxB5p|Wzduaf2 z?*($Hk~`5{wwmBx1o)?<`0Al#@U)kMrg!JuqDi?5&K~*u|Hc?K<|}BlTe>qd>eW_a F{{R-Wmy`ei diff --git a/lispusers/ISO8859IO b/lispusers/ISO8859IO index 147a29904..0c0204ef7 100644 --- a/lispusers/ISO8859IO +++ b/lispusers/ISO8859IO @@ -1,11 +1,11 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "23-Jun-2021 17:00:30"  -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;10 22675 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 8-Aug-2021 13:22:31"  +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;18 22218 - changes to%: (FNS MAKEISOFORMAT MAKEIBMFORMAT MAKEMACFORMAT) + changes to%: (FNS \8859OUTCHARFN \IBMOUTCHARFN \MACOUTCHARFN) - previous date%: "15-Jun-2021 13:53:42" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;9) + previous date%: " 6-Aug-2021 16:12:42" +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;17) (* ; " @@ -15,7 +15,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (PRETTYCOMPRINT ISO8859IOCOMS) (RPAQQ ISO8859IOCOMS - [ + ( (* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.") (COMS (* ; "ISO8859/1") @@ -34,11 +34,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (FNS MAKEMACFORMAT) (P (MAKEMACFORMAT))) (COMS (* ; "Independent of char encoding") - (FNS \COMMONBACKCHARFN \MAKERECODEMAP \RECODECCODE)) - (DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (GETP 'EXPORTS.ALL 'FILE) - (PRINT - "NOTE: ISO8859IO requires EXPORTS.ALL for compilation" - T]) + (FNS \COMMONBACKCCODEFN \MAKERECODEMAP \RECODECCODE)))) @@ -55,7 +51,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (\8859OUTCHARFN [LAMBDA (STREAM CHARCODE) - (DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 5-May-2021 16:31 by rmk:") + (DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 8-Aug-2021 13:21 by rmk:") (* ; "Edited 7-Dec-95 14:34 by ") (* ; "Edited 7-Dec-95 14:32 by ") @@ -65,18 +61,27 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (* ;; "If any remaining codes are out of charset 0, the streams external format will be used. ") - (* ;; "Calls \PRINTCCODE instead of \OUTCHAR so that recompiling is not needed if the default external format changes.") + (IF (EQ CHARCODE (CHARCODE EOL)) + THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + (\BOUTEOL STREAM) + ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (\BOUT STREAM (IF (IGREATERP CHARCODE 127) + THEN - (\PRINTCCODE (IF (IGREATERP CHARCODE 127) - THEN + (* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128") - (* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128") + (\RECODECCODE CHARCODE *XEROXTOISO8859MAP*) + ELSE CHARCODE]) - (\RECODECCODE CHARCODE *XEROXTOISO8859MAP*) - ELSE CHARCODE) - STREAM]) - -(\8859INCCODEFN [LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:50 by rmk:") (* ; "Edited 7-Dec-95 15:24 by ") (* ; "Edited 7-Dec-95 15:19 by ") (CL:WHEN BYTECOUNTVAR (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL))) (\RECODECCODE (\BIN STRM) *ISO8859TOXEROXMAP*]) +(\8859INCCODEFN + [LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:10 by rmk:") + (* ; "Edited 7-Dec-95 15:24 by ") + (* ; "Edited 7-Dec-95 15:19 by ") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1)) + (\RECODECCODE (\BIN STRM) + *ISO8859TOXEROXMAP*]) (\8859PEEKCCODEFN [LAMBDA (STRM NOERROR) (* ; "Edited 5-May-2021 17:44 by rmk:") @@ -93,7 +98,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (DEFINEQ (MAKEISOFORMAT - [LAMBDA NIL (* ; "Edited 23-Jun-2021 17:00 by rmk:") + [LAMBDA NIL (* ; "Edited 5-Aug-2021 22:15 by rmk:") (* ; "Edited 9-Mar-99 17:19 by rmk:") (* ; "Edited 7-Dec-95 16:24 by ") (* ; "Edited 7-Dec-95 16:20 by ") @@ -177,12 +182,10 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (61805 376] (SETQ *XEROXTOISO8859MAP* (\MAKERECODEMAP XEROXTOISO)) (SETQ *ISO8859TOXEROXMAP* (\MAKERECODEMAP XEROXTOISO T))) - (\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT - NAME _ :ISO8859/1 - INCCODEFN _ (FUNCTION \8859INCCODEFN) - PEEKCCODEFN _ (FUNCTION \8859PEEKCCODEFN) - BACKCCODEFN _ (FUNCTION \COMMONBACKCHARFN) - OUTCHARFN _ (FUNCTION \8859OUTCHARFN]) + (MAKE-EXTERNALFORMAT :ISO8859/1 (FUNCTION \8859INCCODEFN) + (FUNCTION \8859PEEKCCODEFN) + (FUNCTION \COMMONBACKCCODEFN) + (FUNCTION \8859OUTCHARFN]) ) (MAKEISOFORMAT) @@ -194,20 +197,31 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (DEFINEQ (\IBMOUTCHARFN - [LAMBDA (STREAM CHARCODE) (* ; "Edited 5-May-2021 16:38 by rmk:") - (\PRINTCCODE (IF (IGREATERP CHARCODE 127) - THEN - - (* ;; "We know that IBM doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128") - - (\RECODECCODE CHARCODE *XEROXTOIBMMAP*) - ELSE CHARCODE) - STREAM]) - -(\IBMINCCODEFN [LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:50 by rmk:") (* ; "Edited 8-Dec-95 13:23 by ") (* ; "Edited 7-Dec-95 15:19 by ") (CL:WHEN BYTECOUNTVAR (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL))) (\RECODECCODE (\BIN STRM) *IBMTOXEROXMAP*]) + [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-Aug-2021 13:21 by rmk:") + (IF (EQ CHARCODE (CHARCODE EOL)) + THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + (\BOUTEOL STREAM) + ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (\BOUT STREAM (IF (IGREATERP CHARCODE 127) + THEN + + (* ;; "We know that IBM doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128") + + (\RECODECCODE CHARCODE *XEROXTOIBMMAP*) + ELSEIF CHARCODE]) + +(\IBMINCCODEFN + [LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:10 by rmk:") + (* ; "Edited 8-Dec-95 13:23 by ") + (* ; "Edited 7-Dec-95 15:19 by ") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1)) + (\RECODECCODE (\BIN STRM) + *IBMTOXEROXMAP*]) (\IBMPEEKCCODEFN - [LAMBDA (STRM NOERROR COUNTP) (* ; "Edited 5-May-2021 17:44 by rmk:") + [LAMBDA (STRM NOERROR) (* ; "Edited 5-Aug-2021 22:28 by rmk:") (* ; "Edited 3-Jan-96 14:23 by ") (* ; "Edited 8-Dec-95 13:24 by ") (* ; "Edited 7-Dec-95 15:51 by ") @@ -222,7 +236,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (DEFINEQ (MAKEIBMFORMAT - [LAMBDA NIL (* ; "Edited 23-Jun-2021 17:00 by rmk:") + [LAMBDA NIL (* ; "Edited 5-Aug-2021 22:17 by rmk:") (LET [(XEROXTOIBM '((61217 255) (61291 166) (8994 168) @@ -312,12 +326,10 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (191 168] (SETQ *XEROXTOIBMMAP* (\MAKERECODEMAP XEROXTOIBM)) (SETQ *IBMTOXEROXMAP* (\MAKERECODEMAP XEROXTOIBM T)) - (\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT - NAME _ :IBM - INCCODEFN _ (FUNCTION \IBMINCCODEFN) - PEEKCCODEFN _ (FUNCTION \IBMPEEKCCODEFN) - BACKCCODEFN _ (FUNCTION \COMMONBACKCHARFN) - OUTCHARFN _ (FUNCTION \IBMOUTCHARFN]) + (MAKE-EXTERNALFORMAT :IBM (FUNCTION \IBMINCCODEFN) + (FUNCTION \IBMPEEKCCODEFN) + (FUNCTION \COMMONBACKCCODEFN) + (FUNCTION \IBMOUTCHARFN]) ) (MAKEIBMFORMAT) @@ -329,7 +341,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (DEFINEQ (\MACOUTCHARFN - [LAMBDA (STREAM CHARCODE) (* ; "Edited 5-May-2021 16:28 by rmk:") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-Aug-2021 13:22 by rmk:") (* ;; "Converts CHARCODE from internal encoding to MAC before printing.") @@ -337,21 +349,23 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (* ;; "If any remaining codes are out of charset 0, the streams external format will be used.") - (* ;; "Calls \PRINTCCODE instead of \OUTCHAR so that recompiling is not needed if the default external format changes.") - - (\PRINTCCODE (IF (IGREATERP CHARCODE 127) - THEN + (IF (EQ CHARCODE (CHARCODE EOL)) + THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + (\BOUTEOL STREAM) + ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (\BOUT STREAM (IF (IGREATERP CHARCODE 127) + THEN - (* ;; "We know that MAC doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128") + (* ;; "We know that MAC doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128") - (\RECODECCODE CHARCODE *XEROXTOMACMAP*) - ELSE CHARCODE) - STREAM]) + (\RECODECCODE CHARCODE *XEROXTOMACMAP*) + ELSE CHARCODE]) (\MACINCCODEFN [LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:50 by rmk:") (* ; "Edited 8-Dec-95 13:29 by ") (CL:WHEN BYTECOUNTVAR (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL))) (\RECODECCODE (\BIN STRM) *MACTOXEROXMAP*]) (\MACPEEKCCODEFN - [LAMBDA (STRM NOERROR COUNTP) (* ; "Edited 5-May-2021 17:44 by rmk:") + [LAMBDA (STRM NOERROR) (* ; "Edited 5-Aug-2021 22:29 by rmk:") (* ; "Edited 3-Jan-96 14:23 by ") (* ; "Edited 8-Dec-95 13:29 by ") (\RECODECCODE (\PEEKCCODE STRM NOERROR) @@ -364,7 +378,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (DEFINEQ (MAKEMACFORMAT - [LAMBDA NIL (* ; "Edited 23-Jun-2021 17:00 by rmk:") + [LAMBDA NIL (* ; "Edited 5-Aug-2021 22:25 by rmk:") (* ; "Edited 7-Dec-95 16:24 by ") (* ; "Edited 7-Dec-95 16:20 by ") @@ -478,12 +492,10 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (61249 228] (SETQ *XEROXTOMACMAP* (\MAKERECODEMAP XEROXTOMAC)) (SETQ *MACTOXEROXMAP* (\MAKERECODEMAP XEROXTOMAC T)) - (\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT - NAME _ :MACINTOSH - INCCODEFN _ (FUNCTION \MACINCCODEFN) - PEEKCCODEFN _ (FUNCTION \MACPEEKCCODEFN) - BACKCCODEFN _ (FUNCTION \COMMONBACKCHARFN) - OUTCHARFN _ (FUNCTION \MACOUTCHARFN]) + (MAKE-EXTERNALFORMAT :MACINTOSH (FUNCTION \MACINCCODEFN) + (FUNCTION \MACPEEKCCODEFN) + (FUNCTION \COMMONBACKCCODEFN) + (FUNCTION \MACOUTCHARFN]) ) (MAKEMACFORMAT) @@ -494,7 +506,13 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (DEFINEQ -(\COMMONBACKCHARFN [LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:53 by rmk:") (* ; "Edited 8-Dec-95 13:26 by ") (CL:WHEN (\BACKFILEPTR STRM) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL))) T)]) +(\COMMONBACKCCODEFN + [LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:12 by rmk:") + (* ; "Edited 8-Dec-95 13:26 by ") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN (\BACKFILEPTR STRM) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) + T)]) (\MAKERECODEMAP [LAMBDA (CODEMAP INVERTED) (* ; "Edited 9-Mar-99 17:23 by rmk:") @@ -528,17 +546,12 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation. (OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255))) CODE]) ) -(DECLARE%: EVAL@COMPILE DONTCOPY - -(OR (GETP 'EXPORTS.ALL 'FILE) - (PRINT "NOTE: ISO8859IO requires EXPORTS.ALL for compilation" T)) -) (PUTPROPS ISO8859IO COPYRIGHT ("Xerox Corporation" 1995 1996 1997 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2172 4321 (\8859OUTCHARFN 2182 . 3323) (\8859INCCODEFN 3325 . 3798) (\8859PEEKCCODEFN -3800 . 4319)) (4413 8190 (MAKEISOFORMAT 4423 . 8188)) (8250 9861 (\IBMOUTCHARFN 8260 . 8769) ( -\IBMINCCODEFN 8771 . 9239) (\IBMPEEKCCODEFN 9241 . 9859)) (9945 13722 (MAKEIBMFORMAT 9955 . 13720)) ( -13770 15455 (\MACOUTCHARFN 13780 . 14675) (\MACINCCODEFN 14677 . 15041) (\MACPEEKCCODEFN 15043 . 15453 -)) (15539 20338 (MAKEMACFORMAT 15549 . 20336)) (20405 22437 (\COMMONBACKCHARFN 20415 . 20758) ( -\MAKERECODEMAP 20760 . 21990) (\RECODECCODE 21992 . 22435))))) + (FILEMAP (NIL (1909 4233 (\8859OUTCHARFN 1919 . 3222) (\8859INCCODEFN 3224 . 3710) (\8859PEEKCCODEFN +3712 . 4231)) (4325 7866 (MAKEISOFORMAT 4335 . 7864)) (7926 9844 (\IBMOUTCHARFN 7936 . 8739) ( +\IBMINCCODEFN 8741 . 9222) (\IBMPEEKCCODEFN 9224 . 9842)) (9928 13459 (MAKEIBMFORMAT 9938 . 13457)) ( +13507 15354 (\MACOUTCHARFN 13517 . 14574) (\MACINCCODEFN 14576 . 14940) (\MACPEEKCCODEFN 14942 . 15352 +)) (15438 19991 (MAKEMACFORMAT 15448 . 19989)) (20058 22117 (\COMMONBACKCCODEFN 20068 . 20438) ( +\MAKERECODEMAP 20440 . 21670) (\RECODECCODE 21672 . 22115))))) STOP diff --git a/lispusers/ISO8859IO.LCOM b/lispusers/ISO8859IO.LCOM index 9d908f91dd3dfef9d8dd8cd0fb4879200142685f..ac6c89f1cb160d648c3fa2212f85c187ba7b620c 100644 GIT binary patch delta 2081 zcmcIly>HV{5O)HF)}n~2MW_-gr$A{Ol-AFQ^I?|Q?sKsc+mT}+h#<8jp%elI3at4D zSW=4t#KOP^Q`lKqkdQ!#83qOxm>J61PFklbQiYTZr#rvrcfXIk^Y=@e(%JYT)pV04 zHN8ZWx~W+(QPFr!(vAv-WrRn-c|#=SRHo5~Jd zgc#(K@}t$HzzYOON)iMqC3IFUw{zU!8lRU$T+YXUz5bwCU%zv2t<`Km{pQNu)#k>m z1hrgF%v%>7^@40`Ce(Dr2vvrx?o?}cA*Nj{l_1=Fettd%jg^OZD2u2-9JhW?mcKeUR!^(;iJM6Vvq@Gm63=br3LI4$-2!b zzf2g0iOQ|oacl!LOcKf!2j9d6Y9}~grkDsqac|d| zcLmsKiQPzcpa~vK+|J?SZA`d8oHC_F9{`#tE#}y`4g^e#+O}nHcf}r)NFrL0eJ+D7 zkWiQhmfL4~{RkxVisk)V9IHxgt7^#QNWyK6auLPtOrCJxj2=y_;_1v@VSL0}K_;0L z7;=#&-RPKjRYY2Y|36WHnraz_Wh!_(`h?QGecOPLWEyvR@9JiMS1Joq58?vpz8?E= zVEE>K9#6D~V6K2-E5?q{iNI)l7M39Jd3gv%5A=3dC%H%gJwCl3e@V~ZKa-*@in|7i z$nR-yuq{k2jT@0|$XpT4RgCV7sqDew+d4JENf1;a5I1~;txg>80Q?!KNm z^IzImJ?#g^_rJB@MbFb79}Q~nKX9zdh3>agTL;_Ts0&Y;{fxH>Z@dKq_U)ML-r1@% zYd8@Qr+3%A&s*8CIo8xmJ<*Fa7)Us2f|*tZB7n^EDKQP0lOXp}-cM7Q=KYLdmh&?K zv#g)--B+_uBk1e-xsw>HbDJ1{&Rxa06u*Y?Rs06VBb*mExCX|roKfvjMM=VV*zmCA d@W;lz4LE;-&vw67jDZ?u?APwZIb+0U`xoWZ;q3qb literal 11107 zcmeI2?{Ayc702xav60~{NxM=yRxYM6CnCZ3KEDI1>?BVb6Wfom-Kt&7T+_IXsd2I- zotVZnm^SUzq^X()yj)*RnuOA_!q_IVx7}Z`y{ur;UWUJ*`=0ybiS4!wCNwrwB%0&< z+~JMNznnkT zmpD0+p>p#mQ4bebT3FN1UFuGYtl*4$v)Sydl})ou`rO*f>+Mc!g{^g2nvMK$p|<>^ zXOC~THa3r5Y_4~j-J`{|bIs1tms=~H)(@;1=jes@*0lO{wA0>Pza;Y(YLV|dK_QxX zhG!=S)VZ^cGs^>1|Kdg~R@i!FePi>9Sysv~hbX=nRZIE0`ZZVT`Blo#>tAh{xOlu+ zWWCPJ%*>?ON^=V?jP!dc)mkF`>6+s6ah(a_dJa3c+U#CvZL+O3IG9;1*VxFXc5{-g zZ?wMOUc0m@-9iOv?(}q?HS1Wjw)lKHE0`QPLmd|#ug@>#tBYkeyWo#x3XC)QJs&NE ztiZCYR>wdpO|rznL?SViU+Mh#laB5dKk2~}epnRW=44Cmj< z&t3exv}Y&B&XRSpaaNx-47Sw5`eZ7@eKw`7sYlW}X;dmRnUalD3B%<+vnuFjc1F&? z>hX%2kVxY!pLHCcLCi|ggUACZx+MCnHV>5~da`{XWf`0$x5`mitwy~b4gK~ZGDmv%3AZv8Cx0Oe{N=?q0rj_!+&+-w}#(N#9m?>xS`{laba?9Z(t zcV={g@jzEYq_@cmGX9TH~bggpvp?4+h=oZ_0Olt zad$xB`|z1Q{APK;<1?M1!YIbYpNiWD2g>}BYJG0>COLLF$6j0BAzL1OY4=z3_o0Y& zhRCW1#>Wo8h{pamrAzxqw_k=CjftJc7+Lb{K&>B8>(iGj(b#}3jfu`snT%{y4DwN*Y5cqShYxJu)`9j94Z2N$spEK*Xf z!*wpX0{3rGawDMiX>Yy8B6~WC9$%wwA5SKho1*Biz3utHKt72E)o)tLKZwneZeSr<^b9{T~f|hHO+@3f5@G(d&IF@WV&< z_HSu4uI8gsDJs+0)BBu@p-9=NgU#aZpgM^$@h)WBY*ud#PjhB@?A7~*`>m>F$_EI zSu!uB+K_^*??QASqAq;*shr4Kkm$R}QW||07-ZZhr7kK&YM^TMFlu-}wIUtP@qo&a zEFe=!l2JC$Wi2QSJfsUjsbo8H*i@3NC)vinsO%;^WT};LXHizv#_*A7bPv_rB5wkDKC8wB`vMhLrF_(rIxU?Rty{1 zDZTT3O4nL3D}|-ClGm2fiW+UDHNZ+HY^60IpKYZzz$ztdr8UT+FKneX$U>8?v|_YE zCatt=30w9jjRae13^2llt=cvKS_wz%1aYA)rL_S@op7{Hj91~1PNYE68ZB7mXg^_z z<++oSz|O*4>5HJ>xzZl_!h|mleCJBHK`-p-T^99DaCheQvH)4dycm2~mL>CI(}nm6 z%qy7W`pPHa@9;hRy@$V&$nW9r{{a5>Ef!xk^o_$#x1sMG#TQQ91$}$T_bd_bqyHKB zf^P2yzBteHVeTEl7ZlUKnPDxy1NQ=t2iAAs2qo=pK{$cTB7uSL?#jCe0amn21*G_MofJ&bdUWuBJ7jTVIigq+4H+gQQzuk%OXJO>tCK zQ;bJ+D=9|Otz;EVx0=Ny-5Q<*-Ez%2o=wcDJn)EV41Y@2(^`r3By*xpVm(QnB!h+w zcY@@&tLVierqw(snO5_oM0Y5vRv^H7>GN%J&0sA_j!`(blVWgYBuyh zvRv~Mk*qoeD1Ox>1%Bm*D&dnk%n-kFL!t1=oCt_txgk>c$E7BaBU((?h+)eOkCNAh zJHfBqFfRC&8%~ASJmysDC(XX#SMC}amT6M;;VYN?iUT{SmAi&WQNN)~P%C#0!BTIk zHj~t%a`0{_k&#-iFGrKE4 zBUkVGPW+6dy)B6NStit@+S0$HXk_f!Kzb<}U-TX)DVjpTDr6}`!M;KgiO4cI3(N#= zP{@n|y($<+fnF8bRDoU1(1<{99DXGfHlRx=tb&dd=#}AS zg3}b}H5e#SIL-qLGzNNv!W!T_LSX}+gu(_;357NAc@hdWIuikU~ z0%&rjXfD_17N3Yt$5tf`$J7hU45N~ZCZ0+(Y?u~Ys?HKb#UFVV0(DaaVEJk3Zh z4iteaF4h!{P@$q%)FHW8$9ZW$IXcd(xEMoCm#65hJ_`{Wn;1L>5n5joD_~dgK9R7Y zdO>X<&rJlm`g+B|p-dsQ?@;d{5{!!yhcMnFQ;-S^J+cI4F(p-BScr3?7Noiu>!?DX zCao;=$$OQ+x6y3!VuiAxYI(IHaamrhNSN2xDi$@FzDlvkB7K!&Q4`Cnlt2zTd6y!g zUf!f|ip$G;6yM?CdwGo_C#$jyHxEcuEsC25$m9n`CLJbeyxVk6pzmlSNUFVYZp3*} z`AN%*y0dUGd?;PjY||k^-&@f1QTG<|%ph+q0vy$lsICw25wc#R=-`X>gTn2%UBrEM zUO#{s%donW{{3kFO+5Jco4kW=Wn=|fOZeBuBc@8eTFsx5f$c*1L|COa zSoDsD-ooH3cEew$=poIuZ;$7ObK4KEBu@_|my@f94*j8U{VPkWhraXr(v$BG4PXD~ za}zJ(2}C!Uke8{eU!wric>4b3;p_Jm$C583OGC-scjk+wJaY^8O+-NjR_{#)G|JHNKU&f{eq9&xQUw^(zd#ai8S zYb$tXhIeSK_SR}^!zg%~KZRT^wz<{pt~57R7zNK-uWYrtl)brmuHAl$p+3rUY4cLE z1Hb20b?xqjnRE)1kql>KA)fZB$8=BgG}7tu*uZ`Ez#aAAH8u(zD@Jqq;)#5<#!_)i zPSuJQpSsgkwN^!45B&<{kXB)t{-jAH?%A43!`11^JPVDtdGatc0#$Ibp*tW;oIH}*-bg6l+-Q8N-T#XGxN9-9WPwsmdH*k)>vxOSc*c5~w zj_WZHA9|ZJMeVtlHeg`^LuQ@EO?Qi}ou`L{8}UGijYj+TKV}$+4ySsj9Vx&Aykfo@ z;w@o_S9Cd)ui!}zTZr&dFRGl9-HfManPXuc9sd0Bs2*ZMRHACVHiL&4s6nOCLmsM6 zO}bRNjEu8p78D}3(fZz{_J*8IabY==)T__tR(q|RW_4@?_%Aguvh?q`@6_+TmP%zR z$Lp19RH^l7B=f6_^d_bFNK)Wl&GU+h{y@7>x+7kW+ D|1vQh diff --git a/sources/AOFD b/sources/AOFD index e3c7a052c..8815445b1 100644 --- a/sources/AOFD +++ b/sources/AOFD @@ -1,11 +1,11 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "13-Jun-2021 11:35:32" {DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;2 35745 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 8-Aug-2021 00:11:00" {DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;3 36869 - changes to%: (FNS CLOSEF INPUT OUTPUT RANDACCESSP \MAKEBASEBYTESTREAM \BASEBYTES.PEEKBIN - \SEARCHOPENFILES) + changes to%: (FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT) + (VARS AOFDCOMS) - previous date%: "10-May-2021 15:44:43" -{DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;1) + previous date%: "13-Jun-2021 11:35:32" +{DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;2) (* ; " @@ -36,7 +36,8 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. \BASEBYTES.PEEKBIN \BASEBYTES.TRUNCATEFN \BASEBYTES.OPENFN \BASEBYTES.BLOCKIO) (GLOBALVARS \BASEBYTESDEVICE) (DECLARE%: DONTEVAL@LOAD (P (\BASEBYTES.IO.INIT))) - (FNS OPENSTRINGSTREAM)) + (FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT) + (P (MAKE-STRING-FORMAT))) [COMS (* ;; "STREAM interface for old-style strings") @@ -532,42 +533,77 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. (DEFINEQ (OPENSTRINGSTREAM - [LAMBDA (STR ACCESS) (* rmk%: "28-Mar-85 08:40") - - (* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. Thus, this implementation does not side-effect the string as the 10 does. However, the temporary coercion of strings to open streams in \GETSTREAM does simulate the side-effecting. Note that a string stream is unnamed.") - - (PROG (STREAM FATP) - (OR (STRINGP STR) - (\ILLEGAL.ARG STR)) - (SETQ FATP (ffetch (STRINGP FATSTRINGP) of STR)) - [SETQ STREAM (\MAKEBASEBYTESTREAM (OR (ffetch (STRINGP BASE) of STR) - T) - (COND - (FATP (UNFOLD (ffetch (STRINGP OFFST) of STR) - BYTESPERWORD)) - (T (ffetch (STRINGP OFFST) of STR))) - (COND - (FATP (UNFOLD (ffetch (STRINGP LENGTH) of STR) - BYTESPERWORD)) - (T (ffetch (STRINGP LENGTH) of STR))) - (SELECTQ ACCESS - ((INPUT OUTPUT BOTH) - ACCESS) - (NIL 'INPUT) - (\ILLEGAL.ARG ACCESS] - (PROGN (* ; - "Minor differences between a basebytestream and a stringstream") - (if FATP - then (freplace (STREAM CHARSET) of STREAM with \NORUNCODE)) - (freplace USERCLOSEABLE of STREAM with T) - (freplace USERVISIBLE of STREAM with T) - (SELECTQ (SYSTEMTYPE) - (VAX (freplace F2 of STREAM with 0) - (freplace STRMBINFN of STREAM with (FUNCTION \STRINGBIN))) - NIL)) - (RETURN STREAM]) + [LAMBDA (STR ACCESS) (* ; "Edited 8-Aug-2021 00:02 by rmk:") + (* rmk%: "28-Mar-85 08:40") + + (* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.") + + (* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ") + + (SELECTQ ACCESS + ((INPUT OUTPUT BOTH)) + (NIL (SETQ ACCESS 'INPUT)) + (\ILLEGAL.ARG ACCESS)) + (CL:UNLESS (STRINGP STR) + (\ILLEGAL.ARG STR)) + (LET (STREAM) + (IF (AND (EQ ACCESS 'INPUT) + (NOT (ffetch (STRINGP FATSTRINGP) of STR))) + THEN (\FATTENSTRING STR) + ELSE (\SMASHABLESTRING STR T)) + + (* ;; "String storage is now fat") + + (SETQ STREAM (\MAKEBASEBYTESTREAM (OR (ffetch (STRINGP BASE) of STR) + T) + (UNFOLD (ffetch (STRINGP OFFST) of STR) + BYTESPERWORD) + (UNFOLD (ffetch (STRINGP LENGTH) of STR) + BYTESPERWORD) + ACCESS)) + + (* ;; "Differences between a basebytestream and a stringstream") + + (\EXTERNALFORMAT STREAM :STRING) + (freplace USERCLOSEABLE of STREAM with T) + (freplace USERVISIBLE of STREAM with T) + STREAM]) + +(MAKE-STRING-FORMAT + [LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:") + + (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ") + + (MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP) + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2)) + (\WIN STRM] + [FUNCTION (LAMBDA (STRM NOERROR) + (CL:WHEN (\PEEKBIN STRM NOERROR) + + (* ;; "This guards against the EOF error") + + (PROG1 (LOGOR (LLSH (\BIN STRM) + 8) + (\PEEKBIN STRM NOERROR)) + (\BACKFILEPTR STRM)))] + [FUNCTION (LAMBDA (STRM COUNTP) + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN (\BACKFILEPTR STRM) + (IF (\BACKFILEPTR STRM) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2)) + T + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* 1)))] + [FUNCTION (LAMBDA (STRM CODE) + (\WOUT STRM CODE) + CODE] + NIL + 'CR]) ) +(MAKE-STRING-FORMAT) + (* ;; "STREAM interface for old-style strings") @@ -748,16 +784,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. ) (PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2373 3480 (\ADD-OPEN-STREAM 2383 . 2660) (\GENERIC-UNREGISTER-STREAM 2662 . 3478)) ( -3521 10778 (CLOSEALL 3531 . 4236) (CLOSEF 4238 . 5434) (EOFCLOSEF 5436 . 5732) (INPUT 5734 . 6506) ( -OPENP 6508 . 6907) (OUTPUT 6909 . 7683) (POSITION 7685 . 8497) (RANDACCESSP 8499 . 8974) (\IOMODEP -8976 . 9613) (WHENCLOSE 9615 . 10776)) (10779 10901 (STREAMADDPROP 10789 . 10899)) (12065 24946 ( -\BASEBYTES.IO.INIT 12075 . 15271) (\MAKEBASEBYTESTREAM 15273 . 18585) (\MBS.OUTCHARFN 18587 . 18975) ( -\BASEBYTES.NAME.FROM.STREAM 18977 . 19440) (\BASEBYTES.BOUT 19442 . 20159) (\BASEBYTES.SETFILEPTR -20161 . 20782) (\BASEBYTES.READP 20784 . 21420) (\BASEBYTES.BIN 21422 . 21953) (\BASEBYTES.PEEKBIN -21955 . 22786) (\BASEBYTES.TRUNCATEFN 22788 . 23292) (\BASEBYTES.OPENFN 23294 . 23784) ( -\BASEBYTES.BLOCKIO 23786 . 24944)) (25069 27319 (OPENSTRINGSTREAM 25079 . 27317)) (27376 31012 ( -\STRINGSTREAM.INIT 27386 . 31010)) (31074 34646 (GETSTREAM 31084 . 31307) (\ADDOFD 31309 . 31596) ( -\CLEAROFD 31598 . 31879) (\DELETEOFD 31881 . 32032) (\GETSTREAM 32034 . 34198) (\SEARCHOPENFILES 34200 - . 34644))))) + (FILEMAP (NIL (2412 3519 (\ADD-OPEN-STREAM 2422 . 2699) (\GENERIC-UNREGISTER-STREAM 2701 . 3517)) ( +3560 10817 (CLOSEALL 3570 . 4275) (CLOSEF 4277 . 5473) (EOFCLOSEF 5475 . 5771) (INPUT 5773 . 6545) ( +OPENP 6547 . 6946) (OUTPUT 6948 . 7722) (POSITION 7724 . 8536) (RANDACCESSP 8538 . 9013) (\IOMODEP +9015 . 9652) (WHENCLOSE 9654 . 10815)) (10818 10940 (STREAMADDPROP 10828 . 10938)) (12104 24985 ( +\BASEBYTES.IO.INIT 12114 . 15310) (\MAKEBASEBYTESTREAM 15312 . 18624) (\MBS.OUTCHARFN 18626 . 19014) ( +\BASEBYTES.NAME.FROM.STREAM 19016 . 19479) (\BASEBYTES.BOUT 19481 . 20198) (\BASEBYTES.SETFILEPTR +20200 . 20821) (\BASEBYTES.READP 20823 . 21459) (\BASEBYTES.BIN 21461 . 21992) (\BASEBYTES.PEEKBIN +21994 . 22825) (\BASEBYTES.TRUNCATEFN 22827 . 23331) (\BASEBYTES.OPENFN 23333 . 23823) ( +\BASEBYTES.BLOCKIO 23825 . 24983)) (25108 28417 (OPENSTRINGSTREAM 25118 . 26835) (MAKE-STRING-FORMAT +26837 . 28415)) (28500 32136 (\STRINGSTREAM.INIT 28510 . 32134)) (32198 35770 (GETSTREAM 32208 . 32431 +) (\ADDOFD 32433 . 32720) (\CLEAROFD 32722 . 33003) (\DELETEOFD 33005 . 33156) (\GETSTREAM 33158 . +35322) (\SEARCHOPENFILES 35324 . 35768))))) STOP diff --git a/sources/AOFD.LCOM b/sources/AOFD.LCOM index 1b864a901649393dd1f2e76596aed3ee3548bf93..6f9a72e571ab1ebc557b563a8cdd253cb080c626 100644 GIT binary patch delta 1705 zcma)6-EZ4e6n9c4z#3X6IzEI5hiDykr37C)ag&IL+$7hjRmZk$XKJNNQ`bgq+OSsp zdbNfSJP#vyf;V_V2+{5dq>4A_3y<)E)CqXwA^!jx=h|+UY}r_(>zrOqa-eB0@ z0C9b5?b>Gl##|j7m)U;cnRW+%8SO%sF0o>wDW(Vp*PvkZEDOdnmrA7qY^>eHbYm3} zPEwL+g=fKBfM_@S-kJuYrdRbEq`=_jE@G1m+kX~-GDw%H=L2<&cFXDdGVERN-yZDV zx)B4!Okxyfg8gr@pXI}!GJ=q$n*x4D`xj4yH|R#9`u3g}3s;lnrn46=XM^}oDVfZWnLKaR{DdRL)^}Ezxq)m$@1b|uvRt*{iCmew)IgJWdTvoJu z-6r#(f_|oDu@1FLH1s-v2$B>ol*yRQ>mVzLu0lPnpjW`O-Ch8imI`Vanoh6?qzq0k z;HK0CBW3Y%dQwGE2-MqEQL;cH&nl;)c&0c&wR^X6p`&IuVL!KcIQ zIxZOQH{kc2V4If6zfUZJpihg~4)Z+6J1K%G-^9&j8x*$|3c|rG&&vM@!e1$MaAzux zsfo9qUu8G&fZ(27#+I6<4f?4lKOKfP1|x3i(N@FBUf<%qCKwK0P0r70#9JTa=)swt zb%C=9mp_hd66pURDo-G4hiq&tuiyl5EPuwMIBd}2gTG^u@}k&&6L$>AWPU!SOk4rC z1HwC)P>8SSw4W_h;{0EFo_k>lB!0}8$%}$a(iCWUfLxnSs4|e+6HFRs=JY5Pc+ka1 zAJBxMIHiR1F^?lxer^BX!th)Trf?cxG#8}Di^wus_!9@xJVdwE(ixGzk&|X t?dT8nQbvqsG&Rz-cTwtV3(*%^5v3!o96iv!oSl+WjE>dW=)3Zd{{hs~rG5Ya delta 932 zcmb_a&rcIU6kZlga03CNC|vMmLv>f(+Swm%y5Z1mJKK(IcQ?CBLX%z^OQ1l22pByz z8WX&kW)l)GoHX&^MH|k&Di==1#Ebj^9{L~XY$-|`kIrG{d*6F`@0*$L+s@B*LC9m1 z*jO@&g(YH}4$OJj$OlH&!oU+dz@9~Xmv2r@&x@Q8mE~wbfb+m3MS8fuCCLdH0YbW> z>59^P>deR@&B>Q?X&t3?4K;tvHgcBZV-tw&E(PE$1<~OdcHYS4u^Q=BS}8gw}9i#CCh@#ljHF?54GyvO0B2pR!^=h z>xjxt^8PJ{BHG88_QrZ=ty7$21e8qt^VgB4L4{ZrE*Mta z@CwvolqldJa)U{hUCJc-8A!_ziy5A0lqJVBeH=ha9b~k>HBl!}LYu#lN2&f{X`tpK zcEJ_L1*E2XhDB-uvQAJ0q@WA;B3VAqis8|n+1A_G_Qbd-f{=4cJ_vW|mswhTn7Svd u-n$kyHGYT-TiWgLyCzdKmV6K{BvTaaCZ+I5n+!iD=V|mcc@(}%o&E;Xko#8v diff --git a/sources/ATERM b/sources/ATERM index 104ef16be..096e3457f 100644 --- a/sources/ATERM +++ b/sources/ATERM @@ -1,10 +1,10 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Jun-2021 12:31:16" {DSK}kaplan>Local>medley3.5>git-medley>sources>ATERM.;2 57229 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 7-Aug-2021 12:47:09" {DSK}kaplan>Local>medley3.5>git-medley>sources>ATERM.;3 57513 - changes to%: (FNS \CHDEL1) + changes to%: (FNS \FILLBUFFER) - previous date%: "10-May-2021 15:07:31" -{DSK}kaplan>Local>medley3.5>git-medley>sources>ATERM.;1) + previous date%: "23-Jun-2021 12:31:16" +{DSK}kaplan>Local>medley3.5>git-medley>sources>ATERM.;2) (* ; " @@ -243,7 +243,7 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation. T]) (\FILLBUFFER - [LAMBDA (FILLTYPE) (* ; "Edited 5-May-2021 20:45 by rmk:") + [LAMBDA (FILLTYPE) (* ; "Edited 7-Aug-2021 12:46 by rmk:") (* ;; "While filling the line, the current file pointer is the end of the line. When the line is closed, this is made the eof. *READTABLE* is used for syntactic delimiters and paren counting on READ and RATOM calls but isn't referenced (or bound) for READC") @@ -300,7 +300,8 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation. (\SETFILEPTR \LINEBUF.OFD 0) (replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with RETYPING.LBS)) - (until (\PAGEDEOFP \LINEBUF.OFD) do (\OUTCHAR \TERM.OFD (\INCHAR + (until (\PAGEDEOFP \LINEBUF.OFD) do (\OUTCHAR \TERM.OFD ( + \INCCODE.EOLC \LINEBUF.OFD ))) @@ -426,13 +427,15 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation. (replace (LINEBUFFER LBRKCOUNT) of \LINEBUF.OFD with ILB) (replace (LINEBUFFER INSTRINGP) of \LINEBUF.OFD with ISP) (replace (LINEBUFFER LPARCOUNT) of \LINEBUF.OFD with ILP)) - [until (\PAGEDEOFP \LINEBUF.OFD) do (SETQ CHAR (\INCHAR \LINEBUF.OFD)) + [until (\PAGEDEOFP \LINEBUF.OFD) do (SETQ CHAR (\INCCODE.EOLC + \LINEBUF.OFD)) (COND ((EQ ESCAPE.RC (SETQ RSNX (\SYNCODE RTBLSA CHAR))) (OR (\PAGEDEOFP \LINEBUF.OFD) - (\INCHAR \LINEBUF.OFD))) + (\INCCODE.EOLC \LINEBUF.OFD) + )) (T (\INCPARENCOUNT RSNX] (replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with FILLING.LBS ))) @@ -1139,18 +1142,18 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation. ) (PUTPROPS ATERM COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2974 31665 (BKLINBUF 2984 . 3459) (CLEARBUF 3461 . 4793) (LINBUF 4795 . 4981) ( -PAGEFULLFN 4983 . 6464) (SETLINELENGTH 6466 . 6662) (SYSBUF 6664 . 6850) (TERMCHARWIDTH 6852 . 7269) ( -TERMINAL-INPUT 7271 . 7839) (TERMINAL-OUTPUT 7841 . 8427) (\CHDEL1 8429 . 8698) (\CLOSELINE 8700 . -8989) (\DECPARENCOUNT 8991 . 10574) (\ECHOCHAR 10576 . 11268) (\FILLBUFFER 11270 . 23995) ( -\FILLBUFFER.WORDSEPRP 23997 . 24242) (\FILLBUFFER.BACKUP 24244 . 24423) (\GETCHAR 24425 . 24814) ( -\INCPARENCOUNT 24816 . 27428) (\RESETLINE 27430 . 27754) (\RESETTERMINAL 27756 . 28520) (\SAVELINEBUF -28522 . 30493) (\STOPSCROLL? 30495 . 31663)) (31876 35732 (\DSCCOUT 31886 . 35026) (\INITBCPLDISPLAY -35028 . 35730)) (35925 37175 (VIDEOCOLOR 35935 . 37173)) (38007 43861 (\PEEKREFILL 38017 . 42128) ( -\READREFILL 42130 . 42724) (\RATOM/RSTRING-REFILL 42726 . 43304) (\READCREFILL 43306 . 43859)) (43862 -45691 (DRIBBLE 43872 . 45473) (DRIBBLEFILE 45475 . 45689)) (45692 52367 (\SETUP.DEFAULT.LINEBUF 45702 - . 48159) (\CREATELINEBUFFER 48161 . 50583) (\LINEBUF.READP 50585 . 50934) (\LINEBUF.EOFP 50936 . -51275) (\LINEBUF.PEEKBIN 51277 . 51484) (\OPENLINEBUF 51486 . 52365)) (52442 53681 (LINEBUFFER-EOFP -52452 . 52910) (LINEBUFFER-SKIPSEPRS 52912 . 53679)) (54038 54312 (\INTERMP 54048 . 54179) (\OUTTERMP -54181 . 54310))))) + (FILEMAP (NIL (2992 31949 (BKLINBUF 3002 . 3477) (CLEARBUF 3479 . 4811) (LINBUF 4813 . 4999) ( +PAGEFULLFN 5001 . 6482) (SETLINELENGTH 6484 . 6680) (SYSBUF 6682 . 6868) (TERMCHARWIDTH 6870 . 7287) ( +TERMINAL-INPUT 7289 . 7857) (TERMINAL-OUTPUT 7859 . 8445) (\CHDEL1 8447 . 8716) (\CLOSELINE 8718 . +9007) (\DECPARENCOUNT 9009 . 10592) (\ECHOCHAR 10594 . 11286) (\FILLBUFFER 11288 . 24279) ( +\FILLBUFFER.WORDSEPRP 24281 . 24526) (\FILLBUFFER.BACKUP 24528 . 24707) (\GETCHAR 24709 . 25098) ( +\INCPARENCOUNT 25100 . 27712) (\RESETLINE 27714 . 28038) (\RESETTERMINAL 28040 . 28804) (\SAVELINEBUF +28806 . 30777) (\STOPSCROLL? 30779 . 31947)) (32160 36016 (\DSCCOUT 32170 . 35310) (\INITBCPLDISPLAY +35312 . 36014)) (36209 37459 (VIDEOCOLOR 36219 . 37457)) (38291 44145 (\PEEKREFILL 38301 . 42412) ( +\READREFILL 42414 . 43008) (\RATOM/RSTRING-REFILL 43010 . 43588) (\READCREFILL 43590 . 44143)) (44146 +45975 (DRIBBLE 44156 . 45757) (DRIBBLEFILE 45759 . 45973)) (45976 52651 (\SETUP.DEFAULT.LINEBUF 45986 + . 48443) (\CREATELINEBUFFER 48445 . 50867) (\LINEBUF.READP 50869 . 51218) (\LINEBUF.EOFP 51220 . +51559) (\LINEBUF.PEEKBIN 51561 . 51768) (\OPENLINEBUF 51770 . 52649)) (52726 53965 (LINEBUFFER-EOFP +52736 . 53194) (LINEBUFFER-SKIPSEPRS 53196 . 53963)) (54322 54596 (\INTERMP 54332 . 54463) (\OUTTERMP +54465 . 54594))))) STOP diff --git a/sources/ATERM.LCOM b/sources/ATERM.LCOM index f3f85f1bb415e21a67ff376ba5263cac2068dc90..35118f623dffeef6e1de9f19266b3d5e1dab8f34 100644 GIT binary patch delta 657 zcmcam|E+$4n~{Q?n}3k6V~B!WgtK$7CYOerr;n?1kgH>etBZn?g1N3^X}YeFfsvtt zp^=q|xs`$C#H@gNV@;r(8A8s;z{=Fv%D_TNA*m=eIX|}`Gbc4gfh##9F)ux}Sk+1) z25790Q>dGpYmh=_o`RBFsE>~VvI%;6dP)i@i6ua7SWGrFRzh}~1TMEt_Gh#YFjn9) zH8(XhR)AWsP?8UHfrgu3FtRf=6$*+{%QEvzi^0|cRVW!5>w1;u!F_9NXk}=oq`);f zkkM|l1XHFUr?bC{tDdXBkMrafVRZy=^EzQuCIol#Gtm}CuFctE0gNnM8k$_2_lpP0 zGjdH9G*1JP6=3qdc{Gr1Z2=Nl1SVr`Bql3b+5!0qmQg@*w`C-d6tx1WsIdwIl9$2k z_jcx!3$3Mqd^>xI$xEz#fUJ+!Ak%zpK;%lBSRl!6s|+NyZDW9BhpmMUmqv`IpJ#}Z zbAXSFXK;XzVQ>YP)TrD-Bnp4Atf1 z>E{}(U}^zW6=x?4R8<2eXW6L%*$3@}Md3PtDuMA0HSwjLEl^(FUS9y{5dQ#IKae>< PX`nG__NlB~Kzq3W9zd^n delta 664 zcmZ8cJ8#oa6qXBJA}k)2oUvDKfmqb3A9781MuVi6Ob4g;RTS!b zEyLzfGDNi5v2AqOyIQT%s2@#1bu}~h6?ytsU_-y52 z_Fa5lk(TnoE$R(HF6NX=+$1Xux%gT3RtXZ`Ba$J@Vfk$#SInQxZIRMT*qVRjA z1?-2?1+1&t#W#5!e^Lctzw`G|-NW;08K2i3n3cCPuSt$ywx0rLwKYIb3jsf9@&;K6 zEyrr_>aN|g0@rSK8M5NLP0vH&LDG*?JsqTDkaplan>Local>medley3.5>git-medley>sources>FILEIO.;75 181074 +(FILECREATED " 8-Aug-2021 14:53:49"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;85 181632 - changes to%: (FNS \THROUGHIN) + changes to%: (FNS COPYCHARS) - previous date%: " 5-Aug-2021 22:31:41" -{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;74) + previous date%: " 8-Aug-2021 14:30:40" +{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;83) (* ; " @@ -1199,13 +1199,16 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.  "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") - ))) + (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 POINTER POINTER POINTER POINTER POINTER + POINTER) '((EXTERNALFORMAT 0 (FLAGBITS . 0)) (EXTERNALFORMAT 0 (BITS . 17)) (EXTERNALFORMAT 0 (BITS . 48)) @@ -1214,8 +1217,10 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (EXTERNALFORMAT 4 POINTER) (EXTERNALFORMAT 6 POINTER) (EXTERNALFORMAT 8 POINTER) - (EXTERNALFORMAT 10 POINTER)) - '12) + (EXTERNALFORMAT 10 POINTER) + (EXTERNALFORMAT 12 POINTER) + (EXTERNALFORMAT 14 POINTER)) + '16) (* "END EXPORTED DEFINITIONS") @@ -1250,7 +1255,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2) (BITS 1) - POINTER POINTER POINTER POINTER POINTER POINTER) + POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER) '((EXTERNALFORMAT 0 (FLAGBITS . 0)) (EXTERNALFORMAT 0 (BITS . 17)) (EXTERNALFORMAT 0 (BITS . 48)) @@ -1259,8 +1265,10 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (EXTERNALFORMAT 4 POINTER) (EXTERNALFORMAT 6 POINTER) (EXTERNALFORMAT 8 POINTER) - (EXTERNALFORMAT 10 POINTER)) - '12) + (EXTERNALFORMAT 10 POINTER) + (EXTERNALFORMAT 12 POINTER) + (EXTERNALFORMAT 14 POINTER)) + '16) (ADDTOVAR SYSTEMRECLST (DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) @@ -1271,8 +1279,9 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (BACKCCODEFN POINTER) (OUTCHARFN POINTER) (NAME POINTER) - (FORMATBYTESTREAMFN POINTER (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined") - ))) + (FORMATBYTESTREAMFN POINTER) + (EF1 POINTER) + (EF2 POINTER))) ) (DEFINEQ @@ -1318,15 +1327,19 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. *EXTERNALFORMATS*]) (FIND-FORMAT - [LAMBDA (NAME NOERROR) (* ; "Edited 9-Jul-2021 09:34 by rmk:") - (SETQ NAME (MKATOM NAME)) (* ; + [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"]) + (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 5-Aug-2021 20:39 by rmk:") + [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.") @@ -1343,19 +1356,19 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (\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)) - [(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)) + (fetch (FDEV DEFAULTEXTERNALFORMAT) + of (fetch DEVICE of STREAM)) *DEFAULT-EXTERNALFORMAT*))) (SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME)) (CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME @@ -1415,20 +1428,21 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. EOL _ CR.EOLC]) (\THROUGHIN - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 6-Aug-2021 10:31 by rmk:") + [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 COUNP is non-NIL, always -1 is returned as the second value.") +(* ;;; "If COUNTP is non-NIL, the byte counter is always set to 1.") - (CL:WHEN BYTECOUNTVAR - (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL))) + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1)) (\BIN STREAM]) (\THROUGHBACKCCODE - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:52 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) (CL:WHEN (\BACKFILEPTR STREAM) - (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL))) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) T)]) (\THROUGHOUTCHARFN @@ -2439,7 +2453,7 @@ update the map") ]) (COPYCHARS - [LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 3-Jul-2021 10:59 by rmk:") + [LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 8-Aug-2021 14:53 by rmk:") (* ; "Edited 14-Jun-2021 22:08 by rmk:") (* ; "Edited 8-Dec-95 16:38 by rmk:") (* ; "Edited 26-Mar-99 12:13 by rmk:") @@ -2478,7 +2492,7 @@ update the map") (T START] (RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM)) (SETQ ACTUALEND EOF)) - (T (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCHAR SRCSTRM NIL SRCEOLC))) + (T (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM SRCEOLC))) (* ;  "Not RAP and START and END are both NIL. Slow copy to the end of the file.") (RETURN))) @@ -2532,8 +2546,8 @@ update the map") (* ;;  "Let the \INCHAR macro decrement the byte count") - (\OUTCHAR DSTSTRM (\INCHAR SRCSTRM - 'CNT NIL CNT] + (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL + 'CNT CNT] T]) (COPYFILE @@ -3082,11 +3096,10 @@ update the map") (DEFINEQ (\BOUTEOL - [LAMBDA (STREAM) (* ; "Edited 5-Aug-2021 22:31 by rmk:") + [LAMBDA (STREAM) (* ; "Edited 6-Aug-2021 14:51 by rmk:") - (* ;; "Convenient closed function to put out EOL characters without depending on EXPORTS.ALL for constants. This also sets the position back to 0.") + (* ;; "Convenient closed function to put out EOL characters without depending on EXPORTS.ALL for constants. .") - (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))) @@ -3420,44 +3433,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 (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))))) + (FILEMAP (NIL (28411 31901 (STREAMPROP 28421 . 28855) (GETSTREAMPROP 28857 . 29330) (PUTSTREAMPROP +29332 . 31749) (STREAMP 31751 . 31899)) (31944 34463 (\DEFPRINT.BY.NAME 31954 . 33106) ( +\STREAM.DEFPRINT 33108 . 34156) (\FDEV.DEFPRINT 34158 . 34461)) (34721 39762 (\GETACCESS 34731 . 35185 +) (\SETACCESS 35187 . 39760)) (63079 64332 (MAKE-EXTERNALFORMAT 63089 . 64330)) (65565 73394 ( +\INSTALL.EXTERNALFORMAT 65575 . 67024) (\REMOVE.EXTERNALFORMAT 67026 . 67857) (FIND-FORMAT 67859 . +68676) (\EXTERNALFORMAT 68678 . 73392)) (73717 75580 (\CREATE.THROUGH.EXTERNALFORMAT 73727 . 74529) ( +\THROUGHIN 74531 . 74955) (\THROUGHBACKCCODE 74957 . 75228) (\THROUGHOUTCHARFN 75230 . 75578)) (75688 +81657 (\DEFINEDEVICE 75698 . 78014) (\GETDEVICEFROMNAME 78016 . 78489) (\GETDEVICEFROMHOSTNAME 78491 + . 79535) (\REMOVEDEVICE 79537 . 80660) (\REMOVEDEVICE.NAMES 80662 . 81655)) (81697 106357 (\CLOSEFILE + 81707 . 82532) (\DELETEFILE 82534 . 82828) (\DEVICEEVENT 82830 . 84600) (\GENERATEFILES 84602 . 85080 +) (\GENERATENEXTFILE 85082 . 85733) (\GENERATEFILEINFO 85735 . 86196) (\GETFILENAME 86198 . 86587) ( +\GENERIC.OUTFILEP 86589 . 87059) (\OPENFILE 87061 . 89639) (\DO.PARAMS.AT.OPEN 89641 . 92194) ( +\RENAMEFILE 92196 . 92620) (\REVALIDATEFILE 92622 . 95224) (\PAGED.REVALIDATEFILELST 95226 . 96784) ( +\PAGED.REVALIDATEFILES 96786 . 98505) (\PAGED.REVALIDATEFILE 98507 . 100790) (\BUFFERED.REVALIDATEFILE + 100792 . 103078) (\BUFFERED.REVALIDATEFILELST 103080 . 104264) (\PRINT-REVALIDATION-RESULT 104266 . +104681) (\TRUNCATEFILE 104683 . 105074) (\FILE-CONFLICT 105076 . 106355)) (106393 111056 ( +\GENERATENOFILES 106403 . 108499) (\NULLFILEGENERATOR 108501 . 108745) (\NOFILESNEXTFILEFN 108747 . +110738) (\NOFILESINFOFN 110740 . 111054)) (111175 113083 (\FILE.NOT.OPEN 111185 . 111698) ( +\FILE.WONT.OPEN 111700 . 112028) (\ILLEGAL.DEVICEOP 112030 . 112312) (\IS.NOT.RANDACCESSP 112314 . +112760) (\STREAM.NOT.OPEN 112762 . 113081)) (113218 115516 (\FDEVINSTANCE 113228 . 115514)) (117066 +124440 (CNDIR 117076 . 118381) (DIRECTORYNAME 118383 . 122566) (DIRECTORYNAMEP 122568 . 123184) ( +HOSTNAMEP 123186 . 123993) (\ADD.CONNECTED.DIR 123995 . 124438)) (124485 155136 (\BACKFILEPTR 124495 + . 124683) (\BACKPEEKBIN 124685 . 125046) (\BACKBIN 125048 . 125399) (BIN 125401 . 125618) (\BIN +125620 . 125897) (\BINS 125899 . 126185) (BOUT 126187 . 126549) (\BOUT 126551 . 126866) (\BOUTS 126868 + . 127179) (COPYBYTES 127181 . 130513) (COPYCHARS 130515 . 137445) (COPYFILE 137447 . 138244) ( +\COPYOPENFILE 138246 . 141319) (\INFER.FILE.TYPE 141321 . 142275) (EOFP 142277 . 142574) (FORCEOUTPUT +142576 . 142823) (\FLUSH.OPEN.STREAMS 142825 . 143181) (CHARSET 143183 . 144847) (ACCESS-CHARSET +144849 . 145066) (GETEOFPTR 145068 . 145318) (GETFILEINFO 145320 . 148513) (\TYPE.FROM.FILETYPE 148515 + . 148985) (\FILETYPE.FROM.TYPE 148987 . 149166) (GETFILEPTR 149168 . 149420) (SETFILEINFO 149422 . +153035) (SETFILEPTR 153037 . 154756) (BOUT16 154758 . 154943) (BIN16 154945 . 155134)) (155239 160444 +(\GENERIC.BINS 155249 . 155529) (\GENERIC.BOUTS 155531 . 155796) (\GENERIC.RENAMEFILE 155798 . 157629) + (\GENERIC.OPENP 157631 . 158946) (\GENERIC.READP 158948 . 159989) (\GENERIC.CHARSET 159991 . 160442)) + (160445 160784 (\MAP-OPEN-STREAMS 160455 . 160782)) (162654 164734 (\EOF.ACTION 162664 . 162915) ( +\EOSERROR 162917 . 163110) (\GETEOFPTR 163112 . 163294) (\INCFILEPTR 163296 . 163646) (\PEEKBIN 163648 + . 163839) (\SETCLOSEDFILELENGTH 163841 . 164175) (\SETEOFPTR 164177 . 164365) (\SETFILEPTR 164367 . +164732)) (164735 165277 (\FIXPOUT 164745 . 165045) (\FIXPIN 165047 . 165275)) (165278 165844 (\BOUTEOL + 165288 . 165842)) (168936 178800 (\BUFFERED.BIN 168946 . 169798) (\BUFFERED.PEEKBIN 169800 . 170582) +(\BUFFERED.BOUT 170584 . 171444) (\BUFFERED.BINS 171446 . 175131) (\BUFFERED.BOUTS 175133 . 176934) ( +\BUFFERED.COPYBYTES 176936 . 178798)) (178829 181181 (\NULLDEVICE 178839 . 180857) (\NULL.OPENFILE +180859 . 181179))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index b8253988c4ede6cad4619d6fa69a00246518b4cc..c56219c09ae375b6b38a0a921d6ab5a4ded39bd0 100644 GIT binary patch delta 1511 zcma)6O>Em_7`9!8I@5IyoBETb-79Z{q*^oo#EBiDEl%PnZd1EUoN5!3lC%z8+H~#O z6-`_a5=axhP(F}2!Y)jl(qucZ4*38aa^S=cAfyQiaYBL?5GSPaIX|7+Uhu{5|MPs` z_rC9!@Ace!x95ZMDS2F7pC1=Efd@VmmBgsTZQi}A$x;AVIOr6`C?~KmyIP)GURtSC z%Qn#EyDO_}7ow0br>`f{YBmRzTfnCBnGAr8Jmg^HXbqVS(EgO3(GporwY20BAj~3! z3ZyzEOF;879~K3eyIHz5UtWVd%NWg{GIGx$1F*7MezUT?z6N&bP8s`;Fz2En4*gE5 zlq@!QDlvF+k|GEyW`9lKZ!^ZAw}#`{P#Cmq*39CIfT>B}6WGAFIvYS<3M+gxV(Zk)vL# zne%SsP90)Rx=9sXWq=|d^oT+IyYw^SsjK%5fb@4ns;elH+Zfm;ld34s(x0 z&^u?mRG7oRp>vpbC<4)>mQwQ>3&g{R0ABgfclx3PISap(dmF&>BCxtKqh|Ev;o>YP zQX}V6NQK9blQ*ns;JT@h!tz-Bx}~)|T6Qb|1Wk|xrJ}_-!ifPx7xzvM6mFB8NI?I5)ky5RYRK~IYj@;B61I!oH< zVkvog$rho0%2`P4evz=3-HN;S(Y+Fc2b}bxIne)jDn9W;VaTz~q22ncjyY6gv*NUAv^G4H^Y!y+b~?gs;E;(-!eSH<@ zaKp@7?jVCC%Wy+C5(zV@1vN9107+6Hmp1d6q+x*+!m)8243a2yq!1pKwrwILM!H5$ z=tyE12X@PgVeU|Q5zk*cTTu49TT#%1x!Y0P5*SmAD3D5OGguHhjRitjZrg+~zi$(` zj*S;l&d!oNx>CGA$x7opo27jW>CQf$uC#|FVrrF2_qUpl#tqmwzg#$TOvl$kqRsaw zaiQlYRyy<~zI&kV!SPCHF?aU``gvoZ5#0Fa5?bkD(Bqyy#BGZ&(f+t@7%g5MHmLgr#*8tfq;ZwxcD5I4H2cUfY#I*0Ei0>+I6aCJJqYv#~d^6UWYv z(;smN2au{B5b!t@6(P|BDndxE-5!Wbec;psNFWX^Cpd6|3P(j8fwx|}O$Y~k@w}Pu zee-7KeQz(l<^J+*_q&!iFeIrK1Fe8Lnj)vJ) zD_vY#&gHEPQ0c5$n77uBg<;xA=-R}IgrY*O0CapJnFJ7#$8}KJO%tU3)IeNG#zys+ zY{a5C*Y1O$X_tIj5`kiaEF%ff$_1q&PB#!&$G7G5!}6+iE>~P%gN#|SFkt8DIlDB0 zrGY{z*Dxsw=-V$2RTJdE!95X@AjlE4(Hj}zC5Y*|rh^D$r({DL!>1ImZ_0@2s+^2# z`j~70%faAI*Z3d?0?#3@Z*JrJCf^UVc!Qr^@FY`=h$tgxu|z zs#@~A9d1;F5ywY4f8>nq?j~KgdUgh~x1MT-X300@r)|vCt^IP*HYfu99#45E#JJ(U?9IQzsQ&Q^#VefjjnJUXJ;9_I5J6%Pbxe zt*Dc7Qi*QEQO(iNz_Ot#*%xx1;2`pv5gXMeR0Csy-M-YJeMr9_h)&!$xBQ_TS-el# zJ*NBWj`g)Go97jBrA8!!X6|K|3 zES5h-4@|kAuBV``fkr>9s)|jRu^C^gYjkF@QGIUd?;lb$(r2IFpqpmBe6z!DeXbK9 zqs#TI*1xb-`9n!Gb&=Kj_u4@xL-`kCKnw+8TAMIN6EfCnh=*xKb?kru;|Xmd8O66t z6fi1+Vc23?mJndumcU_a*bWPf)N=9?2DXX$fcS`*7uyUx)`{~-V8tLgy%HAfIRYOP z90Bl>)K&l|wdBHKs+PDotih&)I95WxrFEBxzDpe=LtJ$(LsRITOWuw|mx~yY^CV)= z9I0L}oIT{xarrJs)C=G2K^>P*@uA0s2HJIE?KuStLc5@r2P=makm>QF7mx3)UcLP1 z%jlEMSKhC6xLL`MxSqtWht4n4H)=K#Kh2k8TFrPbT6|iH~GM8+qSpY?Qw9aC% vna>x`ueG+8@b_f)BHp}at*l#xw6$h$nzg{XU@qkfR>nkaplan>Local>medley3.5>git-medley>sources>JAPANESE.;6 64773 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 8-Aug-2021 13:28:16"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17 62025 - changes to%: (FNS \CREATE.JIS.EXTERNALFORMAT \CREATE.SHIFTJIS.EXTERNALFORMAT - \CREATE.EUC.EXTERNALFORMAT) + changes to%: (FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN) - previous date%: "15-Jun-2021 15:26:08" -{DSK}kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;5) + previous date%: " 6-Aug-2021 17:07:29" +{DSK}kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;16) (PRETTYCOMPRINT JAPANESECOMS) @@ -24,8 +23,8 @@ (FNS \MAKE.JIS.TO.XCCS.CONV.TABLE) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAKE.JIS.TO.XCCS.CONV.TABLE] (DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS))) - (FNS \JISIN \JISPEEK \BACKJISCHAR \SHIFTJISIN \SHIFTJISPEEK \BACKSHIFTJISCHAR \EUCIN \EUCPEEK - \BACKEUCCHAR) + (FNS \JISIN \JISPEEK \BACKJISCCODE \SHIFTJISIN \SHIFTJISPEEK \BACKSHIFTJISCCODE \EUCIN + \EUCPEEK \BACKEUCCODE) (FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN) [COMS (FNS CONVHANKAKU) (DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.XCCS.TO.JIS @@ -518,7 +517,99 @@ ) (DEFINEQ -(\JISIN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 15:24 by rmk:") (* ;;; "Returns a 16 bit XCCS code. Assuming the input character stream is encoded with JIS. Allows the incorrect usage of KI and KO based on the two different JIS, OLDJIS and NEWJIS, because it is very likely that these two different sets of KI and KO are used simultaneously, although it is against a standard! ") (* ;;; "If COUNP is non-NIL, the number of bytes read is returned as a second value. Doesn't do EOL conversion -- \INCHAR or \INCCODE do that.") (PROG (CH1 CH2 CH3 (IN16BITFLG (\KIMODEP STREAM T)) (CHARNUM 0)) RETRY (AND (SETQ CH1 (\BIN STREAM)) (COND [(EQ CH1 (CHARCODE ESC)) (* ; "Might be KI or KO.") (SETQ CH2 (\BIN STREAM)) (COND [(EQ CH2 (CHARCODE $)) (* ; "Might be KI") (SETQ CH3 (\BIN STREAM)) (COND ((OR (EQ CH3 (CHARCODE B)) (EQ CH3 (CHARCODE @))) (* ; "KI") (\CHNAGE.KI.MODE STREAM T T) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (SETQ CHARNUM (IPLUS CHARNUM 3] (* ; "Here we have to try the same preocedure again, because bogus duplicated KI/KO sequence might come again!") (SETQ IN16BITFLG T) (GO RETRY)) (T (RETURN (COND (IN16BITFLG (* ; "Under processing 16 bit code.") (\BACKFILEPTR STREAM) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS 2 CHARNUM] (\CONV.JIS.TO.XCCS CH1 CH2)) (T (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS 1 CHARNUM] (CHARCODE ESC] [(EQ CH2 (CHARCODE %()) (* ; "Might be KO") (SETQ CH3 (\BIN STREAM)) (COND ((OR (EQ CH3 (CHARCODE J)) (EQ CH3 (CHARCODE H))) (* ; "KO") (\CHNAGE.KI.MODE STREAM T NIL) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (SETQ CHARNUM (IPLUS CHARNUM 3] (* ;  "Oops. Yes, we have to try again to ignore duplicated KI/KO sequence.") (SETQ IN16BITFLG NIL) (GO RETRY)) (T (RETURN (COND (IN16BITFLG (* ; "Under processing 16 bit code.") (\BACKFILEPTR STREAM) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 2] (\CONV.JIS.TO.XCCS CH1 CH2)) (T (\BACKFILEPTR STREAM) (\BACKFILEPTR STREAM) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 1] (CHARCODE ESC] (IN16BITFLG (* ; "Under processing 16 bit code.") [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 2] (RETURN (\CONV.JIS.TO.XCCS CH1 CH2))) (T (\BACKFILEPTR STREAM) [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 1] (RETURN (CHARCODE ESC] [IN16BITFLG (* ; "Under processing 16 bit code.") [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 2] (RETURN (\CONV.JIS.TO.XCCS CH1 (\BIN STREAM] ((\HANKAKUP CH1) (* ; "HANKAKU-KATAKANA is converted to ZENKAKU-KATAKANA because XCCS does not support HANKAKU-KATAKANA.") [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 1] (RETURN (\CONV.HANKAKU.KANA CH1))) (T (* ;; "C0, SP, DEL, C1, 10/0, or 15/15 of 0 character set.") [AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL (IPLUS CHARNUM 1] (RETURN CH1]) +(\JISIN + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 17:07 by rmk:") + +(* ;;; "Returns a 16 bit XCCS code. Assuming the input character stream is encoded with JIS. Allows the incorrect usage of KI and KO based on the two different JIS, OLDJIS and NEWJIS, because it is very likely that these two different sets of KI and KO are used simultaneously, although it is against a standard! ") + +(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read. Doesn't do EOL conversion -- \INCCODE do that.") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (PROG (CH1 CH2 CH3 (IN16BITFLG (\KIMODEP STREAM T)) + (CHARNUM 0)) + RETRY + (CL:WHEN (SETQ CH1 (\BIN STREAM)) + (IF (EQ CH1 (CHARCODE ESC)) + THEN (* ; "Might be KI or KO.") + (SETQ CH2 (\BIN STREAM)) + (IF (EQ CH2 (CHARCODE $)) + THEN (* ; "Might be KI") + (SETQ CH3 (\BIN STREAM)) + [IF (OR (EQ CH3 (CHARCODE B)) + (EQ CH3 (CHARCODE @))) + THEN (* ; "KI") + (\CHNAGE.KI.MODE STREAM T T) + (CL:WHEN COUNTP (ADD CHARNUM 3)) + (* ; "Here we have to try the same preocedure again, because bogus duplicated KI/KO sequence might come again!") + (SETQ IN16BITFLG T) + (GO RETRY) + ELSE (RETURN (IF IN16BITFLG + THEN + (* ; "Under processing 16 bit code.") + (\BACKFILEPTR STREAM) + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* + (IPLUS 2 CHARNUM))) + (\CONV.JIS.TO.XCCS CH1 CH2) + ELSE (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS 1 CHARNUM + ))) + (CHARCODE ESC] + ELSEIF (EQ CH2 (CHARCODE %()) + THEN (* ; "Might be KO") + (SETQ CH3 (\BIN STREAM)) + [IF (OR (EQ CH3 (CHARCODE J)) + (EQ CH3 (CHARCODE H))) + THEN (* ; "KO") + (\CHNAGE.KI.MODE STREAM T NIL) + (CL:WHEN COUNTP (ADD CHARNUM 3)) + (* ; + "Oops. Yes, we have to try again to ignore duplicated KI/KO sequence.") + (SETQ IN16BITFLG NIL) + (GO RETRY) + ELSE (RETURN (IF IN16BITFLG + THEN + (* ; "Under processing 16 bit code.") + (\BACKFILEPTR STREAM) + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* + (IPLUS CHARNUM 2))) + (\CONV.JIS.TO.XCCS CH1 CH2) + ELSE (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS CHARNUM 1 + ))) + (CHARCODE ESC] + ELSEIF IN16BITFLG + THEN (* ; "Under processing 16 bit code.") + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS CHARNUM 2))) + (RETURN (\CONV.JIS.TO.XCCS CH1 CH2)) + ELSE (\BACKFILEPTR STREAM) + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS CHARNUM 1))) + (RETURN (CHARCODE ESC))) + ELSEIF IN16BITFLG + THEN (* ; "Under processing 16 bit code.") + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS CHARNUM 2))) + (RETURN (\CONV.JIS.TO.XCCS CH1 (\BIN STREAM))) + ELSEIF (\HANKAKUP CH1) + THEN (* ; +"HANKAKU-KATAKANA is converted to ZENKAKU-KATAKANA because XCCS does not support HANKAKU-KATAKANA.") + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS CHARNUM 1))) + (RETURN (\CONV.HANKAKU.KANA CH1)) + ELSE + + (* ;; "C0, SP, DEL, C1, 10/0, or 15/15 of 0 character set.") + + (CL:WHEN COUNTP + (SETQ *BYTECOUNTER* (IPLUS CHARNUM 1))) + (RETURN CH1)))]) (\JISPEEK [LAMBDA (STREAM NOERROR COUNTP) (* ; "Edited 25-Feb-91 16:27 by nm") @@ -640,9 +731,41 @@ (COUNTP (RETURN (CL:VALUES CH1 CHARNUM))) (T (RETURN CH1]) -(\BACKJISCHAR [LAMBDA (STREAM COUNTP BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 15:13 by rmk:") (COND ((\BACKFILEPTR STREAM) (COND [(\KIMODEP STREAM T) (COND [(\BACKFILEPTR STREAM) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2] (T (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL] (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL]) - -(\SHIFTJISIN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 15:01 by rmk:") (* ;;; "Returns a 16 bit XCCS code. Assuming the input character stream is encoded with Shift-JIS. If BYTECOUNTVAR is non-NIL, the number of bytes read is decremented from it.. Doesn't do EOL conversion -- \INCHAR or \INCCODE do that..") (LET ((CH1 (\BIN STREAM)) CH2) (AND CH1 (COND ((\SJIS.KANJI.FIRST.BYTEP CH1) (* ;  "Read next byte and compose a kanji character.") (\CONV.SJIS.TO.JIS CH1 (\BIN STREAM)) (* ;  "CH1 and CH2 is adjusted to represent JIS code in \CONV.SJIS.TO.JIS.") (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL 2))) (\CONV.JIS.TO.XCCS CH1 CH2)) (T (* ; "ASCII or HANKAKU-KATAKANA") (AND BYTECOUNTVAR (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL))) (COND ((\HANKAKUP CH1) (* ; "HANKAKU-KATAKANA") (\CONV.HANKAKU.KANA CH1)) (T (* ; "ASCII") CH1]) +(\BACKJISCCODE + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 17:01 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN (\BACKFILEPTR STREAM) + (IF (\KIMODEP STREAM T) + THEN (IF (\BACKFILEPTR STREAM) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)))]) + +(\SHIFTJISIN + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:27 by rmk:") + +(* ;;; "Returns a 16 bit XCCS code. Assuming the input character stream is encoded with Shift-JIS. If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of byte.. Doesn't do EOL conversion -- \INCCODE.EOLC does that..") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (LET ((CH1 (\BIN STREAM)) + CH2) + (CL:WHEN CH1 + [COND + ((\SJIS.KANJI.FIRST.BYTEP CH1) (* ; + "Read next byte and compose a kanji character.") + (\CONV.SJIS.TO.JIS CH1 (\BIN STREAM)) (* ; + "CH1 and CH2 is adjusted to represent JIS code in \CONV.SJIS.TO.JIS.") + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2)) + (\CONV.JIS.TO.XCCS CH1 CH2)) + (T (* ; "ASCII or HANKAKU-KATAKANA") + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1)) + (COND + ((\HANKAKUP CH1) (* ; "HANKAKU-KATAKANA") + (\CONV.HANKAKU.KANA CH1)) + (T (* ; "ASCII") + CH1])]) (\SHIFTJISPEEK [LAMBDA (STREAM NOERROR COUNTP) (* ; "Edited 25-Feb-91 16:30 by nm") @@ -684,9 +807,48 @@ (COUNTP (RETURN (CL:VALUES CH1 0))) (T (RETURN CH1]) -(\BACKSHIFTJISCHAR [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 15:11 by rmk:") (COND ((\BACKFILEPTR STREAM) (COND [(\BACKFILEPTR STREAM) (COND [(\SJIS.KANJI.FIRST.BYTEP (\PEEKBIN STREAM)) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2] (T (\BIN STREAM) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 1] (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 1]) - -(\EUCIN [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 15:04 by rmk:") (* ;;; "Returns a 16 bit XCCS code. Assuming the input character stream is encoded with EUC (Extended Unix Codes). Although EUC is independent of a particular language, the language implemented here is Japanese, thus this should be called as UJIS (Unixnized extended JIS code). JEIDA uses EUC as UJIS. ") (* ;;; "If COUNP is non-NIL, the number of bytes read is returned as a second value. Doesn't do EOL conversion -- \INCHAR or \INCCODE do that.") (LET ((CH1 (\BIN STREAM)) CH2) (AND CH1 (COND ((\EUC.KANJI.FIRST.BYTEP CH1) (* ;  "Read next byte and compose a kanji character.") (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL 2))) (\CONV.JIS.TO.XCCS (LOGAND CH1 127) (LOGAND (\BIN STREAM) 127))) ((\EUC.HANKAKUP CH1) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL 2))) (\CONV.HANKAKU.KANA (\BIN STREAM))) ((\GAIJIP CH1) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL 3))) (CL:VALUES (\CONV.JIS.TO.XCCS (LOGAND (\BIN STREAM) 127) (LOGAND (\BIN STREAM) 127)) 3)) (T (* ; "ASCII, C0, C1, SP or DEL") (AND BYTECOUNTVAR (SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL))) CH1]) +(\BACKSHIFTJISCCODE + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:32 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN (\BACKFILEPTR STREAM) + (IF (\BACKFILEPTR STREAM) + THEN (IF (\SJIS.KANJI.FIRST.BYTEP (\PEEKBIN STREAM)) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) + ELSE (\BIN STREAM) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)))]) + +(\EUCIN + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:36 by rmk:") + +(* ;;; "Returns a 16 bit XCCS code. Assuming the input character stream is encoded with EUC (Extended Unix Codes). Although EUC is independent of a particular language, the language implemented here is Japanese, thus this should be called as UJIS (Unixnized extended JIS code). JEIDA uses EUC as UJIS. ") + +(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read. Doesn't do EOL conversion -- \INCCODE.EOLC does that.") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (LET ((CH1 (\BIN STREAM)) + CH2) + (CL:WHEN CH1 + (COND + ((\EUC.KANJI.FIRST.BYTEP CH1) (* ; + "Read next byte and compose a kanji character.") + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2)) + (\CONV.JIS.TO.XCCS (LOGAND CH1 127) + (LOGAND (\BIN STREAM) + 127))) + ((\EUC.HANKAKUP CH1) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2)) + (\CONV.HANKAKU.KANA (\BIN STREAM))) + ((\GAIJIP CH1) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 3)) + (\CONV.JIS.TO.XCCS (LOGAND (\BIN STREAM) + 127) + (LOGAND (\BIN STREAM) + 127))) + (T (* ; "ASCII, C0, C1, SP or DEL") + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1)) + CH1)))]) (\EUCPEEK [LAMBDA (STREAM NOERROR COUNTP) (* ; "Edited 25-Feb-91 16:35 by nm") @@ -759,32 +921,57 @@ (COUNTP (RETURN (CL:VALUES CH1 0))) (T (RETURN CH1]) -(\BACKEUCCHAR [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 15:11 by rmk:") (COND ((\BACKFILEPTR STREAM) (COND [(BITTEST (\PEEKBIN STREAM) (MASK.1'S 7 1)) (* ; "C1, KAINJI, HANKAKU or GAIJI") (COND [(\BACKFILEPTR STREAM) (COND [(\EUC.HANKAKUP (\PEEKBIN STREAM)) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2] [(BITTEST (\PEEKBIN STREAM) (MASK.1'S 7 1)) (* ; "KANJI or GAIJI") (COND [(\BACKFILEPTR STREAM) (COND [(\GAIJIP (\PEEKBIN STREAM)) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 3] (T (* ; "KANJI") (\BIN STREAM) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2] (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2] (T (* ; "C1") (\BIN STREAM) (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL] (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL] (AND BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL]) +(\BACKEUCCODE + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:57 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN (\BACKFILEPTR STREAM) + (IF (BITTEST (\PEEKBIN STREAM) + (MASK.1'S 7 1)) + THEN (* ; "C1, KAINJI, HANKAKU or GAIJI") + (IF (\BACKFILEPTR STREAM) + THEN (IF (\EUC.HANKAKUP (\PEEKBIN STREAM)) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) + ELSEIF (BITTEST (\PEEKBIN STREAM) + (MASK.1'S 7 1)) + THEN (* ; "KANJI or GAIJI") + (IF (\BACKFILEPTR STREAM) + THEN (IF (\GAIJIP (\PEEKBIN STREAM)) + THEN (CL:WHEN COUNTP (SETQ + *BYTECOUNTER* -3) + ) + ELSE + (* ; "KANJI") + (\BIN STREAM) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2) + )) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -2)) + ELSE (* ; "C1") + (\BIN STREAM) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)))]) ) (DEFINEQ (\JISOUTCHARFN - [LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 11-Mar-91 11:49 by nm") + [LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 8-Aug-2021 13:24 by rmk:") (* ;;; "Encoder for JIS format.") (COND ((EQ CHARCODE (CHARCODE EOL)) + (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) (COND ((\KIMODEP OUTSTREAM NIL) (\OUTKO OUTSTREAM) (\CHNAGE.KI.MODE OUTSTREAM NIL NIL))) - (\BOUT OUTSTREAM (SELECTC (ffetch EOLCONVENTION of OUTSTREAM) - (CR.EOLC (CHARCODE CR)) - (LF.EOLC (CHARCODE LF)) - (CRLF.EOLC (\BOUT OUTSTREAM (CHARCODE CR)) - - (* ;; "Don't put out high-order byte preceding LF. The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes") - - (CHARCODE LF)) - (SHOULDNT))) - (freplace CHARPOSITION of OUTSTREAM with 0)) - (T (SETQ CHARCODE (\CONV.XCCS.TO.JIS OUTSTREAM CHARCODE)) + (\BOUTEOL OUTSTREAM)) + (T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (SETQ CHARCODE (\CONV.XCCS.TO.JIS OUTSTREAM CHARCODE)) (* ;  "\CONV.XCCS.TO.JIS converts ZENKAKUKATAKANA to HANKAKUKATAKANA if the stream desires it.") (COND @@ -800,32 +987,20 @@ ((\KIMODEP OUTSTREAM NIL) (\OUTKO OUTSTREAM) (\CHNAGE.KI.MODE OUTSTREAM NIL NIL))) - (\BOUT OUTSTREAM CHARCODE))) - (freplace CHARPOSITION of OUTSTREAM with (PROGN - (* ; "Ugh. Don't overflow") - (IPLUS16 (ffetch - CHARPOSITION - of OUTSTREAM) - 1]) + (\BOUT OUTSTREAM CHARCODE]) (\SHIFTJISOUTCHARFN - [LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 7-Mar-91 21:55 by nm") + [LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 8-Aug-2021 13:26 by rmk:") (* ;;; "Encoder for Shift-JIS format.") (COND ((EQ CHARCODE (CHARCODE EOL)) - (\BOUT OUTSTREAM (SELECTC (ffetch EOLCONVENTION of OUTSTREAM) - (CR.EOLC (CHARCODE CR)) - (LF.EOLC (CHARCODE LF)) - (CRLF.EOLC (\BOUT OUTSTREAM (CHARCODE CR)) - - (* ;; "Don't put out high-order byte preceding LF. The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes") - - (CHARCODE LF)) - (SHOULDNT))) - (freplace CHARPOSITION of OUTSTREAM with 0)) - (T (SETQ CHARCODE (\CONV.XCCS.TO.JIS OUTSTREAM CHARCODE)) + (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + (\BOUTEOL OUTSTREAM)) + (T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (SETQ CHARCODE (\CONV.XCCS.TO.JIS OUTSTREAM CHARCODE)) (* ;  "\CONV.XCCS.TO.JIS converts ZENKAKUKATAKANA to HANKAKUKATAKANA if the stream desires it.") (COND @@ -838,32 +1013,20 @@ (< CH2 256)) (\BOUT OUTSTREAM CH1) (\BOUT OUTSTREAM CH2] - (T (\BOUT OUTSTREAM CHARCODE))) - (freplace CHARPOSITION of OUTSTREAM with (PROGN - (* ; "Ugh. Don't overflow") - (IPLUS16 (ffetch - CHARPOSITION - of OUTSTREAM) - 1]) + (T (\BOUT OUTSTREAM CHARCODE]) (\EUCOUTCHARFN - [LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 11-Mar-91 11:29 by nm") + [LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 8-Aug-2021 13:27 by rmk:") (* ;;; "Encoder for EUC format.") (COND ((EQ CHARCODE (CHARCODE EOL)) - (\BOUT OUTSTREAM (SELECTC (ffetch EOLCONVENTION of OUTSTREAM) - (CR.EOLC (CHARCODE CR)) - (LF.EOLC (CHARCODE LF)) - (CRLF.EOLC (\BOUT OUTSTREAM (CHARCODE CR)) - - (* ;; "Don't put out high-order byte preceding LF. The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes") - - (CHARCODE LF)) - (SHOULDNT))) - (freplace CHARPOSITION of OUTSTREAM with 0)) - (T (SETQ CHARCODE (\CONV.XCCS.TO.JIS OUTSTREAM CHARCODE)) + (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) + (\BOUTEOL OUTSTREAM)) + (T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (IPLUS16 1 DATUM)) + (SETQ CHARCODE (\CONV.XCCS.TO.JIS OUTSTREAM CHARCODE)) (* ;  "\CONV.XCCS.TO.JIS converts ZENKAKUKATAKANA to HANKAKUKATAKANA if the stream desires it.") (COND @@ -878,13 +1041,7 @@ (\BOUT OUTSTREAM 142) (\BOUT OUTSTREAM (LOGOR CHARCODE 128))) (T (* ; "C0, C1, SP, DEL or G0") - (\BOUT OUTSTREAM CHARCODE))) - (freplace CHARPOSITION of OUTSTREAM with (PROGN - (* ; "Ugh. Don't overflow") - (IPLUS16 (ffetch - CHARPOSITION - of OUTSTREAM) - 1]) + (\BOUT OUTSTREAM CHARCODE]) ) (DEFINEQ @@ -1099,47 +1256,40 @@ (DEFINEQ (\CREATE.JIS.EXTERNALFORMAT - [LAMBDA NIL (* ; "Edited 23-Jun-2021 16:57 by rmk:") + [LAMBDA NIL (* ; "Edited 5-Aug-2021 22:40 by rmk:") (* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :JIS as its name.") - (\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT - NAME _ :JIS - INCCODEFN _ (FUNCTION \JISIN) - PEEKCCODEFN _ (FUNCTION \JISPEEK) - BACKCCODEFN _ (FUNCTION \BACKJISCHAR) - OUTCHARFN _ (FUNCTION \JISOUTCHARFN]) + (MAKE-EXTERNALFORMAT :JIS (FUNCTION \JISIN) + (FUNCTION \JISPEEK) + (FUNCTION \BACKJISCCODE) + (FUNCTION \JISOUTCHARFN]) (\CREATE.SHIFTJIS.EXTERNALFORMAT - [LAMBDA NIL (* ; "Edited 23-Jun-2021 16:57 by rmk:") + [LAMBDA NIL (* ; "Edited 5-Aug-2021 22:41 by rmk:") (* ;;; "Create two instances of EXTERNALFORMAT datatype and install them with :W-MS and :MS as their names respectively. :MS have to change the end of line convention to CRLF.") - (\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT - NAME _ :W-MS - INCCODEFN _ (FUNCTION \SHIFTJISIN) - PEEKCCODEFN _ (FUNCTION \SHIFTJISPEEK) - BACKCCODEFN _ (FUNCTION \BACKSHIFTJISCHAR) - OUTCHARFN _ (FUNCTION \SHIFTJISOUTCHARFN))) - (\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT - NAME _ :MS - INCCODEFN _ (FUNCTION \SHIFTJISIN) - PEEKCCODEFN _ (FUNCTION \SHIFTJISPEEK) - BACKCCODEFN _ (FUNCTION \BACKSHIFTJISCHAR) - OUTCHARFN _ (FUNCTION \SHIFTJISOUTCHARFN) - EOL _ CRLF.EOLC]) + (MAKE-EXTERNALFORMAT :W-MS (FUNCTION \SHIFTJISIN) + (FUNCTION \SHIFTJISPEEK) + (FUNCTION \BACKSHIFTJISCCODE) + (FUNCTION \SHIFTJISOUTCHARFN)) + (MAKE-EXTERNALFORMAT :MS (FUNCTION \SHIFTJISIN) + (FUNCTION \SHIFTJISPEEK) + (FUNCTION \BACKSHIFTJISCCODE) + (FUNCTION \SHIFTJISOUTCHARFN) + NIL + 'CRLF]) (\CREATE.EUC.EXTERNALFORMAT - [LAMBDA NIL (* ; "Edited 23-Jun-2021 16:57 by rmk:") + [LAMBDA NIL (* ; "Edited 5-Aug-2021 22:40 by rmk:") (* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :EUC as its name.") - (\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT - NAME _ :EUC - INCCODEFN _ (FUNCTION \EUCIN) - PEEKCCODEFN _ (FUNCTION \EUCPEEK) - BACKCCODEFN _ (FUNCTION \BACKEUCCHAR) - OUTCHARFN _ (FUNCTION \EUCOUTCHARFN]) + (MAKE-EXTERNALFORMAT :EUC (FUNCTION \EUCIN) + (FUNCTION \EUCPEEK) + (FUNCTION \BACKEUCCODE) + (FUNCTION \EUCOUTCHARFN]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -1163,11 +1313,11 @@ (ADDTOVAR LAMA CONVHANKAKU) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11013 16229 (\MAKE.JIS.TO.XCCS.CONV.TABLE 11023 . 16227)) (19873 44134 (\JISIN 19883 . -25968) (\JISPEEK 25970 . 32596) (\BACKJISCHAR 32598 . 33079) (\SHIFTJISIN 33081 . 34480) ( -\SHIFTJISPEEK 34482 . 36588) (\BACKSHIFTJISCHAR 36590 . 37138) (\EUCIN 37140 . 39018) (\EUCPEEK 39020 - . 42599) (\BACKEUCCHAR 42601 . 44132)) (44135 50824 (\JISOUTCHARFN 44145 . 46502) (\SHIFTJISOUTCHARFN - 46504 . 48551) (\EUCOUTCHARFN 48553 . 50822)) (50825 51144 (CONVHANKAKU 50835 . 51142)) (61868 64328 -(\CREATE.JIS.EXTERNALFORMAT 61878 . 62502) (\CREATE.SHIFTJIS.EXTERNALFORMAT 62504 . 63700) ( -\CREATE.EUC.EXTERNALFORMAT 63702 . 64326))))) + (FILEMAP (NIL (10976 16192 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10986 . 16190)) (19836 45193 (\JISIN 19846 . +26482) (\JISPEEK 26484 . 33110) (\BACKJISCCODE 33112 . 33652) (\SHIFTJISIN 33654 . 35046) ( +\SHIFTJISPEEK 35048 . 37154) (\BACKSHIFTJISCCODE 37156 . 37742) (\EUCIN 37744 . 39447) (\EUCPEEK 39449 + . 43028) (\BACKEUCCODE 43030 . 45191)) (45194 49042 (\JISOUTCHARFN 45204 . 46614) (\SHIFTJISOUTCHARFN + 46616 . 47716) (\EUCOUTCHARFN 47718 . 49040)) (49043 49362 (CONVHANKAKU 49053 . 49360)) (60086 61580 +(\CREATE.JIS.EXTERNALFORMAT 60096 . 60484) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60486 . 61189) ( +\CREATE.EUC.EXTERNALFORMAT 61191 . 61578))))) STOP diff --git a/sources/JAPANESE.LCOM b/sources/JAPANESE.LCOM index 30d3b8fdd66b17228622aeed54853a2b5daba760..b45e3af2eaf49a2875030719562ad170ecb9f360 100644 GIT binary patch delta 4668 zcmb_gdu&^075BZ4oz!{MNod|pzBo;=(rh1*XaCd@cx~s%X;SA z_?J(fzVJNt)$SwCTSGT{aW$Jk~V#A$!f3<53_n7|$e87;z|_0d)FN z2mnEyy$3QuDhsAMZOHIUIiq9!Mjib9uITKO+4w-KY_>oObu z^H{?|1TS^jsyczbDWs^DD+yd8aYsnp zQhv5UiF<;^JzqitKXH4eFe-s&i57TRX0^br)hjQmkuz^AkuyJp$dfzMYJ^NA@^SP5 zeW_v1a$ElLOyPUDtE?XM_0l@-@r2~R2^5jU*(`UVGutmFSWsAC_$3NH54Y%t%bna6j^J=?w-r)aO7#iojWQ=4Y70gqOo+-GuY9PleF zsqDhv`{QewoX^kJ#tFWKMcF|0?!+nh{S^GduNC3E+(d%}9#BTC(*e3|ti!3WT|70bcX8Be5psetFk0c@ zU0UngITyZE)y8-+-%+m@oNoH&fVW1517)GeWVM;*imQLLJr_vq4OA<^>}O0adoL5{xe9Y*x-KUt5rGNXv88lKfXFU}oakHGi&IE6hLR)_%FLHI|0`^z?C)o zk%BA>2oq#k=qc>$+FfFbhhxM$KGoHn+!{-0olUm_`)Zj2=1eI8lby~&D+6vj7UUHQ zV5vyJtDAe+Rm|+JQC{F?I0kL4Q<__nUn668AIS7$bs&>-5B&(Ab9g$IVbCSaF#HSm z5@tG=3hyT>vT|$wr&-yOe=93@Lc&a^QHUCWv9woH zaNvE;y3>UQ*#Oo-P?<2(L6xXbCKaRXeEgZ*L=_(AL4gjdg!zG4ygWHpCjo2@H&4&p zp$-Z=w2@X1ywk4KgM;e8x#HHU8k}!6v(QttOP#!nbh+Ni@e0FXCvDrJxAQ!m41z!_ z1;1x*WIc*5?^b)67u34p*453ogn@0j|Dh>gS=W>=C}ks0Kb*+V9an2;NM&BkLmeHU z{kdMPM^$TvXATY)P89TnQ;(s4NxfOsjz-E(;MAzSy}8HTb~KU<2BW>yD1rzH>f?HY2NcRh06b$zTJ9N-4vz=e!D z4+i5=F^d1Ruc3@{Xo-7y$h#iRk|*9(jZFev^{7ct(FfD2`WwN!3!A+2xLIQ5P<^%0&caR1-o*gC%LC_DKR`T#1o2Au^On$y;Y#3leUf@ zdNUVD#X^X*cv=dFG7#5VHcs`6Qj;htks+XQXkHFb(-@GQ-HCktX+*HmxN9agfHX;9 z_bN;pOT$WgR{$I8?oZ>1KHLB0%z}gP8*=lR0dqALptUf7R3ZR^+?Y|Rg)!ktX&lx? zX^gHM&YQR6^Wj=}6H97vOSl;SB)kXSrb~8WHsS^9qOk=ZiuAE2gl)%~@p}jY7S_c`9e$Mf zLb1u3N{Rym%Uk_3|R0YcvyAeOn*bFkvnc(n=j!2dq%oWo`V43+&$ zQXOtfOQ0dAiS|cnvfrB_^oK>5bBNH#4-uU|P+AxvyS_Wpy_(+)9N0fcMBw%uCbFxCiT0zz wWaqIXWPSe#;ddV;8DBa|IG-NnVTJQ0zX6t*20dhZsn9|m_;g=`QMv2?4RjPg3IG5A delta 5632 zcmcIoeQaCR7595ivc#UJMu;}1T188F&HLF&pnjl~XV6%(?MK$?&`KK92znxKsKk7*z*Wg7o%$z* za!3fe(Y~XTw;#Uq$N_yak8G3o965SyeF$MK*^WO+Y??p^4k4R+cw0J+7H_?A<3=~i z-*z0Q$I$V^aK2|alQoTSaW>3Nba>H` zqmy?ZIDFz5Js6bSg1pFCIV36}pXx?7yqOPk@=Sq$sjeWR=&oFBP}`QtZI7f;0tt&5 zW5DpCY!0F~;zhN0+btGrxXuE9Z`53ys_d^!HUF?7jCSXrE7pEb@2EUitg(dAcwX-T zk~>}wqX|7)xtP|&m6D4sJoskKwQ}TqB%08z@9tXvo{j8QK5%9F_iS+EvbJXx;|CQq05OK6|!O?`yFLKn|GCx%& zo}4LiSD3rpG`Op+&6znNSzTha=(xdPWyV`JPh5|P~ ziJ!EO*jAg{H{wt2Xw@gWD+9pH-7wg5f5EOsXW@0dma<>TP@G06PIJG_5D@2{*E^~3 zLWbd#AwXW3ExGk;$=On8zTmK~jBaYb+O!WaBU? zC@NzMY7oWJAQu9DM)(2(6Z!l>gOFr25seI{NV6HujUhG27O5&*6HrB}8Bm~};IM!{ zuyjGdFDzvg6rW6wlY>6`^{dPvKbW!PEWaF}d-{D$K?;7(7zsRBvO*M@b)sN+BrxlO z>VjS~b%XM~c8F3y#*fBaHG-%L*rmFGP=Z+NZ|5X@y6I-z*x$|zGM+}r8dN3x_IkH9 z81Umy9c_Hj4;tOppco`mtE$Mjh`Owb8l-B9>I427-mj805QFsW%=OL!lwn=1CxF zac3i~Zb|PO!$N~|pBGu87K^2ZRp*PLMa^!ehcVAb^CkBn)GW&&wAH7NIcE9N^HeP-O=4k%=s^^n0o-aur-XDU3?sxFL!@lFU&qs)-S|o zXIkR=2T&s1;33WuCqxK0bPFq>QgxoSA-tvgU$$RBCo`u#UHz(3&3#E>=`BK5ki-{# zECC^dlDpTt}s~K5@ z%GdGQGR_gN=@s!}mVHZ6e7V=X<$NSx>H!B0Ai@adtx*#faMci4JVq4-SgjZ+;lK56 zsJCYlX^KYYhIL;H4gR&242|Lnf(HL`9$FCuzN4(qQv{kx*D<3%^WcW>aD~prEVw8a zwWzrMFu7Ikpc+==<_IIbaDxteoaH^Ox~nqNueIv#%8Um--IW;^d~UAHw8O_!nQ4K~ z@ycbbHBZ|n=YUSHIcG0wPH4nW?6nji%ZrwIB6n3T=V70Vd01YWq;@#@J*z+yy?4z> zkv)#GW^icQ?`bS+4t>6INppOtH5M%|X^k+0ed)H()2}&uN^AX4bDH;6(efZz`&dD9 z7A>dA@t#UaENjlG*-{TRv9y-1ew>cew`#2mYo|5FjFa2EgRD8H*Me7%YfiW#rhQD> z3$CB2l-3aWS-lhFKL`17%R^NBGdlk005M6o_Heu-@?^CV;&2}XeC#^#2L;x41FQ{8 zMz5Ddb)ixOnHISq8&?E$by6{sSt*JtvK|*u$d_0A_^tKbydtoV4;R&Ls|*d2^h+7a z2|6F=$4KqrCDue`F+iBSK$|5G6-HXDUt;@8qQoi@nkH$Uq9{Y4fAlvs6uxO?p0zAgruBzK%Ok8h^;0*d zDl_*QrFxgae5gXoRbN!Dw4_0~0NR@k?OsFsVXD0)3hzbMa%pk*FRUh|wOI7UbuY;5 zjuZUGS7f)QASet&=yKTtT+OP4CP-kSi3|elmt35RxFC}m_7dEgrn=-?sxH7KZ_1YL zx0p3Z~HyG%#wSo^Yi)-7`Lzx^30zPy{ zf7KXM4@#4Y;MbKTnKvvFVTJL65ETHMJtjo(#Ux?-UR)SJc6e%q;yGQX_%?+j$d0i4w}Rd7P(@V5-icKq_@P@&WYmv>_JnQ+_yCBeQe4}?DtlQo&TT9*Qt zM0i>np_Z!@B)btpdEtT={LtcP6j;n9p&E100{yjsp$v}zGvwwj5LZDK@cjdBJG3}6 zQt+tp)vv+NglqBdZs{WtYFkL(Z#zO`b$NY$wzL@+w)hGxfAv$>r`M9lzf->!nSDB} zKV$?g0+Q3q0#?my5#BjQ!02n7=B7~1W}lf}!k2|kfHYYayKfe{ON9_A-MwV!%HKgg zt@UMtu$TmI5;Z1KSEj8K;D>fJk;r6ok#u@vY$yB=Boj#wYhxpk9H2)0TheGq*CM}H zfJs^p5;sA`!i01yc<@mg`kx@65O9$n-B)8>x@&INXsr7_*xPHvAB=b5frzbeFR^5JaBfMI;Flqdk}08~QX$YLgN7>r zi9#6#SPVf^0w^?+MNp1k5;R2MFt>oLGn&7Ni78>g04^q@3XaJz5ZciP#{ongUxg7j z(M~b?zvmgeE0+5NOy-UP{unP0nrA>8UI6vwd4|h_ZqAPXIyedAbe9WX9csc_T|GWE zw4ut8fqJ&iiErImk6p14%tq?h;(KF3piT~S;df$Nt#;(Wr}<8-4y(YuYdCI&^vACZ zx3?hsGOY36hudpF?!_N)3h%Mw$kqv1_4L;7!+6VZH}=HI-uvRW!T4G{3u9Y?$O;KU zvwsrCfl`t?VTAwE;mgSsQ2$KkVQh-G;bW-*pr%u|!`PZ8<2`BO_|Mel$ur$?uY}NXND@ zLKnt}&h;^}Dw(CyETLED2z@d~q#w~SzK!r-pkwQHLjQn{*R~U#*bc(^^$xOX)y_T` z!#fFmiH?oCh|aNHMCUy^ZrM$wzuZkcwv7}1k#T{yQ*e0j?bY#4;JrWY;_PQ8I&0~3 F=|A}>DqsKr diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY index bc675f373..7e2d3b8c5 100644 --- a/sources/LLDISPLAY +++ b/sources/LLDISPLAY @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 1-Aug-2021 23:41:37"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;5 268898 +(FILECREATED " 8-Aug-2021 00:19:22"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7 268927 - changes to%: (FNS DSPCREATE) + changes to%: (FNS READBITMAP) - previous date%: " 1-Aug-2021 23:37:06" -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;4) + previous date%: " 1-Aug-2021 23:41:37" +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;6) (* ; " @@ -1340,9 +1340,9 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. (T (\ILLEGAL.ARG BITMAP]) (READBITMAP - [LAMBDA (FILE) (* ; "Edited 1-Dec-86 19:29 by Pavel") + [LAMBDA (FILE) (* ; "Edited 8-Aug-2021 00:18 by rmk:") -(* ;;; "reads a bitmap from the input file.") +(* ;;; "reads a bitmap from the input file.") (SKIPSEPRS FILE) (OR (EQ (READC FILE) @@ -1354,8 +1354,8 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. [SETQ BITSPERPIXEL (SELECTQ (SKIPSEPRS STRM) ((%" %)) 1) - (PROGN (* ; - "after height can come the bits per pixel.") + (PROGN (* ; + "after height can come the bits per pixel.") (RATOM FILE] (SETQ W (FOLDHI (ITIMES BITSPERPIXEL WIDTH) BITSPERWORD)) @@ -1366,26 +1366,26 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. [(EQ (SKIPSEPRS STRM) '%") (FRPTQ HEIGHT (SKIPSEPRS STRM) - (OR (EQ (\BIN STRM) + (OR (EQ (\INCCODE STRM) (CHARCODE %")) (GO BAD)) - (FRPTQ W [\PUTBASEBYTE BASE 0 (LOGOR (LLSH (IDIFFERENCE (\BIN STRM) + (FRPTQ W [\PUTBASEBYTE BASE 0 (LOGOR (LLSH (IDIFFERENCE (\INCCODE STRM) (SUB1 (CHARCODE A))) 4) - (IDIFFERENCE (\BIN STRM) + (IDIFFERENCE (\INCCODE STRM) (SUB1 (CHARCODE A] - [\PUTBASEBYTE BASE 1 (LOGOR (LLSH (IDIFFERENCE (\BIN STRM) + [\PUTBASEBYTE BASE 1 (LOGOR (LLSH (IDIFFERENCE (\INCCODE STRM) (SUB1 (CHARCODE A))) 4) - (IDIFFERENCE (\BIN STRM) + (IDIFFERENCE (\INCCODE STRM) (SUB1 (CHARCODE A] (SETQ BASE (\ADDBASE BASE 1))) - (OR (EQ (\BIN STRM) + (OR (EQ (\INCCODE STRM) (CHARCODE %")) (GO BAD] (T (GO BAD))) (SKIPSEPRS STRM) - (OR (EQ (\BIN STRM) + (OR (EQ (\INCCODE STRM) (CHARCODE %))) (GO BAD)) (RETURN BM) @@ -4528,42 +4528,42 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. (PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1993 1994 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (20543 23211 (\FBITMAPBIT 20553 . 21013) (\FBITMAPBIT.UFN 21015 . 22034) ( -\NEWPAGE.DISPLAY 22036 . 22171) (INITBITMASKS 22173 . 23209)) (25256 25765 (\CreateCursorBitMap 25266 - . 25763)) (25882 84942 (BITBLT 25892 . 36282) (BLTSHADE 36284 . 37062) (\BITBLTSUB 37064 . 47199) ( -\GETPILOTBBTSCRATCHBM 47201 . 47816) (BITMAPCOPY 47818 . 48394) (BITMAPCREATE 48396 . 49956) ( -BITMAPBIT 49958 . 58345) (BLTCHAR 58347 . 58963) (\BLTCHAR 58965 . 59467) (\MEDW.BLTCHAR 59469 . 64347 -) (\CHANGECHARSET.DISPLAY 64349 . 67307) (\INDICATESTRING 67309 . 68505) (\SLOWBLTCHAR 68507 . 75603) -(TEXTUREP 75605 . 75875) (INVERT.TEXTURE 75877 . 76151) (INVERT.TEXTURE.BITMAP 76153 . 77688) ( -BITMAPWIDTH 77690 . 78062) (READBITMAP 78064 . 80546) (\INSUREBITSPERPIXEL 80548 . 80843) ( -MAXIMUMCOLOR 80845 . 80986) (OPPOSITECOLOR 80988 . 81167) (MAXIMUMSHADE 81169 . 81380) (OPPOSITESHADE -81382 . 81561) (\MEDW.BITBLT 81563 . 84940)) (84944 90259 (FINISH-READING-BITMAP 84944 . 90259)) ( -91522 92003 (BITMAPBIT.EXPANDER 91532 . 92001)) (92004 140538 (\BITBLT.DISPLAY 92014 . 115253) ( -\BITBLT.BITMAP 115255 . 124354) (\BITBLT.MERGE 124356 . 126609) (\BLTSHADE.DISPLAY 126611 . 133711) ( -\BLTSHADE.BITMAP 133713 . 140536)) (140539 149859 (\BITBLT.BITMAP.SLOW 140549 . 149857)) (149860 -166241 (\PUNT.BLTSHADE.BITMAP 149870 . 156966) (\PUNT.BITBLT.BITMAP 156968 . 166239)) (166242 169682 ( -\SCALEDBITBLT.DISPLAY 166252 . 167885) (\BACKCOLOR.DISPLAY 167887 . 169680)) (174000 176273 ( -DISPLAYSTREAMP 174010 . 174618) (DSPSOURCETYPE 174620 . 175629) (DSPXOFFSET 175631 . 175950) ( -DSPYOFFSET 175952 . 176271)) (176274 192575 (DSPCREATE 176284 . 178388) (DSPDESTINATION 178390 . -181493) (DSPTEXTURE 181495 . 181657) (\DISPLAYSTREAMINCRXPOSITION 181659 . 181946) (\SFFixDestination -181948 . 183126) (\SFFixClippingRegion 183128 . 185300) (\SFFixFont 185302 . 186352) (\SFFIXLINELENGTH - 186354 . 187850) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187852 . 189665) (\SFFixY 189667 . 192573)) - (192576 194770 (\MEDW.XOFFSET 192586 . 193727) (\MEDW.YOFFSET 193729 . 194768)) (194771 202697 ( -\DSPCLIPPINGREGION.DISPLAY 194781 . 195527) (\DSPFONT.DISPLAY 195529 . 197899) (\DISPLAY.PILOTBITBLT -197901 . 198050) (\DSPLINEFEED.DISPLAY 198052 . 198623) (\DSPLEFTMARGIN.DISPLAY 198625 . 199356) ( -\DSPOPERATION.DISPLAY 199358 . 200382) (\DSPRIGHTMARGIN.DISPLAY 200384 . 201229) ( -\DSPXPOSITION.DISPLAY 201231 . 202088) (\DSPYPOSITION.DISPLAY 202090 . 202695)) (207467 212503 ( -TTYDISPLAYSTREAM 207477 . 212501)) (212822 213852 (DSPSCROLL 212832 . 213532) (PAGEHEIGHT 213534 . -213850)) (213897 216919 (\DSPRESET.DISPLAY 213907 . 216917)) (217479 238117 (\DSPPRINTCHAR 217489 . -225327) (\DSPPRINTCR/LF 225329 . 238115)) (238118 238710 (\TTYBACKGROUND 238128 . 238708)) (238711 -241998 (DSPBACKUP 238721 . 241996)) (242182 242438 (COLORDISPLAYP 242192 . 242436)) (242439 244510 ( -DISPLAYBEFOREEXIT 242449 . 243275) (DISPLAYAFTERENTRY 243277 . 244508)) (244890 249422 ( -\DSPCLIPTRANSFORMX 244900 . 245489) (\DSPCLIPTRANSFORMY 245491 . 246216) (\DSPTRANSFORMREGION 246218 - . 246750) (\DSPUNTRANSFORMY 246752 . 247012) (\DSPUNTRANSFORMX 247014 . 247274) ( -\OFFSETCLIPPINGREGION 247276 . 249420)) (250728 253315 (UPDATESCREENDIMENSIONS 250738 . 251367) ( -\CreateScreenBitMap 251369 . 253313)) (253874 267033 (\CoerceToDisplayDevice 253884 . 254297) ( -\CREATEDISPLAY 254299 . 256139) (DISPLAYSTREAMINIT 256141 . 259285) (\STARTDISPLAY 259287 . 262198) ( -\MOVE.WINDOWS.ONTO.SCREEN 262200 . 264392) (\UPDATE.PBT.RASTERWIDTHS 264394 . 266176) (\STOPDISPLAY -266178 . 266670) (\DEFINEDISPLAYINFO 266672 . 267031)) (267641 268402 (INITIALIZEDISPLAYSTREAMS 267651 - . 268400))))) + (FILEMAP (NIL (20544 23212 (\FBITMAPBIT 20554 . 21014) (\FBITMAPBIT.UFN 21016 . 22035) ( +\NEWPAGE.DISPLAY 22037 . 22172) (INITBITMASKS 22174 . 23210)) (25257 25766 (\CreateCursorBitMap 25267 + . 25764)) (25883 84971 (BITBLT 25893 . 36283) (BLTSHADE 36285 . 37063) (\BITBLTSUB 37065 . 47200) ( +\GETPILOTBBTSCRATCHBM 47202 . 47817) (BITMAPCOPY 47819 . 48395) (BITMAPCREATE 48397 . 49957) ( +BITMAPBIT 49959 . 58346) (BLTCHAR 58348 . 58964) (\BLTCHAR 58966 . 59468) (\MEDW.BLTCHAR 59470 . 64348 +) (\CHANGECHARSET.DISPLAY 64350 . 67308) (\INDICATESTRING 67310 . 68506) (\SLOWBLTCHAR 68508 . 75604) +(TEXTUREP 75606 . 75876) (INVERT.TEXTURE 75878 . 76152) (INVERT.TEXTURE.BITMAP 76154 . 77689) ( +BITMAPWIDTH 77691 . 78063) (READBITMAP 78065 . 80575) (\INSUREBITSPERPIXEL 80577 . 80872) ( +MAXIMUMCOLOR 80874 . 81015) (OPPOSITECOLOR 81017 . 81196) (MAXIMUMSHADE 81198 . 81409) (OPPOSITESHADE +81411 . 81590) (\MEDW.BITBLT 81592 . 84969)) (84973 90288 (FINISH-READING-BITMAP 84973 . 90288)) ( +91551 92032 (BITMAPBIT.EXPANDER 91561 . 92030)) (92033 140567 (\BITBLT.DISPLAY 92043 . 115282) ( +\BITBLT.BITMAP 115284 . 124383) (\BITBLT.MERGE 124385 . 126638) (\BLTSHADE.DISPLAY 126640 . 133740) ( +\BLTSHADE.BITMAP 133742 . 140565)) (140568 149888 (\BITBLT.BITMAP.SLOW 140578 . 149886)) (149889 +166270 (\PUNT.BLTSHADE.BITMAP 149899 . 156995) (\PUNT.BITBLT.BITMAP 156997 . 166268)) (166271 169711 ( +\SCALEDBITBLT.DISPLAY 166281 . 167914) (\BACKCOLOR.DISPLAY 167916 . 169709)) (174029 176302 ( +DISPLAYSTREAMP 174039 . 174647) (DSPSOURCETYPE 174649 . 175658) (DSPXOFFSET 175660 . 175979) ( +DSPYOFFSET 175981 . 176300)) (176303 192604 (DSPCREATE 176313 . 178417) (DSPDESTINATION 178419 . +181522) (DSPTEXTURE 181524 . 181686) (\DISPLAYSTREAMINCRXPOSITION 181688 . 181975) (\SFFixDestination +181977 . 183155) (\SFFixClippingRegion 183157 . 185329) (\SFFixFont 185331 . 186381) (\SFFIXLINELENGTH + 186383 . 187879) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187881 . 189694) (\SFFixY 189696 . 192602)) + (192605 194799 (\MEDW.XOFFSET 192615 . 193756) (\MEDW.YOFFSET 193758 . 194797)) (194800 202726 ( +\DSPCLIPPINGREGION.DISPLAY 194810 . 195556) (\DSPFONT.DISPLAY 195558 . 197928) (\DISPLAY.PILOTBITBLT +197930 . 198079) (\DSPLINEFEED.DISPLAY 198081 . 198652) (\DSPLEFTMARGIN.DISPLAY 198654 . 199385) ( +\DSPOPERATION.DISPLAY 199387 . 200411) (\DSPRIGHTMARGIN.DISPLAY 200413 . 201258) ( +\DSPXPOSITION.DISPLAY 201260 . 202117) (\DSPYPOSITION.DISPLAY 202119 . 202724)) (207496 212532 ( +TTYDISPLAYSTREAM 207506 . 212530)) (212851 213881 (DSPSCROLL 212861 . 213561) (PAGEHEIGHT 213563 . +213879)) (213926 216948 (\DSPRESET.DISPLAY 213936 . 216946)) (217508 238146 (\DSPPRINTCHAR 217518 . +225356) (\DSPPRINTCR/LF 225358 . 238144)) (238147 238739 (\TTYBACKGROUND 238157 . 238737)) (238740 +242027 (DSPBACKUP 238750 . 242025)) (242211 242467 (COLORDISPLAYP 242221 . 242465)) (242468 244539 ( +DISPLAYBEFOREEXIT 242478 . 243304) (DISPLAYAFTERENTRY 243306 . 244537)) (244919 249451 ( +\DSPCLIPTRANSFORMX 244929 . 245518) (\DSPCLIPTRANSFORMY 245520 . 246245) (\DSPTRANSFORMREGION 246247 + . 246779) (\DSPUNTRANSFORMY 246781 . 247041) (\DSPUNTRANSFORMX 247043 . 247303) ( +\OFFSETCLIPPINGREGION 247305 . 249449)) (250757 253344 (UPDATESCREENDIMENSIONS 250767 . 251396) ( +\CreateScreenBitMap 251398 . 253342)) (253903 267062 (\CoerceToDisplayDevice 253913 . 254326) ( +\CREATEDISPLAY 254328 . 256168) (DISPLAYSTREAMINIT 256170 . 259314) (\STARTDISPLAY 259316 . 262227) ( +\MOVE.WINDOWS.ONTO.SCREEN 262229 . 264421) (\UPDATE.PBT.RASTERWIDTHS 264423 . 266205) (\STOPDISPLAY +266207 . 266699) (\DEFINEDISPLAYINFO 266701 . 267060)) (267670 268431 (INITIALIZEDISPLAYSTREAMS 267680 + . 268429))))) STOP diff --git a/sources/LLDISPLAY.LCOM b/sources/LLDISPLAY.LCOM index 39580bfb2..b7217ed9e 100644 --- a/sources/LLDISPLAY.LCOM +++ b/sources/LLDISPLAY.LCOM @@ -1,10 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 2-Aug-2021 00:07:24" ("compiled on " -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;5) " 1-Aug-2021 23:43:13" -"COMPILE-FILEd" in "FULL 1-Aug-2021 ..." dated " 1-Aug-2021 23:43:18") -(FILECREATED " 1-Aug-2021 23:41:37" {DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;5 - 268898 changes to%: (FNS DSPCREATE) previous date%: " 1-Aug-2021 23:37:06" -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;4) +(FILECREATED " 8-Aug-2021 00:19:22" ("compiled on " +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7) " 6-Aug-2021 20:53:08" +"COMPILE-FILEd" in "FULL 6-Aug-2021 ..." dated " 6-Aug-2021 20:53:13") +(FILECREATED " 8-Aug-2021 00:19:22" {DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7 + 268927 changes to%: (FNS READBITMAP) previous date%: " 1-Aug-2021 23:41:37" +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;6) (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION @@ -187,7 +187,7 @@ BLTCHAR :D8 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT) () \BLTCHAR :D8 -(P 0 A0288 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) +(P 0 A0140 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () \MEDW.BLTCHAR :D8 @@ -246,10 +246,10 @@ BITMAPWIDTH :D8 (23 WIDTH 16 WINDOW 5 BITMAP) () READBITMAP :D8 -(P 6 BITSPERPIXEL P 5 W P 4 BM P 3 BASE P 2 STRM P 1 HEIGHT P 0 WIDTH I 0 FILE) ù@ @ gðªo ¿@ @ @g -CJ dgð§dgð’¿k†¿@ ^HÚlØââââ½HIN \É»Ijð³qJ gð²RIdjñ²\J ¿J l"ð²=Mdjñ²0KjJ l@ÙààààJ l@ÙäÇ¿KkJ l@ÙààààJ l@ÙäÇ¿KkлkÙ°Ï¿J l"ð¬¿o hkÙ°£¿J ¿J l)ð²ãL(237 SKIPSEPRS 224 ERROR 146 SKIPSEPRS 126 SKIPSEPRS 106 BITMAPCREATE 87 RATOM 61 SKIPSEPRS 52 GETSTREAM 41 RATOM 35 RATOM 28 ERROR 11 READC 5 SKIPSEPRS) -(131 %" 112 BITMAP 75 %) 67 %" 47 INPUT 16 %() -( 219 "BAD FORMAT OF BITMAP IN FILE" 23 "BAD FORMAT OF BITMAP IN FILE") +(P 6 BITSPERPIXEL P 5 W P 4 BM P 3 BASE P 2 STRM P 1 HEIGHT P 0 WIDTH I 0 FILE) @ @ gðªo ¿@ @ @g +CJ dgð§dgð’¿k†¿@ ^HÚlØââââ½HIN \É»Ij𒱊J gð²jIdjñ²tJ ¿J l"ð²QMdjñ²@KjJ l@ÙààààJ l@ÙäÇ¿KkJ l@ÙààààJ l@ÙäÇ¿KkлkÙ°¿¿J l"ð¬¿o hkÙ°‹¿J ¿J l)ð²ßL(270 \INCCODE 263 SKIPSEPRS 250 ERROR 235 \INCCODE 214 \INCCODE 201 \INCCODE 187 \INCCODE 174 \INCCODE 155 \INCCODE 148 SKIPSEPRS 128 SKIPSEPRS 106 BITMAPCREATE 87 RATOM 61 SKIPSEPRS 52 GETSTREAM 41 RATOM 35 RATOM 28 ERROR 11 READC 5 SKIPSEPRS) +(133 %" 112 BITMAP 75 %) 67 %" 47 INPUT 16 %() +( 245 "BAD FORMAT OF BITMAP IN FILE" 23 "BAD FORMAT OF BITMAP IN FILE") \INSUREBITSPERPIXEL :D8 (I 0 NBITS) #@d¡kdkð³üdlð³ödlð³ðdlð³ê (32 \ILLEGAL.ARG) NIL @@ -273,7 +273,7 @@ OPPOSITESHADE :D8 NIL () \MEDW.BITBLT :D8 -(P 9 A0291 P 8 A0290 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0289 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)  +(P 9 A0143 P 8 A0142 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0141 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)   @ ³C ªo ¿@òZ@²WCi Cgh É0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±–Cô‚±¯C´‚±¨@i !@gh É0AIÉصABIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@ @@ -420,27 +420,27 @@ Q (145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT) () DSPXOFFSET :D8 -(P 0 A0303 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM) +(P 0 A0155 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPYOFFSET :D8 -(P 0 A0304 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM) +(P 0 A0156 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPCREATE :D8 -(P 0 DSTRM I 0 DESTINATION F 8 DEFAULTFONT F 9 \DISPLAYIMAGEOPS F 10 DisplayFDEV) k€@µ +(P 0 DSTRM I 0 DESTINATION F 8 DEFAULTFONT F 9 \DISPLAYIMAGEOPS F 10 DisplayFDEV) e€@µ `b„¿l djÏ0¿dg(¿djÏ ¿`dj6¿dk.¿dk,¿`dkÏ ¿¹dI*¿dj¿d`¿odnÿdhºdJ ¿d`¿dj¿dj¿dj¿dj¿»dK0¿dW.¿dW -¿dnÿÿÍ5¿`¼dLÍ4¿dh2¿dg*¿dg&¿dg$¿`½dMÍ¿dj¿dj¿djÏ 0¿dkÏ ¿djÍ¿dlÏ¿dh¿djÏ¿dg +¿dnÿÿÍ5¿`¼dLÍ4¿dh2¿dg*¿dg&¿dg$¿`½dMÍ¿dj¿dj¿dkÏ ¿djÍ¿dlÏ¿dh¿djÏ¿dg ¿XWH @H WH `@È_¿^Oó‘NOH gH gH -H(359 DSPOPERATION 348 DSPSOURCETYPE 337 DSPRIGHTMARGIN 306 DSPFONT 298 DSPDESTINATION 291 DSPFONT 281 \SETACCESS) -(353 REPLACE 342 INPUT 317 BITMAP 311 SCREENWIDTH 276 OUTPUT 219 FILELINELENGTH 211 \STREAM.NOT.OPEN 202 \STREAM.NOT.OPEN 193 \EOSERROR 176 \STREAM.DEFAULT.MAXBUFFERS 123 ScreenBitMap 93 SCREENWIDTH 69 |PILOTBBTTYPE#| 48 |\DISPLAYDATATYPE#| 34 \DSPPRINTCHAR 18 BITMAP 10 ScreenBitMap) +H(353 DSPOPERATION 342 DSPSOURCETYPE 331 DSPRIGHTMARGIN 300 DSPFONT 292 DSPDESTINATION 285 DSPFONT 275 \SETACCESS) +(347 REPLACE 336 INPUT 311 BITMAP 305 SCREENWIDTH 270 OUTPUT 219 FILELINELENGTH 211 \STREAM.NOT.OPEN 202 \STREAM.NOT.OPEN 193 \EOSERROR 176 \STREAM.DEFAULT.MAXBUFFERS 123 ScreenBitMap 93 SCREENWIDTH 69 |PILOTBBTTYPE#| 48 |\DISPLAYDATATYPE#| 34 \DSPPRINTCHAR 18 BITMAP 10 ScreenBitMap) ( 101 -16383) DSPDESTINATION :D8 (P 4 CL::$$TYPE-VALUE P 3 CL::$$TYPE-VALUE P 2 CL::$$TYPE-VALUE P 1 \INTERRUPTABLE P 0 DD I 1 DISPLAYSTREAM I 0 DESTINATION F 5 DisplayFDEV F 6 \4DISPLAYFDEV F 7 XDisplayFDEV F 8 \8DISPLAYFDEV F 9 \24DISPLAYFDEV) ýAgh bÉ0XdÉ@¢±ØA@Jò2@Èdkð“¿U°,dlð“¿V°#dlð”¿W°lð’W‰JôW diff --git a/sources/LLREAD b/sources/LLREAD index da981ee02..d1761ad17 100644 --- a/sources/LLREAD +++ b/sources/LLREAD @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED "29-Jul-2021 22:16:26"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;50 97706 +(FILECREATED " 8-Aug-2021 14:52:26"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;76 100285 - changes to%: (VARS CHARACTERSETNAMES) + changes to%: (FNS \INCCODE.EOLC) - previous date%: "29-Jul-2021 22:14:18" -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;48) + previous date%: " 8-Aug-2021 13:10:22" +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;75) (* ; " @@ -43,7 +43,7 @@ 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 + (FNS \OUTCHAR \INCCODE \BACKCCODE \PEEKCCODE \PEEKCCODE.NOEOLC \INCCODE.EOLC \FORMATBYTESTREAM) (MACROS \CHECKEOLC)) (COMS (INITVARS (*REPLACE-NO-FONT-CODE* T) @@ -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)) @@ -635,7 +635,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 +733,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 +742,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)) @@ -1118,13 +1119,14 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (RETURN \READDEPTH]) (\CHECKEOLC.CRLF - [LAMBDA (STREAM PEEKBINFLG BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 23-Jun-2021 13:08 by rmk:") + [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 BYTECOUNTVAR, decrements that free variable by the number of bytes read.") + (* ;; "If COUNTP, that sets *BYTECOUNTER* freely with the number of LF bytes.") - (LET (CH (NUM 0)) + (DECLARE (USEDFREE *BYTECOUNTER*)) + (LET (CH) [SETQ CH (COND [PEEKBINFLG @@ -1159,12 +1161,14 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (* ;; "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) + (IF COUNTP + THEN (LET (NUMLFBYTES) + (DECLARE (SPECVARS NUMLFBYTES)) + (\INCCODE STREAM 'NUMLFBYTES 0) + (ADD *BYTECOUNTER* NUMLFBYTES)) + ELSE (\INCCODE STREAM)) (CHARCODE EOL)) (T (CHARCODE CR] - (CL:WHEN BYTECOUNTVAR - (SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)) - NUM))) CH]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -1653,21 +1657,59 @@ 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 8-Aug-2021 13:08 by rmk:") + + (* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.") - (* ;; "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") + (* ;; "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]) -(\INCCODE [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 10:23 by rmk:") (* ;; "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))") (* ;; "Caller must bind BYTECOUNTVAR as a SPECVAR. BYTECOUNTVAL can be passed as the current value of BYTECOUNTVAR, to save a call to EVAL.") (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM) \DEFAULTINCCODE) STREAM BYTECOUNTVAR (AND BYTECOUNTVAR (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR]) +(\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 23-Jun-2021 14:49 by rmk:") - (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) - \DEFAULTBACKCCODE) - STREAM BYTECOUNTVAR (AND BYTECOUNTVAR (\EVALV1 BYTECOUNTVAR]) + [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 6-Aug-2021 15:57 by rmk:") + (IF BYTECOUNTVAR + THEN [LET ((*BYTECOUNTER* 0)) + (DECLARE (SPECVARS *BYTECOUNTER*)) + (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) + \DEFAULTINCCODE) + STREAM + '*BYTECOUNTER* 0 (SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 + BYTECOUNTVAR + )) + *BYTECOUNTER*] + ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) + \DEFAULTINCCODE) + STREAM]) (\PEEKCCODE [LAMBDA (STREAM NOERROR EOL) (* ; "Edited 14-Jun-2021 12:40 by rmk:") @@ -1682,35 +1724,46 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. \DEFAULTPEEKCCODE) STREAM NOERROR]) -(\INCHAR - [LAMBDA (STREAM BYTECOUNTVAR EOLC BYTECOUNTVAL) (* ; "Edited 22-Jun-2021 10:48 by rmk:") +(\INCCODE.EOLC + [LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:") - (* ;; "EOL conversion around essentially what \INCCODE does, without 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") - (CL:WHEN BYTECOUNTVAR - (OR BYTECOUNTVAL (SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))) - (\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM) - \DEFAULTINCCODE) - STREAM BYTECOUNTVAR BYTECOUNTVAL) - (OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM)) - STREAM NIL BYTECOUNTVAR BYTECOUNTVAL]) + (IF BYTECOUNTVAR + THEN [LET (*BYTECOUNTER* CODE) + (DECLARE (SPECVARS *BYTECOUNTER*)) -(\INCCODE.EOLC - [LAMBDA (STREAM BYTECOUNTVAR EOLC BYTECOUNTVAL) (* ; "Edited 22-Jun-2021 10:48 by rmk:") + (* ;; "The INCCODEFN first sets *BYTECOUNTER*") - (* ;; "EOL conversion around essentially what \INCCODE does, without the extra function call.") + (CL:UNLESS BYTECOUNTVAL + (SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))) + (SETQ CODE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM) + \DEFAULTINCCODE) + STREAM T)) - (* ;; " EOLC of NIL means all patterns go to EOL") + (* ;; "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") - (CL:WHEN BYTECOUNTVAR - (OR BYTECOUNTVAL (SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))) - (\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM) - \DEFAULTINCCODE) - STREAM BYTECOUNTVAR BYTECOUNTVAL) - (OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM)) - STREAM NIL BYTECOUNTVAR BYTECOUNTVAL]) + (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:") @@ -1738,7 +1791,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. ) (DECLARE%: EVAL@COMPILE -(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG BYTECOUNTVAR BYTECOUNTVAL) +(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP) (COND ((EQ EOLC 'NOEOLC) CH) @@ -1757,7 +1810,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 - BYTECOUNTVAR BYTECOUNTVAL)) + COUNTP)) (CHARCODE CR))) CH]) ) @@ -1794,19 +1847,19 @@ 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 - (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) ( -CL:READ-DELIMITED-LIST 13033 . 13948) (CL:PARSE-INTEGER 13950 . 20421)) (20516 33455 (RSTRING 20526 . -21258) (READ-EXTENDED-TOKEN 21260 . 25126) (\RSTRING2 25128 . 33453)) (33491 66954 (\TOP-LEVEL-READ -33501 . 35484) (\SUBREAD 35486 . 60977) (\SUBREADCONCAT 60979 . 61602) (\ORIG-READ.SYMBOL 61604 . -62672) (\ORIG-INVALID.SYMBOL 62674 . 63573) (\APPLYREADMACRO 63575 . 63991) (INREADMACROP 63993 . -64559) (\CHECKEOLC.CRLF 64561 . 66952)) (67113 67288 (READQUOTE 67123 . 67286)) (67313 79217 (READVBAR - 67323 . 68654) (READHASHMACRO 68656 . 74466) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 74468 . 74688) ( -DIGITBASEP 74690 . 75424) (READNUMBERINBASE 75426 . 77312) (ESTIMATE-DIMENSIONALITY 77314 . 77639) ( -SKIP.HASH.COMMENT 77641 . 78609) (CMLREAD.FEATURE.PARSER 78611 . 79215)) (79261 85794 (CHARACTER.READ -79271 . 80525) (CHARCODE.DECODE 80527 . 85792)) (90262 95112 (\OUTCHAR 90272 . 90675) (\INCCODE 90677 - . 91360) (\BACKCCODE 91362 . 91662) (\PEEKCCODE 91664 . 91980) (\PEEKCCODE.NOEOLC 91982 . 92244) ( -\INCHAR 92246 . 92930) (\INCCODE.EOLC 92932 . 93622) (\FORMATBYTESTREAM 93624 . 95110))))) + (FILEMAP (NIL (3472 11701 (LASTC 3482 . 3788) (PEEKC 3790 . 4178) (PEEKCCODE 4180 . 4473) (RATOM 4475 + . 5556) (READ 5558 . 6118) (READC 6120 . 6761) (READCCODE 6763 . 7522) (READP 7524 . 8076) ( +SETREADMACROFLG 8078 . 8377) (SKIPSEPRCODES 8379 . 9362) (SKIPSEPRS 9364 . 9750) (SKREAD 9752 . 11699) +) (11747 20422 (CL:READ 11757 . 12306) (CL:READ-PRESERVING-WHITESPACE 12308 . 13030) ( +CL:READ-DELIMITED-LIST 13032 . 13947) (CL:PARSE-INTEGER 13949 . 20420)) (20515 33460 (RSTRING 20525 . +21257) (READ-EXTENDED-TOKEN 21259 . 25131) (\RSTRING2 25133 . 33458)) (33496 67202 (\TOP-LEVEL-READ +33506 . 35489) (\SUBREAD 35491 . 61052) (\SUBREADCONCAT 61054 . 61677) (\ORIG-READ.SYMBOL 61679 . +62747) (\ORIG-INVALID.SYMBOL 62749 . 63648) (\APPLYREADMACRO 63650 . 64066) (INREADMACROP 64068 . +64634) (\CHECKEOLC.CRLF 64636 . 67200)) (67361 67536 (READQUOTE 67371 . 67534)) (67561 79465 (READVBAR + 67571 . 68902) (READHASHMACRO 68904 . 74714) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 74716 . 74936) ( +DIGITBASEP 74938 . 75672) (READNUMBERINBASE 75674 . 77560) (ESTIMATE-DIMENSIONALITY 77562 . 77887) ( +SKIP.HASH.COMMENT 77889 . 78857) (CMLREAD.FEATURE.PARSER 78859 . 79463)) (79509 86042 (CHARACTER.READ +79519 . 80773) (CHARCODE.DECODE 80775 . 86040)) (90510 97729 (\OUTCHAR 90520 . 91646) (\INCCODE 91648 + . 92834) (\BACKCCODE 92836 . 93796) (\PEEKCCODE 93798 . 94114) (\PEEKCCODE.NOEOLC 94116 . 94378) ( +\INCCODE.EOLC 94380 . 96239) (\FORMATBYTESTREAM 96241 . 97727))))) STOP diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM index e11beb807db761bd05588b69ae7ccdf23ced470f..617a2b22f277c41db0a6f76182a444934684a2d5 100644 GIT binary patch delta 1849 zcmah~OKcif6lE}W>}l;lh@863=ZQ2aI5lBr7%h!WtyHP^4cG=JQfF~A^X`53 zo^#)QclIAp+xyf9Srh8-6E^dGtb=6`e-q7e(&3*l24YC`+Ou z3EiqR^qd#Z;%Q1$-7Z8k4hP%MqxpsOaz3|?HdcUwH4u(9^RS`SwcOi_E1TzV&_*hc-=SZB#n+*O$JC+^wNhVt3ZZ9Z&KLTH58-gj zo6`$Moz=x7aad3UQI!c?-iT_}uM_*+p_uYwh7KxE~SdHS7183g~$4BLWe@c~ND2hN{Fbv9-cvKbqvV;PN zMZLtT?U0mS8`358l&(eCy<{@#aA@E{iSsSyNmXAWP^7E77XNOK$w>LM)q=KMQG$=> z4d(Z1f{UFXupeqy?=j?NkKUagl#EK!h}M0G14@2Dtbei2MjOMBT^7v|4#VX_4Pu;5 z6pm=U%XrHA!NTd1rmsniCNDW81%$Y)*13Q{Z%trt!DOO*5Bv98l>0R;MSZYK@b9%} zwJsWdLKDRmW6j4zQNE>M7btT&P)t%0$DyP&F395ykYhaNV};b(;eK?WM9SVo3n=*Y zI#OeMjl$sGi4;jyr%`C&@TDQXb! z`n6hS+A3NV<6rp}i~3O4lsNn((^i-a3VUt7pI$b7^R=8WkrGtPV+LTWoyI_xf)M0UN7IN zdTx_mA0n;XrK@fSjX^DYPbGvM>Z?=;GqD~et3`v8XL)E>aaa;ZNOA0CaXYkV`3vVZ9vVa>iB*JeqB-*!=F2JSPLBPASBwEKDv98V$c0bM$PFGTP z!0D9FTpKqKT8xB;kku-UA^d&H4A#e~*eO`I%E6e5`@)$%z}uM%fFEV90{)!Ib<>Q;1OG&i OhePD=2=3vaO#cV8JLh`< delta 1678 zcmb7FOK2Nc6xB$=A30+rCpEG9@vG7#Gb9!o{UwK1qtVEcHTsQ4{*G-)9@SQmt;CRqXJ2?+#3ccz7u66mU6Ll2&H9Mj<>rvv9p?Poo645Y#UjTu5iacZhdluYs;pHP8!Ojp z^{R#}i_7KJrRw_mFj{SFEZ0_-P;C`C;zdb9ou{2nrvqu_4LI_WtUi~6wJ`CdBnq;~ zD`E@{JiCji!t<0+^tq5F6bQKds7;JE8o0fkoHWs_)er zo9j9^Y}T?Y6q5wJN-5q+@S zN2Z$AOa5ja`C8+%TK%7c9er-ChYoI)NF-Ia>^-*DU8#dFQgzp!^>FdA)xh}tCwh_B zh16t*=tmw;0;yx7Qc%E(G)ptV08+E7Rbjcj#&0xMqUH4}^7~(0a|ci|lPfBS3nCTH z#sqxhwO7nE!_xS&O^-?Yz>3!>xZNL~g7CsJIyxcK82TD5F@%NUCdWz;>mLE@> zKw$IdH~P>!Yb_c916U;XCXGW?)++Cf*}NrML{=G#R*=T z;E>;|>lU&x5&2*_CyFUSpLsk;jq*Z!2G(@M?A*yQxOUzE%4Ef?B*5iwa#yaNNrUP) zDTBcjc@W&~);ngS3=v-YrZ0M=t8Pm4gK=)?!=V;vR0ydtG0qny1zJf|z#4czk{_Lm zBXGDKJeCDC4vHc)mvuWXJ}~c^@@=Yi{YN}dK%2+H1duod9%pzdo|V(Q((IRGl-`lq zg569i!I}Kf7^MG*c+cMwzU1|5S?Ov$SCT;T4@7snA`eg5Y(^@n3)$aJSQ8pF=I&4{ ziLc9cDv3W+hWxy6iZlc2=HOMK3JFn25jv+JOK}9{A4~LxPCUhb=Ld1NaN$Uq9e*fD1S(iFwap2Q`$!c~NpHLKyf0-x&CMG4ooyiK|?~@8(dTIgitEnpB z>FIX?Kb+P8pG?mJj?R$i?U^aS-)2a3c9!J%R>#-XxAi7WsONgZ z4@;47bXpOGY%!z2n-6tNBp?&AnHXXiF^_2dUNiY(RuS7BVKG-O3=mC>lq@JniaYg9 z_|q~`xKg%bs*+@B@+?J@nYc98nf^I0Qdy}o*h4dNj?ce?@aO6fB)M4`0lZfkJ_%&! a7+4xytPav#D8wNE4kaplan>Local>medley3.5>git-medley>sources>PMAP.;6 60175 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 7-Aug-2021 12:45:46" {DSK}kaplan>Local>medley3.5>git-medley>sources>PMAP.;7 60192 changes to%: (FNS \PAGEDREADP) - previous date%: "21-Jun-2021 21:45:16" -{DSK}kaplan>Local>medley3.5>git-medley>sources>PMAP.;5) + previous date%: "23-Jun-2021 12:40:35" +{DSK}kaplan>Local>medley3.5>git-medley>sources>PMAP.;6) (* ; " @@ -740,7 +740,7 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation. OFFSET _ (fetch EOFFSET of STREAM]) (\PAGEDREADP - [LAMBDA (STREAM FLG) (* ; "Edited 23-Jun-2021 12:40 by rmk:") + [LAMBDA (STREAM FLG) (* ; "Edited 7-Aug-2021 12:45 by rmk:") (* ;; "If FLG is NIL, a single EOL as the last character of the file doesn't count. This is a character operation, not a byte operation.") @@ -755,9 +755,9 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation. (PROGN (* ;; "Yes if we aren't on the last page.") - (* ;; "If on the last page, we know we are not at the end, because the just-peeked EOL is there. But we also don't know how many bytes the EOL occupied. So at this point we have to read the EOL, check to see if we are at then at the EOF, and then back out the EOL") + (* ;; "If on the last page, we know we are not at the end, because the just-peeked EOL is there. But we also don't know how many bytes the EOL occupied. So at this point we have to read the EOL, check to see if we are then at the EOF, and then back out the EOL") - (\INCHAR STREAM) + (\INCCODE.EOLC STREAM) (PROG1 (NOT (\PAGEDEOFP STREAM)) (\BACKCCODE STREAM]) @@ -1107,18 +1107,18 @@ EVAL@COMPILE (PUTPROPS PMAP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1993 2002 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2513 29167 (ADDMAPBUFFER 2523 . 2699) (\ALLOCMAPBUFFER 2701 . 3302) (CHECKBUFFERREFVAL -3304 . 3879) (CLEARMAP 3881 . 4537) (\WRITEOUTBUFFERS 4539 . 5288) (\CLEARMAP 5290 . 8516) (DOPMAP -8518 . 8981) (FINDPTRSBUFFER 8983 . 9857) (FORGETPAGES 9859 . 12144) (\GETMAPBUFFER 12146 . 15268) ( -LOCKMAP 15270 . 15477) (MAPAFTERCLOSE 15479 . 15782) (MAPBUFFERCOUNT 15784 . 16274) (MAPPAGE 16276 . -17785) (MAPWORD 17787 . 18100) (\RELEASEBUFFER 18102 . 18671) (RELEASINGVMEMPAGE 18673 . 19310) ( -RESTOREMAP 19312 . 22109) (UNLOCKMAP 22111 . 22320) (\MAPPAGE 22322 . 27776) (\COLLECTDIRTYBUFS 27778 - . 28558) (\SETIODIRTY 28560 . 29165)) (29168 30139 (WORDCONTENTS 29178 . 29347) (SETWORDCONTENTS -29349 . 29661) (/SETWORDCONTENTS 29663 . 29968) (WORDOFFSET 29970 . 30137)) (31845 51748 ( -\MAKE.PMAP.DEVICE 31855 . 33183) (\PAGEDBACKFILEPTR 33185 . 35659) (\PAGEDSETFILEPTR 35661 . 37097) ( -\PAGED.INCFILEPTR 37099 . 40123) (\PAGEDGETFILEPTR 40125 . 40368) (\PAGEDGETEOFPTR 40370 . 40788) ( -\PAGEDREADP 40790 . 42027) (\PAGEDEOFP 42029 . 43646) (\PAGED.GETNEXTBUFFER 43648 . 47442) ( -\PAGED.FORCEOUTPUT 47444 . 49892) (\UPDATEOF 49894 . 50726) (\READPAGES 50728 . 51188) (\WRITEPAGES -51190 . 51746)) (51749 55841 (\SETEOF 51759 . 52974) (\PAGED.SETEOFPTR 52976 . 54870) (\NEWLENGTHIS -54872 . 55839)) (55983 56363 (PPBUFS 55993 . 56361))))) + (FILEMAP (NIL (2527 29181 (ADDMAPBUFFER 2537 . 2713) (\ALLOCMAPBUFFER 2715 . 3316) (CHECKBUFFERREFVAL +3318 . 3893) (CLEARMAP 3895 . 4551) (\WRITEOUTBUFFERS 4553 . 5302) (\CLEARMAP 5304 . 8530) (DOPMAP +8532 . 8995) (FINDPTRSBUFFER 8997 . 9871) (FORGETPAGES 9873 . 12158) (\GETMAPBUFFER 12160 . 15282) ( +LOCKMAP 15284 . 15491) (MAPAFTERCLOSE 15493 . 15796) (MAPBUFFERCOUNT 15798 . 16288) (MAPPAGE 16290 . +17799) (MAPWORD 17801 . 18114) (\RELEASEBUFFER 18116 . 18685) (RELEASINGVMEMPAGE 18687 . 19324) ( +RESTOREMAP 19326 . 22123) (UNLOCKMAP 22125 . 22334) (\MAPPAGE 22336 . 27790) (\COLLECTDIRTYBUFS 27792 + . 28572) (\SETIODIRTY 28574 . 29179)) (29182 30153 (WORDCONTENTS 29192 . 29361) (SETWORDCONTENTS +29363 . 29675) (/SETWORDCONTENTS 29677 . 29982) (WORDOFFSET 29984 . 30151)) (31859 51765 ( +\MAKE.PMAP.DEVICE 31869 . 33197) (\PAGEDBACKFILEPTR 33199 . 35673) (\PAGEDSETFILEPTR 35675 . 37111) ( +\PAGED.INCFILEPTR 37113 . 40137) (\PAGEDGETFILEPTR 40139 . 40382) (\PAGEDGETEOFPTR 40384 . 40802) ( +\PAGEDREADP 40804 . 42044) (\PAGEDEOFP 42046 . 43663) (\PAGED.GETNEXTBUFFER 43665 . 47459) ( +\PAGED.FORCEOUTPUT 47461 . 49909) (\UPDATEOF 49911 . 50743) (\READPAGES 50745 . 51205) (\WRITEPAGES +51207 . 51763)) (51766 55858 (\SETEOF 51776 . 52991) (\PAGED.SETEOFPTR 52993 . 54887) (\NEWLENGTHIS +54889 . 55856)) (56000 56380 (PPBUFS 56010 . 56378))))) STOP diff --git a/sources/PMAP.LCOM b/sources/PMAP.LCOM index c4d937e3f3801be2614c1302a50286b6c6e43787..846a3eeebb2c180c691b7d809f2cc96f3d3953db 100644 GIT binary patch delta 512 zcmZ{h%SyvQ6o#oF=(rFSix-eXL@{9FWOAuS6w+Lzk~XD@qIjdW)mAi$w{2fR88^Oy zE?oEmx)WT8xNz;(7jPrui6FYr&Bs6d=lti)%zg9{owy7JT)&tzLl{`FtUx3qZq{?G zqGN`R4FaT7=Fw(~Q6_`T3{^8!{dCK3q($`fACFN(Qw%yT!1{i*yt}hk->z1GlxwAE zvwAROz;eNyacqpW3s8?haOXS^ekVwhBtWHfh;4r)%Zl)OwVwZWh7tP5slD#`Ss5s0@`(y?S)mZXVQY5U6+Co#QZvQckSc7KU0m zXtqFhimnTT^YM6GhFbXqhlb>8y8QpJ;PA`5U1@3Dgn&uaq~YC5EI4?g%5{UQrVIgZ zUs{xmo-*b9RL6T diff --git a/sources/PRINTFN b/sources/PRINTFN index 607bce7ab..093440e25 100644 --- a/sources/PRINTFN +++ b/sources/PRINTFN @@ -1,11 +1,9 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "27-Jun-2021 23:29:20"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;16 13154 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED " 8-Aug-2021 15:15:00"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;18 13138 - changes to%: (FNS PFCOPYBYTES) - - previous date%: "22-Jun-2021 10:48:42" -{DSK}kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;14) + previous date%: " 8-Aug-2021 14:52:38" +{DSK}kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;17) (* ; " @@ -29,20 +27,140 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ -(PF [NLAMBDA FN (* ; "Edited 4-Apr-2018 11:13 by rmk:") (* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS. That might not help, if FUNCTIONS are not included in the filemap.") (* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files") (* ;; "If FN is NIL, prints the function named by LASTWORD") (* ;; "If FN is a list, then extra args are interpreted as:") (* ;; " OUTPUT FILE") (* ;; "...") (RESETLST (PROG (OUT OTHERARGS IFILES) (SETQ FN (NLAMBDA.ARGS FN)) (* ; "Grab the args as a list") [COND ((LISTP FN) (* ;  "If it's a list, take the first element as the function name.") (SETQ OTHERARGS (CDR FN)) (SETQ FN (CAR FN] (COND (FN (* ; "FN name specified; use it.") (SETQ LASTWORD FN)) (T (* ; "Not specified, use LASTWORD") (SETQ FN LASTWORD))) [SETQ IFILES (OR (CAR OTHERARGS) (APPEND (WHEREIS FN 'FNS T) (WHEREIS FN 'FUNCTIONS T] [RESETSAVE (OUTPUT (COND ((CADR OTHERARGS) (* ;  "An output file was specified; if not open for output, open it.") (OR (OPENP (CADR OTHERARGS) 'OUTPUT) (WINDOWP (CADR OTHERARGS)) (PROGN [RESETSAVE (SETQ OUT (OPENFILE (CADR OTHERARGS) 'OUTPUT)) '(PROGN (CLOSEF? OLDVALUE] OUT))) (T (* ; "otherwise, use primary output.") T] (* ; "skip compiled files") (FOR FILE INSIDE IFILES UNLESS (MEMB (FILENAMEFIELD FILE 'EXTENSION) *COMPILED-EXTENSIONS*) DO (PRINTFN FN FILE))))]) +(PF + [NLAMBDA FN (* ; "Edited 4-Apr-2018 11:13 by rmk:") + + (* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS. That might not help, if FUNCTIONS are not included in the filemap.") + + (* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files") -(PF* [NLAMBDA FN (* ; "Edited 10-Jun-87 11:09 by jds") (* ;;; "Print the function FN (or LASTWORD), with comments visible to the user.") (RESETVARS (**COMMENT**FLG) (APPLY (FUNCTION PF) FN]) + (* ;; "If FN is NIL, prints the function named by LASTWORD") -(PMORE [LAMBDA NIL (* lmm " 9-AUG-78 17:21") (* lmm "17-MAY-78 15:38") (PRINTFNDEF (CAR LASTFNDEF) T (CADDR LASTFNDEF) -1 (CADDDR LASTFNDEF]) + (* ;; "If FN is a list, then extra args are interpreted as:") -(PRINTFN [LAMBDA (FN FROMFILE TOFILE) (* lmm "14-Aug-84 14:16") (PROG ((LOC (FINDFNDEF FN FROMFILE))) (COND ((LISTP LOC) (SETQ LASTFNDEF LOC) (PRINTFNDEF (CAR LOC) TOFILE (CADR LOC) (CADDR LOC) (CADDDR LOC)) (RETURN FN)) ((EQ LOC 'FILE.NOT.FOUND) (printout TOFILE "file " FROMFILE " not found." T)) (T (printout TOFILE FN " not found on " LOC "." T]) + (* ;; " OUTPUT FILE") -(PRINTFNDEF [LAMBDA (SRCFIL DSTFIL START END TYPE) (* bvm%: " 9-Sep-86 15:54") (RESETLST (PROG (TEM) [COND ((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T)) (SETQ DSTFIL TEM)) (T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT)) '(PROGN (CLOSEF? OLDVALUE] [COND ((SETQ TEM (GETSTREAM SRCFIL 'INPUT T)) (RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM))) (SETQ SRCFIL TEM)) (T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT)) '(PROGN (CLOSEF? OLDVALUE] (PRIN1 "{from " DSTFIL) (PRIN2 (FULLNAME SRCFIL) DSTFIL T) (PRIN1 "} " DSTFIL)) (COND ((OR (NOT (DISPLAYP DSTFIL)) (EQ PFDEFAULT 'COPYBYTES) (EQ TYPE 'MAC)) (COPYBYTES SRCFIL DSTFIL START END)) (T (PFCOPYBYTES SRCFIL DSTFIL START END PFDEFAULT))) (TERPRI DSTFIL))]) + (* ;; "...") -(FINDFNDEF [LAMBDA (FN FROMFILE) (* bvm%: "27-Aug-86 16:27") (* * "Locates FNS definition of FN on FROMFILE. If found, returns a list (file start end type); if file not found, returns symbol FILE.NOT.FOUND; if file found but not fn, returns full name of file that was found") (LET (FULL MAP VALUE) (COND ((NOT (SETQ FULL (FINDFILE FROMFILE T))) 'FILE.NOT.FOUND) [(COND ((SETQ MAP (OR (GETFILEMAP FULL) (LOADFILEMAP FULL))) (* First clause is quick check when the file already has a map.  LOADFILEMAP will find file map, rebuild if necessary and rewrite it on file if  updatemapflg is T.) (AND (for GROUP in (CDR MAP) thereis (SETQ VALUE (FASSOC FN GROUP))) (LIST FULL (CADR VALUE) (CDDR VALUE) 'MAP] (T FULL]) + (RESETLST + (PROG (OUT OTHERARGS IFILES) + (SETQ FN (NLAMBDA.ARGS FN)) (* ; "Grab the args as a list") + [COND + ((LISTP FN) (* ; + "If it's a list, take the first element as the function name.") + (SETQ OTHERARGS (CDR FN)) + (SETQ FN (CAR FN] + (COND + (FN (* ; "FN name specified; use it.") + (SETQ LASTWORD FN)) + (T (* ; "Not specified, use LASTWORD") + (SETQ FN LASTWORD))) + [SETQ IFILES (OR (CAR OTHERARGS) + (APPEND (WHEREIS FN 'FNS T) + (WHEREIS FN 'FUNCTIONS T] + [RESETSAVE (OUTPUT (COND + ((CADR OTHERARGS) (* ; + "An output file was specified; if not open for output, open it.") + (OR (OPENP (CADR OTHERARGS) + 'OUTPUT) + (WINDOWP (CADR OTHERARGS)) + (PROGN [RESETSAVE (SETQ OUT (OPENFILE (CADR OTHERARGS) + 'OUTPUT)) + '(PROGN (CLOSEF? OLDVALUE] + OUT))) + (T (* ; "otherwise, use primary output.") + T] (* ; "skip compiled files") + (FOR FILE INSIDE IFILES UNLESS (MEMB (FILENAMEFIELD FILE 'EXTENSION) + *COMPILED-EXTENSIONS*) + DO (PRINTFN FN FILE))))]) + +(PF* + [NLAMBDA FN (* ; "Edited 10-Jun-87 11:09 by jds") + +(* ;;; "Print the function FN (or LASTWORD), with comments visible to the user.") + + (RESETVARS (**COMMENT**FLG) + (APPLY (FUNCTION PF) + FN]) + +(PMORE + [LAMBDA NIL (* lmm " 9-AUG-78 17:21") + (* lmm "17-MAY-78 15:38") + (PRINTFNDEF (CAR LASTFNDEF) + T + (CADDR LASTFNDEF) + -1 + (CADDDR LASTFNDEF]) + +(PRINTFN + [LAMBDA (FN FROMFILE TOFILE) (* lmm "14-Aug-84 14:16") + (PROG ((LOC (FINDFNDEF FN FROMFILE))) + (COND + ((LISTP LOC) + (SETQ LASTFNDEF LOC) + (PRINTFNDEF (CAR LOC) + TOFILE + (CADR LOC) + (CADDR LOC) + (CADDDR LOC)) + (RETURN FN)) + ((EQ LOC 'FILE.NOT.FOUND) + (printout TOFILE "file " FROMFILE " not found." T)) + (T (printout TOFILE FN " not found on " LOC "." T]) + +(PRINTFNDEF + [LAMBDA (SRCFIL DSTFIL START END TYPE) (* bvm%: " 9-Sep-86 15:54") + (RESETLST + (PROG (TEM) + [COND + ((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T)) + (SETQ DSTFIL TEM)) + (T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT)) + '(PROGN (CLOSEF? OLDVALUE] + [COND + ((SETQ TEM (GETSTREAM SRCFIL 'INPUT T)) + (RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM))) + (SETQ SRCFIL TEM)) + (T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT)) + '(PROGN (CLOSEF? OLDVALUE] + (PRIN1 "{from " DSTFIL) + (PRIN2 (FULLNAME SRCFIL) + DSTFIL T) + (PRIN1 "} +" DSTFIL)) + (COND + ((OR (NOT (DISPLAYP DSTFIL)) + (EQ PFDEFAULT 'COPYBYTES) + (EQ TYPE 'MAC)) + (COPYBYTES SRCFIL DSTFIL START END)) + (T (PFCOPYBYTES SRCFIL DSTFIL START END PFDEFAULT))) + (TERPRI DSTFIL))]) + +(FINDFNDEF + [LAMBDA (FN FROMFILE) (* bvm%: "27-Aug-86 16:27") + + (* * "Locates FNS definition of FN on FROMFILE. If found, returns a list (file start end type); if file not found, returns symbol FILE.NOT.FOUND; if file found but not fn, returns full name of file that was found") + + (LET (FULL MAP VALUE) + (COND + ((NOT (SETQ FULL (FINDFILE FROMFILE T))) + 'FILE.NOT.FOUND) + [(COND + ((SETQ MAP (OR (GETFILEMAP FULL) + (LOADFILEMAP FULL))) + + (* First clause is quick check when the file already has a map. + LOADFILEMAP will find file map, rebuild if necessary and rewrite it on file if + updatemapflg is T.) + + (AND (for GROUP in (CDR MAP) thereis (SETQ VALUE (FASSOC FN GROUP))) + (LIST FULL (CADR VALUE) + (CDDR VALUE) + 'MAP] + (T FULL]) (PFCOPYBYTES - [LAMBDA (SRCFIL DSTFIL START END FLG) (* ; "Edited 27-Jun-2021 23:29 by rmk:") + [LAMBDA (SRCFIL DSTFIL START END FLG) (* ; "Edited 8-Aug-2021 14:51 by rmk:") (* ; "Edited 24-Mar-93 14:16 by rmk:") (* lmm "28-Sep-86 14:38") @@ -91,7 +209,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation. (EOFP SSTRM)) (* ; "We copied the whole file") (TERPRI DSTRM)) (RETURN T))) - (SETQ CHARCODE (\INCCODE.EOLC SSTRM '%#CHARS ANY.EOLC %#CHARS)) + (SETQ CHARCODE (\INCCODE.EOLC SSTRM ANY.EOLC '%#CHARS %#CHARS)) (IF (EQ CHARCODE (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR))) THEN @@ -106,7 +224,11 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation. ELSE (\OUTCHAR DSTRM CHARCODE)) (GO LP)))]) -(DISPLAYP [LAMBDA (STREAM) (* AJB "23-Sep-85 14:53") (LET ((STRM (\OUTSTREAMARG STREAM T))) (AND STRM (OR (DISPLAYSTREAMP STRM) (IMAGESTREAMTYPEP STRM 'TEXT]) +(DISPLAYP + [LAMBDA (STREAM) (* AJB "23-Sep-85 14:53") + (LET ((STRM (\OUTSTREAMARG STREAM T))) + (AND STRM (OR (DISPLAYSTREAMP STRM) + (IMAGESTREAMTYPEP STRM 'TEXT]) ) (RPAQ? PFDEFAULT NIL) @@ -163,7 +285,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation. ) (PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1113 11032 (PF 1123 . 3818) (PF* 3820 . 4114) (PMORE 4116 . 4435) (PRINTFN 4437 . 5028) - (PRINTFNDEF 5030 . 6147) (FINDFNDEF 6149 . 7173) (PFCOPYBYTES 7175 . 10782) (DISPLAYP 10784 . 11030)) + (FILEMAP (NIL (1097 11016 (PF 1107 . 3802) (PF* 3804 . 4098) (PMORE 4100 . 4419) (PRINTFN 4421 . 5012) + (PRINTFNDEF 5014 . 6131) (FINDFNDEF 6133 . 7157) (PFCOPYBYTES 7159 . 10766) (DISPLAYP 10768 . 11014)) ))) STOP diff --git a/sources/PRINTFN.LCOM b/sources/PRINTFN.LCOM index c3ab70755207717ded71a078ab079c3935e5ec6c..da21f6928db39699a14b6b5d5f14e94cf4093e5f 100644 GIT binary patch delta 434 zcmX@2xkFP;!^PFj)6Z4c&C|zK*VE6%vvaT}mj+0ubC9cJh^vc&l7fYJb6 zHL)@^vNE=qSm?}XzFCH;iHALhIh_FrHZSE%Wn{G6%q?)4k&$cieZe#!=_Ujs*9yf0 zNnT+PyF^$K=%kfHIm~llKYh0`%=co&DuJ?EZ#9`8+j7X?8hx?z!sZkQxuSh@|zE>ShAW=#Uf zuqbg&!*kF$cyJ~Lgt;uo1e9oia4K>&Y)5bmOMv4FPAfPz9(hkmk#UKCPKqg5R$^%c zm7ZViJan5azXkz+)a~`p6>#*N?Ub@5N<3(`0qI54gvI@6G>V{B9kaplan>Local>medley3.5>git-medley>sources>XCCS.;37 13678 +(FILECREATED " 8-Aug-2021 12:56:55" {DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;44 13384 - changes to%: (FNS \CREATE.XCCS.EXTERNALFORMAT) + changes to%: (FNS \XCCSOUTCHAR) - previous date%: "24-Jun-2021 23:15:05" -{DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;36) + previous date%: " 6-Aug-2021 15:57:41" +{DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;43) (PRETTYCOMPRINT XCCSCOMS) @@ -35,14 +35,16 @@ (DEFINEQ (\XCCSINCCODE - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 21-Jun-2021 15:44 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 15:57 by rmk:") (* ;;; "Returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8.") -(* ;;; "If BYTECOUNTVAR is non-NIL, it is freely incremented by number of bytes read. If BYTECOUNTVAL is given it is the current value, saves the call to EVAL.") +(* ;;; +"If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.") (* ;;; "This doesn't do EOL conversion, \INCHAR does that") + (DECLARE (USEDFREE *BYTECOUNTER*)) (LET (NUMBYTES (CSET (ACCESS-CHARSET STREAM)) (CHAR (\BIN STREAM))) (* ;  "Error on EOF unless ENDOFSTREAMOP does something else.") @@ -83,7 +85,7 @@ (* ;; "Runcoded CSET and CHAR") (SETQ NUMBYTES 1)) - (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL NUMBYTES))) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* NUMBYTES)) (CL:WHEN CHAR (* ;  "Typically NIL if ENDOFSTREAMOP returned NIL at EOF ") (LOGOR (UNFOLD CSET 256) @@ -143,12 +145,13 @@ CHAR)))]) (\XCCSOUTCHAR - [LAMBDA (STREAM CHARCODE) (* ; "Edited 21-Jun-2021 13:28 by rmk:") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-Aug-2021 12:56 by rmk:") (* ;; "Closed function for the :XCCS external format, also called when :XCCS is the default") (COND ((EQ CHARCODE (CHARCODE EOL)) + (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) [COND [(NOT (\RUNCODED STREAM)) (* ;  "Charset is a constant 0, we put out the high-order byte.") @@ -163,9 +166,10 @@ (* ;; "We are now in the right charset (0) for the first EOL byte. For CRLF, the CR is immediately followed by the LF byte, without the prefix 0 byte even if not runcoded, i.e. the 2 bytes are though of as a composite. The stream is left in CSET0 (the freplace above), read for another shift according to the next shift in a runcoded file.") - (\BOUTEOL STREAM) - (freplace CHARPOSITION of STREAM with 0)) - (T [COND + (\BOUTEOL STREAM)) + (T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) + (ADD1 DATUM)) + (COND ((NOT (\RUNCODED STREAM)) (\BOUT STREAM (\CHARSET CHARCODE)) (\BOUT STREAM (\CHAR8CODE CHARCODE))) @@ -176,15 +180,11 @@ (\BOUT STREAM (freplace (STREAM CHARSET) of STREAM with (\CHARSET CHARCODE)) ) - (\BOUT STREAM (\CHAR8CODE CHARCODE] - (freplace CHARPOSITION of STREAM with (PROGN - (* ; "Ugh. Don't overflow") - (IPLUS16 (ffetch CHARPOSITION - of STREAM) - 1]) + (\BOUT STREAM (\CHAR8CODE CHARCODE]) (\XCCSBACKCCODE - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 10:26 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 15:53 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) (CL:WHEN (\BACKFILEPTR STREAM) (* ;; "The immediately preceding byte must be a character byte. If it is a byte in a runcode, then we are done, even if the byte before is part of a shift sequence.") @@ -193,14 +193,14 @@ (* ;; "If we can't back up, we are already at the beginning.") - [COND - [(EQ \NORUNCODE (ACCESS-CHARSET STREAM)) - (COND - ((\BACKFILEPTR STREAM) - (AND BYTECOUNTVAR (SET BYTECOUNTVAR (IPLUS BYTECOUNTVAL 2))) - T) - (BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL] - (BYTECOUNTVAR (SET BYTECOUNTVAR (ADD1 BYTECOUNTVAL])]) + (IF (EQ \NORUNCODE (ACCESS-CHARSET STREAM)) + THEN (IF (\BACKFILEPTR STREAM) + THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) + T + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)) + ELSEIF COUNTP + THEN (SETQ *BYTECOUNTER* -1)))]) (\XCCSFORMATBYTESTREAM [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 16:47 by rmk:") @@ -290,8 +290,8 @@ (\CREATE.XCCS.EXTERNALFORMAT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1333 1562 (ACCESS-CHARSET 1343 . 1560)) (1563 10693 (\XCCSINCCODE 1573 . 4385) ( -\XCCSPEEKCCODE 4387 . 6923) (\XCCSOUTCHAR 6925 . 9463) (\XCCSBACKCCODE 9465 . 10364) ( -\XCCSFORMATBYTESTREAM 10366 . 10691)) (10694 11250 (\CREATE.XCCS.EXTERNALFORMAT 10704 . 11248)) (11251 - 12082 (\NSIN.24BITENCODING.ERROR 11261 . 12080))))) + (FILEMAP (NIL (1318 1547 (ACCESS-CHARSET 1328 . 1545)) (1548 10399 (\XCCSINCCODE 1558 . 4330) ( +\XCCSPEEKCCODE 4332 . 6868) (\XCCSOUTCHAR 6870 . 9085) (\XCCSBACKCCODE 9087 . 10070) ( +\XCCSFORMATBYTESTREAM 10072 . 10397)) (10400 10956 (\CREATE.XCCS.EXTERNALFORMAT 10410 . 10954)) (10957 + 11788 (\NSIN.24BITENCODING.ERROR 10967 . 11786))))) STOP diff --git a/sources/XCCS.LCOM b/sources/XCCS.LCOM index 9c87b891d162078097d3d02fa3f7dd674d70fde2..6da816b4e6d4f5bc4f40c855304c0d8bde194308 100644 GIT binary patch delta 807 zcmZ`$O=}ZT6rGvIR40i>MWMEq%ZOzr*f1|MlaHa)d5sgAHf?H>qCytdNvzSNDg6*P zQgG9S3o8#41egASw)-v>skjw)8r`|bQW1=Ird3iu9>aNO?z!{kp7Wj!Jm}x3o=gtY z)%oF=8Y4hrrV+>I@xA<-t}7rxm#C&pLo;J332rP^on~XPRDQ3)z@EBM_%j@ArG5#>xaXQvDH8CtS09qihl&R`9G zw4m!C5=~3$us;B-G;szwGhI9|hysgC)w{Lk>azD^Y>^<|<=8NdgsBq=MAqa-1YKhj z!ov_TQZNHLP?Z=-_E8wph>?IS5J=}|r%N+PRVbDUHl2bD#33?vtz>(WU5F^aJ@@mR zz^tA}$JnG3+?m++XFp7Q3Uf01(lf}5EZ|G{L|GBHGQM3tydiL$Ka)94p-Q!yz<|9hqc$f^?IkhdCHfn79&@rhtJ|ZPSKp9pvTv{Ql(NPTN2rDA_R&Vi5pef=J11{_@4X^mjz!U7 z>E9UWSAaEV=exQu_K5!F}1|7r~!70RVp@E=+OOy*U^zuc(cEIvT=mKKR!zUpX O`AZMKhRz=HjQs?vsnEOt delta 914 zcmb7CO-$2Z81A|;L)m9QjD`U6W-6{mW`EYL>>%yRh#i9&w)qn|fa}0P1;UTvU_xR{ zICxM~jnTxDUc8Zwn<2XyLnLavXu`!HN0TMq#dlqY9Ju%$o<8s2_rCA<^nUxxj>q{{ zzDHe}>=8JD2SJST;ix1(Sx#|cgayCI^(2-x&%|IkE25etnpqP73rlIb%(5}n+C(mkGKjt`9b8ojE|KOee{B_07+4Abu z=_3M+#!}e~@L|5rLY%{TWrxVU4w33fsFq#Fk^s;1&TD}r*V(=g6Ie2OUDMJrRU6c_ zRKKr3w2N$tFO2|gnG0k@F|LCYMxgrieu8>>_rRBs!== Date: Mon, 9 Aug 2021 23:37:52 -0700 Subject: [PATCH 2/5] 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. --- sources/AOFD | 88 ++++++++++++++++++++++++++++------------------ sources/AOFD.LCOM | Bin 14423 -> 14404 bytes 2 files changed, 54 insertions(+), 34 deletions(-) diff --git a/sources/AOFD b/sources/AOFD index 8815445b1..d4d64b753 100644 --- a/sources/AOFD +++ b/sources/AOFD @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 8-Aug-2021 00:11:00" {DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;3 36869 +(FILECREATED " 9-Aug-2021 23:30:19" {DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;5 38301 - changes to%: (FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT) - (VARS AOFDCOMS) + changes to%: (VARS AOFDCOMS) + (FNS \STRINGSTREAM.INIT) - previous date%: "13-Jun-2021 11:35:32" -{DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;2) + previous date%: " 8-Aug-2021 00:11:00" +{DSK}kaplan>Local>medley3.5>git-medley>sources>AOFD.;4) (* ; " @@ -38,11 +38,13 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD (P (\BASEBYTES.IO.INIT))) (FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT) (P (MAKE-STRING-FORMAT))) - [COMS - (* ;; "STREAM interface for old-style strings") + (COMS + (* ;; "STREAM interface for old-style strings. However (RMK), it appears never to be used, and even commonlisp string-streams are created using the Interlisp OPENSTRINGSTREAM above. For now, keep the function, but don't execute it") (FNS \STRINGSTREAM.INIT) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT] + + (* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))") +) (COMS (FNS GETSTREAM \ADDOFD \CLEAROFD \DELETEOFD \GETSTREAM \SEARCHOPENFILES) (DECLARE%: DONTCOPY (EXPORT (MACROS \INSTREAMARG \OUTSTREAMARG \STREAMARG))) (MACROS GETOFD \GETOFD)) @@ -606,12 +608,25 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. -(* ;; "STREAM interface for old-style strings") +(* ;; +"STREAM interface for old-style strings. However (RMK), it appears never to be used, and even commonlisp string-streams are created using the Interlisp OPENSTRINGSTREAM above. For now, keep the function, but don't execute it" +) (DEFINEQ (\STRINGSTREAM.INIT - [LAMBDA NIL (* bvm%: "14-Feb-85 00:25") + [LAMBDA NIL (* ; "Edited 9-Aug-2021 23:30 by rmk:") + + (* ;; "RMK: This is described as creating a file device for %"old style%" strings. But the variable that it sets is never referenced. The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.") + + (* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions. ") + + (* ;; "Finally, this appears to be read only. No BOUT is provided.") + + (* ;; "") + + (* ;; " In sum: this is a candidate for removal.") + (SETQ \STRINGSTREAM.FDEV (create FDEV DEVICENAME _ 'STRING CLOSEFILE _ (FUNCTION NILL) @@ -624,7 +639,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. HOSTNAMEP _ (FUNCTION NILL) OPENFILE _ (FUNCTION NILL) READPAGES _ (FUNCTION \ILLEGAL.DEVICEOP) - REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV + REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM) STREAM] SETFILEINFO _ (FUNCTION NILL) @@ -633,13 +648,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. BIN _ [FUNCTION (LAMBDA (STREAM) (replace F2 of STREAM with (COND - ((fetch F1 of STREAM) - (PROG1 (fetch F1 of STREAM) - (replace F1 of STREAM - with NIL))) - ((GNCCODE (fetch FULLFILENAME - of STREAM))) - (T (\EOF.ACTION STREAM] + ((fetch F1 of STREAM) + (PROG1 (fetch F1 + of STREAM) + (replace F1 + of STREAM + with NIL))) + ((GNCCODE (fetch + FULLFILENAME + of STREAM))) + (T (\EOF.ACTION STREAM] PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG) (OR (fetch F1 of STREAM) (CHCON1 (fetch FULLFILENAME @@ -650,17 +668,19 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. (NOT (EOFP STREAM] BACKFILEPTR _ [FUNCTION (LAMBDA (STREAM) (replace F1 of STREAM - with (fetch F2 of STREAM] + with (fetch F2 of STREAM + ] EOFP _ (FUNCTION (LAMBDA (STREAM) (AND (NOT (fetch F1 of STREAM)) (EQ (NCHARS (fetch FULLFILENAME of STREAM)) 0]) ) -(DECLARE%: DONTEVAL@LOAD DOCOPY -(\STRINGSTREAM.INIT) -) + + +(* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))") + (DEFINEQ (GETSTREAM @@ -784,16 +804,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation. ) (PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2412 3519 (\ADD-OPEN-STREAM 2422 . 2699) (\GENERIC-UNREGISTER-STREAM 2701 . 3517)) ( -3560 10817 (CLOSEALL 3570 . 4275) (CLOSEF 4277 . 5473) (EOFCLOSEF 5475 . 5771) (INPUT 5773 . 6545) ( -OPENP 6547 . 6946) (OUTPUT 6948 . 7722) (POSITION 7724 . 8536) (RANDACCESSP 8538 . 9013) (\IOMODEP -9015 . 9652) (WHENCLOSE 9654 . 10815)) (10818 10940 (STREAMADDPROP 10828 . 10938)) (12104 24985 ( -\BASEBYTES.IO.INIT 12114 . 15310) (\MAKEBASEBYTESTREAM 15312 . 18624) (\MBS.OUTCHARFN 18626 . 19014) ( -\BASEBYTES.NAME.FROM.STREAM 19016 . 19479) (\BASEBYTES.BOUT 19481 . 20198) (\BASEBYTES.SETFILEPTR -20200 . 20821) (\BASEBYTES.READP 20823 . 21459) (\BASEBYTES.BIN 21461 . 21992) (\BASEBYTES.PEEKBIN -21994 . 22825) (\BASEBYTES.TRUNCATEFN 22827 . 23331) (\BASEBYTES.OPENFN 23333 . 23823) ( -\BASEBYTES.BLOCKIO 23825 . 24983)) (25108 28417 (OPENSTRINGSTREAM 25118 . 26835) (MAKE-STRING-FORMAT -26837 . 28415)) (28500 32136 (\STRINGSTREAM.INIT 28510 . 32134)) (32198 35770 (GETSTREAM 32208 . 32431 -) (\ADDOFD 32433 . 32720) (\CLEAROFD 32722 . 33003) (\DELETEOFD 33005 . 33156) (\GETSTREAM 33158 . -35322) (\SEARCHOPENFILES 35324 . 35768))))) + (FILEMAP (NIL (2615 3722 (\ADD-OPEN-STREAM 2625 . 2902) (\GENERIC-UNREGISTER-STREAM 2904 . 3720)) ( +3763 11020 (CLOSEALL 3773 . 4478) (CLOSEF 4480 . 5676) (EOFCLOSEF 5678 . 5974) (INPUT 5976 . 6748) ( +OPENP 6750 . 7149) (OUTPUT 7151 . 7925) (POSITION 7927 . 8739) (RANDACCESSP 8741 . 9216) (\IOMODEP +9218 . 9855) (WHENCLOSE 9857 . 11018)) (11021 11143 (STREAMADDPROP 11031 . 11141)) (12307 25188 ( +\BASEBYTES.IO.INIT 12317 . 15513) (\MAKEBASEBYTESTREAM 15515 . 18827) (\MBS.OUTCHARFN 18829 . 19217) ( +\BASEBYTES.NAME.FROM.STREAM 19219 . 19682) (\BASEBYTES.BOUT 19684 . 20401) (\BASEBYTES.SETFILEPTR +20403 . 21024) (\BASEBYTES.READP 21026 . 21662) (\BASEBYTES.BIN 21664 . 22195) (\BASEBYTES.PEEKBIN +22197 . 23028) (\BASEBYTES.TRUNCATEFN 23030 . 23534) (\BASEBYTES.OPENFN 23536 . 24026) ( +\BASEBYTES.BLOCKIO 24028 . 25186)) (25311 28620 (OPENSTRINGSTREAM 25321 . 27038) (MAKE-STRING-FORMAT +27040 . 28618)) (28892 33553 (\STRINGSTREAM.INIT 28902 . 33551)) (33630 37202 (GETSTREAM 33640 . 33863 +) (\ADDOFD 33865 . 34152) (\CLEAROFD 34154 . 34435) (\DELETEOFD 34437 . 34588) (\GETSTREAM 34590 . +36754) (\SEARCHOPENFILES 36756 . 37200))))) STOP diff --git a/sources/AOFD.LCOM b/sources/AOFD.LCOM index 6f9a72e571ab1ebc557b563a8cdd253cb080c626..a471bc3b583953a48dc27c2d9dfff7f3a98d010e 100644 GIT binary patch delta 845 zcmZ`%J#W)c6jdsaDi5e7w1Oehl~EcyAC{k8=fg!H<2bEF;#77D0}MFHqqS&k%OCv^ z5?v8u0KF0M3y@f{ASNW>2QVS=D_GfhNmC^ZUF@TC?tS;@-t#N`9=^rdMny~aE0QQ7 zkYrUBRn&NQ(iIdQSg6l6q^PK_qACmh2oHi$=pEuAF!&^l;=D@SQuZ-;KCrF5b{k;f zQ9%$`7`h3qW*2!;R7F`uHI`?%mf1FR+t7MO^Z%j?N2IuPx2OOk*JTmG;K23waSTb2 zSAlz|*$!ykR#WeG93HrqaqUQqS*hIC~{y}ZS6NCBruops;>P`lHHbuubc7GGE=p9|GV3%a}|$LVy2 z%iTDiamt}gk$mKSkW>C1$*<bZY>H^c<>rqOo&8ks-uIW2;mB!T`NMeKhEM-Zylv_0&!RiXO zW;HckHymeotd$;R&i((X6vp4mZ8^z#H z`6PfohBU^*GPwQ_DCq+Y)F|)|y*Pw8i9CP5LVwsD#o$I51{6;6lg3nm9;vKl-m!EFg4N&BJhLbGCapPoOV4+{Xyadei`~{0>i*BB!ExwAWbm! t$ujfsT&J)ITU)?#O+#;Mwvi|A6|}+%2q delta 775 zcmZXSOK;Oa5XWT%Qe-KpRg?;$N*x)su|sXyyK!FPvb8tC)Q{A5n@bLqHfkb4615En zB#1chkm#Y+9{B>CIFLIh_y~v#d`+&<_(8gw7F4?#TW?Dvk^C+k%R8q|;C(DCd1ONj>_ z*{14@sI?&UNDSQ`NVQ$pg~iUArb%$Pf6Ch>iZ?GM4J;|5TytD%@wPFw*$?5y#hW{u z7(`qw7b`IL0H=L!L$3MJ|6bTmAzRubVFV?WzTZ%Bx_t|f9I?TC{4khtP4%{O8zW#n61>=_a(yKDNCcYjIjx=I`wJj zSXxMZ;?c=K0HY#sOD@uPrAR=dxB{)A7@MQ{Z#si`Z0i<3G30QtYgdOGygIBHurIp3jIpwyEWk hkg~U?ah?B8);@b5;`p2SURZ7|zE{oh9rm*H@h_j+(n Date: Fri, 13 Aug 2021 18:26:59 -0700 Subject: [PATCH 3/5] TTYIN: Fix an ancient coding error but still doesn't solve the (DIRECTORY ?= problem #402 --- sources/TTYIN | 136 ++++++++++++++++++++++----------------------- sources/TTYIN.LCOM | Bin 72724 -> 72735 bytes 2 files changed, 67 insertions(+), 69 deletions(-) diff --git a/sources/TTYIN b/sources/TTYIN index 3e9f34dc1..7afc23058 100644 --- a/sources/TTYIN +++ b/sources/TTYIN @@ -1,10 +1,10 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Jun-2021 10:11:51" {DSK}kaplan>Local>medley3.5>git-medley>sources>TTYIN.;5 329054 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) +(FILECREATED "13-Aug-2021 11:07:59" {DSK}kaplan>Local>medley3.5>git-medley>sources>TTYIN.;7 329042 - changes to%: (MACROS AT.START.OF.LINE EMPTY.LINE) + changes to%: (FNS TTYIN.SCRATCHFILE) - previous date%: "13-Jun-2021 10:04:21" -{DSK}kaplan>Local>medley3.5>git-medley>sources>TTYIN.;3) + previous date%: "13-Jun-2021 10:11:51" +{DSK}kaplan>Local>medley3.5>git-medley>sources>TTYIN.;5) (* ; " @@ -5600,12 +5600,10 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation. (TTYIN.SCRATCHFILE [LAMBDA NIL - (DECLARE (GLOBALVARS TTYINEDIT.SCRATCH)) (* lmm "14-Nov-86 17:05") - [COND - ([OR (NOT TTYINEDIT.SCRATCH) - (NOT (OPENP TTYINEDIT.SCRATCH 'BOTH] - (SETQ TTYINEDIT.SCRATCH (OPENSTREAM '{NODIRCORE} 'BOTH 'OLD/NEW NIL - (CONSTANT (LIST (LIST 'ENDOFSTREAMOP (FUNCTION \TTYIN.RPEOF] + (DECLARE (GLOBALVARS TTYINEDIT.SCRATCH)) (* ; "Edited 13-Aug-2021 11:07 by rmk:") + (CL:UNLESS (AND TTYINEDIT.SCRATCH (OPENP TTYINEDIT.SCRATCH 'BOTH)) + [SETQ TTYINEDIT.SCRATCH (OPENSTREAM '{NODIRCORE} 'BOTH 'OLD/NEW + (CONSTANT (LIST (LIST 'ENDOFSTREAMOP (FUNCTION \TTYIN.RPEOF]) (SETFILEPTR TTYINEDIT.SCRATCH 0) TTYINEDIT.SCRATCH]) @@ -6091,62 +6089,62 @@ DONTEVAL@LOAD EVAL@COMPILE (PUTPROPS TTYIN COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7721 207399 (TTYIN 7731 . 20964) (TTYIN.SETUP 20966 . 24042) (TTYIN.CLEANUP 24044 . -24872) (TTYIN1 24874 . 51392) (TTYIN1RESTART 51394 . 52658) (TTYIN.FINISH 52660 . 62077) ( -TTYIN.BALANCE 62079 . 63205) (ADDCHAR 63207 . 65393) (TTMAKECOMPLEXCHAR 65395 . 65869) (ADDNAKEDCHAR -65871 . 67381) (TTADDTAB 67383 . 68318) (ADJUSTLINE 68320 . 82231) (ADJUSTLINE.AND.RESTORE 82233 . -82671) (AT.END.OF.SCREEN 82673 . 82961) (AT.END.OF.TEXT 82963 . 83418) (AUTOCR? 83420 . 83894) ( -BACKSKREAD 83896 . 88481) (BACKWARD.DELETE.TO 88483 . 88665) (BREAKLINE 88667 . 90934) (BUFTAILP 90936 - . 91254) (CHECK.MARGIN 91256 . 91879) (CLEAR.LINE? 91881 . 92174) (CURRENT.WORD 92176 . 94576) ( -DELETE.TO.END 94578 . 95297) (DELETELINE 95299 . 98256) (DELETETO 98258 . 100080) (DELETETO1 100082 . -101425) (DO.EDIT.COMMAND 101427 . 118746) (DO.EDIT.PP 118748 . 121410) (TTDOTABS 121412 . 122782) ( -EDITCOLUMN 122784 . 123240) (EDITNUMBERP 123242 . 123473) (END.DELETE.MODE 123475 . 123992) (ENDREAD? -123994 . 126429) (FIND.LINE 126431 . 127967) (FIND.LINE.BREAK 127969 . 128639) (FIND.MATCHING.QUOTE -128641 . 129486) (FIND.NEXT.WORD 129488 . 130867) (FIND.NON.SPACE 130869 . 131142) (FIND.START.OF.WORD - 131144 . 131507) (FORWARD.DELETE.TO 131509 . 133731) (GO.TO.ADDRESSING 133733 . 134689) ( -GO.TO.FREELINE 134691 . 135272) (GO.TO.RELATIVE 135274 . 136054) (INIT.CURSOR 136056 . 136953) ( -INSERT.NODE 136955 . 137477) (INSERTLINE 137479 . 138983) (KILL.LINES 138985 . 139523) (KILLSEGMENT -139525 . 140648) (L-CASECODE 140650 . 140811) (MOVE.BACK.TO 140813 . 141042) (MOVE.FORWARD.TO 141044 - . 141465) (MOVE.TO.LINE 141467 . 142382) (MOVE.TO.NEXT.LINE 142384 . 142654) (MOVE.TO.START.OF.WORD -142656 . 143420) (MOVE.TO.WHEREVER 143422 . 143645) (NTH.COLUMN.OF 143647 . 143978) ( -NTH.RELATIVE.COLUMN.OF 143980 . 145280) (OVERFLOW? 145282 . 146230) (OVERFLOWLINE? 146232 . 146558) ( -PREVLINE 146560 . 147740) (PREVWORD 147742 . 149883) (PROPERTAILP 149885 . 150092) (READFROMBUF 150094 - . 152683) (RENUMBER.LINES 152685 . 153078) (RESTORE.CURSOR 153080 . 153234) (RESTOREBUF 153236 . -155420) (RETYPE.BUFFER 155422 . 157685) (SAVE.CURSOR 157687 . 157859) (SCANBACK 157861 . 159219) ( -SCANFORWARD 159221 . 160089) (SCRATCHCONS 160091 . 160693) (SEGMENT.LENGTH 160695 . 161231) ( -SEGMENT.BIT.LENGTH 161233 . 161840) (SETLASTC 161842 . 162139) (SETTAIL? 162141 . 162957) ( -SHOW.MATCHING.PAREN 162959 . 165459) (SKIP/ZAP 165461 . 167940) (START.NEW.LINE 167942 . 168274) ( -START.OF.PARAGRAPH? 168276 . 168657) (TTADJUSTWORD 168659 . 169833) (TTBIN 169835 . 171041) ( -TTBITWIDTH 171043 . 171192) (TTCRLF 171194 . 171401) (TTCRLF.ACCOUNT 171403 . 172043) (TTDELETECHAR -172045 . 173189) (TTDELETELINE 173191 . 175139) (TTDELETEWORD 175141 . 175809) (TTECHO.TO.FILE 175811 - . 179359) (TTGIVEHELP 179361 . 180626) (TTGIVEHELP1 180628 . 181210) (TTGIVEHELP2 181212 . 181907) ( -TTLASTLINE 181909 . 182277) (TTLOADBUF 182279 . 185793) (TTNEXTLINE 185795 . 186115) (TTNEXTNODE -186117 . 186356) (TTNLEFT 186358 . 187585) (TTNTH 187587 . 188046) (TTNTHLINE 188048 . 188580) ( -TTPRIN1 188582 . 192395) (TTPRINSPACE 192397 . 192790) (TTPRIN1COMMENT 192792 . 193116) (TTPRIN2 -193118 . 195437) (TTPROMPTCHAR 195439 . 196335) (TTRUBOUT 196337 . 197300) (TTUNREADBUF 197302 . -197711) (TTWAITFORINPUT 197713 . 201921) (TTYINSTRING 201923 . 202882) (TYPE.BUFFER 202884 . 204636) ( -U-CASECODE 204638 . 204797) (U/L-CASE 204799 . 207397)) (207554 217267 (TTRATOM 207564 . 208008) ( -TTREADLIST 208010 . 208377) (TTSKIPSEPR 208379 . 208753) (TTSKREAD 208755 . 213395) (TTYIN.READ 213397 - . 217265)) (217314 237358 (FIND.MATCHING.WORD 217324 . 217852) (TTCOMPLETEWORD 217854 . 232282) ( -WORD.MATCHES.BUFFER 232284 . 233844) (TTYIN.SHOW.?ALTERNATIVES 233846 . 237356)) (237392 255702 ( -DO?CMD 237402 . 243304) (TTYIN.PRINTARGS 243306 . 254164) (TTYIN.READ?=ARGS 254166 . 254947) ( -DO?CMD.ERRORHANDLER 254949 . 255700)) (255736 263809 (BEEP 255746 . 255921) (BITBLT.DELETE 255923 . -256570) (BITBLT.ERASE 256572 . 256757) (BITBLT.INSERT 256759 . 257070) (DO.CRLF 257072 . 257391) ( -DO.DELETE.LINES 257393 . 258437) (DO.INSERT.LINE 258439 . 260373) (DO.LF 260375 . 260541) ( -ERASE.TO.END.OF.LINE 260543 . 260868) (ERASE.TO.END.OF.PAGE 260870 . 261475) (INSERT.TEXT 261477 . -261981) (TTDELSECTION 261983 . 262281) (TTADJUSTWIDTH 262283 . 263147) (TTINSERTSECTION 263149 . -263488) (TTSETCURSOR 263490 . 263807)) (263844 268821 (TTYINBUFFERDEVICE 263854 . 265170) ( -TTYINBUFFERSTREAM 265172 . 265934) (TTYINBUFFERBIN 265936 . 266472) (TTYINBUFFERPEEK 266474 . 266952) -(TTYINBUFFERREADP 266954 . 267209) (TTYINBUFFEREOFP 267211 . 267463) (TTYINBUFFERBACKPTR 267465 . -268017) (TTYINWORDRDTBL 268019 . 268819)) (268982 294539 (DO.MOUSE 268992 . 271749) ( -DO.SHIFTED.SELECTION 271751 . 282190) (COPY.SEGMENT 282192 . 282396) (DELETE.LONG.SEGMENT 282398 . -282757) (DELETE.LONG.SEGMENT1 282759 . 285235) (INVERT.LONG.SEGMENT 285237 . 286266) (INVERT.SEGMENT -286268 . 287783) (BRACKET.CURRENT.WORD 287785 . 289319) (TTBEFOREPOS 289321 . 290051) (TTNEXTPOS -290053 . 290761) (TTRACKMOUSE 290763 . 294537)) (294683 299939 (SETREADFN 294693 . 295171) ( -TTYINENTRYFN 295173 . 295598) (TTYINREADP 295600 . 296065) (TTYINREAD 296067 . 297461) (TTYINFIX -297463 . 298662) (CHARMACRO? 298664 . 299231) (TTYINMETA 299233 . 299361) (TTYIN.LASTINPUT 299363 . -299937)) (299940 308209 (TTYINEDIT 299950 . 302067) (SIMPLETEXTEDIT 302069 . 305113) ( -SET.TTYINEDIT.WINDOW 305115 . 306266) (TTYIN.PPTOFILE 306268 . 308207)) (308267 308444 ( -MAKE-TTSCRATCHFILE 308277 . 308442)) (308591 309369 (TTYIN.SCRATCHFILE 308601 . 309060) (\TTYIN.RPEOF -309062 . 309367)) (309581 313214 (TTYINPROMPTFORWORD 309591 . 313212))))) + (FILEMAP (NIL (7722 207400 (TTYIN 7732 . 20965) (TTYIN.SETUP 20967 . 24043) (TTYIN.CLEANUP 24045 . +24873) (TTYIN1 24875 . 51393) (TTYIN1RESTART 51395 . 52659) (TTYIN.FINISH 52661 . 62078) ( +TTYIN.BALANCE 62080 . 63206) (ADDCHAR 63208 . 65394) (TTMAKECOMPLEXCHAR 65396 . 65870) (ADDNAKEDCHAR +65872 . 67382) (TTADDTAB 67384 . 68319) (ADJUSTLINE 68321 . 82232) (ADJUSTLINE.AND.RESTORE 82234 . +82672) (AT.END.OF.SCREEN 82674 . 82962) (AT.END.OF.TEXT 82964 . 83419) (AUTOCR? 83421 . 83895) ( +BACKSKREAD 83897 . 88482) (BACKWARD.DELETE.TO 88484 . 88666) (BREAKLINE 88668 . 90935) (BUFTAILP 90937 + . 91255) (CHECK.MARGIN 91257 . 91880) (CLEAR.LINE? 91882 . 92175) (CURRENT.WORD 92177 . 94577) ( +DELETE.TO.END 94579 . 95298) (DELETELINE 95300 . 98257) (DELETETO 98259 . 100081) (DELETETO1 100083 . +101426) (DO.EDIT.COMMAND 101428 . 118747) (DO.EDIT.PP 118749 . 121411) (TTDOTABS 121413 . 122783) ( +EDITCOLUMN 122785 . 123241) (EDITNUMBERP 123243 . 123474) (END.DELETE.MODE 123476 . 123993) (ENDREAD? +123995 . 126430) (FIND.LINE 126432 . 127968) (FIND.LINE.BREAK 127970 . 128640) (FIND.MATCHING.QUOTE +128642 . 129487) (FIND.NEXT.WORD 129489 . 130868) (FIND.NON.SPACE 130870 . 131143) (FIND.START.OF.WORD + 131145 . 131508) (FORWARD.DELETE.TO 131510 . 133732) (GO.TO.ADDRESSING 133734 . 134690) ( +GO.TO.FREELINE 134692 . 135273) (GO.TO.RELATIVE 135275 . 136055) (INIT.CURSOR 136057 . 136954) ( +INSERT.NODE 136956 . 137478) (INSERTLINE 137480 . 138984) (KILL.LINES 138986 . 139524) (KILLSEGMENT +139526 . 140649) (L-CASECODE 140651 . 140812) (MOVE.BACK.TO 140814 . 141043) (MOVE.FORWARD.TO 141045 + . 141466) (MOVE.TO.LINE 141468 . 142383) (MOVE.TO.NEXT.LINE 142385 . 142655) (MOVE.TO.START.OF.WORD +142657 . 143421) (MOVE.TO.WHEREVER 143423 . 143646) (NTH.COLUMN.OF 143648 . 143979) ( +NTH.RELATIVE.COLUMN.OF 143981 . 145281) (OVERFLOW? 145283 . 146231) (OVERFLOWLINE? 146233 . 146559) ( +PREVLINE 146561 . 147741) (PREVWORD 147743 . 149884) (PROPERTAILP 149886 . 150093) (READFROMBUF 150095 + . 152684) (RENUMBER.LINES 152686 . 153079) (RESTORE.CURSOR 153081 . 153235) (RESTOREBUF 153237 . +155421) (RETYPE.BUFFER 155423 . 157686) (SAVE.CURSOR 157688 . 157860) (SCANBACK 157862 . 159220) ( +SCANFORWARD 159222 . 160090) (SCRATCHCONS 160092 . 160694) (SEGMENT.LENGTH 160696 . 161232) ( +SEGMENT.BIT.LENGTH 161234 . 161841) (SETLASTC 161843 . 162140) (SETTAIL? 162142 . 162958) ( +SHOW.MATCHING.PAREN 162960 . 165460) (SKIP/ZAP 165462 . 167941) (START.NEW.LINE 167943 . 168275) ( +START.OF.PARAGRAPH? 168277 . 168658) (TTADJUSTWORD 168660 . 169834) (TTBIN 169836 . 171042) ( +TTBITWIDTH 171044 . 171193) (TTCRLF 171195 . 171402) (TTCRLF.ACCOUNT 171404 . 172044) (TTDELETECHAR +172046 . 173190) (TTDELETELINE 173192 . 175140) (TTDELETEWORD 175142 . 175810) (TTECHO.TO.FILE 175812 + . 179360) (TTGIVEHELP 179362 . 180627) (TTGIVEHELP1 180629 . 181211) (TTGIVEHELP2 181213 . 181908) ( +TTLASTLINE 181910 . 182278) (TTLOADBUF 182280 . 185794) (TTNEXTLINE 185796 . 186116) (TTNEXTNODE +186118 . 186357) (TTNLEFT 186359 . 187586) (TTNTH 187588 . 188047) (TTNTHLINE 188049 . 188581) ( +TTPRIN1 188583 . 192396) (TTPRINSPACE 192398 . 192791) (TTPRIN1COMMENT 192793 . 193117) (TTPRIN2 +193119 . 195438) (TTPROMPTCHAR 195440 . 196336) (TTRUBOUT 196338 . 197301) (TTUNREADBUF 197303 . +197712) (TTWAITFORINPUT 197714 . 201922) (TTYINSTRING 201924 . 202883) (TYPE.BUFFER 202885 . 204637) ( +U-CASECODE 204639 . 204798) (U/L-CASE 204800 . 207398)) (207555 217268 (TTRATOM 207565 . 208009) ( +TTREADLIST 208011 . 208378) (TTSKIPSEPR 208380 . 208754) (TTSKREAD 208756 . 213396) (TTYIN.READ 213398 + . 217266)) (217315 237359 (FIND.MATCHING.WORD 217325 . 217853) (TTCOMPLETEWORD 217855 . 232283) ( +WORD.MATCHES.BUFFER 232285 . 233845) (TTYIN.SHOW.?ALTERNATIVES 233847 . 237357)) (237393 255703 ( +DO?CMD 237403 . 243305) (TTYIN.PRINTARGS 243307 . 254165) (TTYIN.READ?=ARGS 254167 . 254948) ( +DO?CMD.ERRORHANDLER 254950 . 255701)) (255737 263810 (BEEP 255747 . 255922) (BITBLT.DELETE 255924 . +256571) (BITBLT.ERASE 256573 . 256758) (BITBLT.INSERT 256760 . 257071) (DO.CRLF 257073 . 257392) ( +DO.DELETE.LINES 257394 . 258438) (DO.INSERT.LINE 258440 . 260374) (DO.LF 260376 . 260542) ( +ERASE.TO.END.OF.LINE 260544 . 260869) (ERASE.TO.END.OF.PAGE 260871 . 261476) (INSERT.TEXT 261478 . +261982) (TTDELSECTION 261984 . 262282) (TTADJUSTWIDTH 262284 . 263148) (TTINSERTSECTION 263150 . +263489) (TTSETCURSOR 263491 . 263808)) (263845 268822 (TTYINBUFFERDEVICE 263855 . 265171) ( +TTYINBUFFERSTREAM 265173 . 265935) (TTYINBUFFERBIN 265937 . 266473) (TTYINBUFFERPEEK 266475 . 266953) +(TTYINBUFFERREADP 266955 . 267210) (TTYINBUFFEREOFP 267212 . 267464) (TTYINBUFFERBACKPTR 267466 . +268018) (TTYINWORDRDTBL 268020 . 268820)) (268983 294540 (DO.MOUSE 268993 . 271750) ( +DO.SHIFTED.SELECTION 271752 . 282191) (COPY.SEGMENT 282193 . 282397) (DELETE.LONG.SEGMENT 282399 . +282758) (DELETE.LONG.SEGMENT1 282760 . 285236) (INVERT.LONG.SEGMENT 285238 . 286267) (INVERT.SEGMENT +286269 . 287784) (BRACKET.CURRENT.WORD 287786 . 289320) (TTBEFOREPOS 289322 . 290052) (TTNEXTPOS +290054 . 290762) (TTRACKMOUSE 290764 . 294538)) (294684 299940 (SETREADFN 294694 . 295172) ( +TTYINENTRYFN 295174 . 295599) (TTYINREADP 295601 . 296066) (TTYINREAD 296068 . 297462) (TTYINFIX +297464 . 298663) (CHARMACRO? 298665 . 299232) (TTYINMETA 299234 . 299362) (TTYIN.LASTINPUT 299364 . +299938)) (299941 308210 (TTYINEDIT 299951 . 302068) (SIMPLETEXTEDIT 302070 . 305114) ( +SET.TTYINEDIT.WINDOW 305116 . 306267) (TTYIN.PPTOFILE 306269 . 308208)) (308268 308445 ( +MAKE-TTSCRATCHFILE 308278 . 308443)) (308592 309357 (TTYIN.SCRATCHFILE 308602 . 309048) (\TTYIN.RPEOF +309050 . 309355)) (309569 313202 (TTYINPROMPTFORWORD 309579 . 313200))))) STOP diff --git a/sources/TTYIN.LCOM b/sources/TTYIN.LCOM index feb34ffce38994cabdc9813e4b5ebd8ac3e6a283..0c4b41fb72f218032463ca8799bf2c71b763bbae 100644 GIT binary patch delta 413 zcmbQTgJu2>mI-c#3UY4#LB5V53UU$7&cT{o8g8CGuFgTOjv=lt3QC5?x{jskx<&>@ zh6;v;Rt6SU1`{&_>&-P$r3@^sjDg5ZNg=5yH90@GATuX5MS&|hBQY;MwOG|kAtWTy z(@!thImj`@*#l&QLS~+Vl3S>cj{>q4dU|?F3Mq*tK+PytL(DfZRD!rq0k;FqtxPSI z6eho8wAC?J;4(I{G%ztzfVxAWBp>J$4L84F4EIbv%&5!)^q}eFSB#E~rkiz`F8yTm zoc#Z{w6kJ50}vpHd=QrhM2LfkmIM%)#RVc0K!gB;hMB2Cuxkj&n*kv~3MLkl5sy{j0#pwOQ})GdTb#7HfL| delta 385 zcmbQggJsGNmI-c?9T|lMyh`(QjSP$o6$}lm3=OSJCzc21m})9085-##q%5rrEv-xq zl@yYSQj_y@3o>(3Qxv#TD+-E=Rjm~A@=G!@^U@VE^AwcaLVbJ`koD^6=_x6sB$fa* zpqOc7WMyb-Wo$Xwfl)*lVH3m=K$|B2X0)?V;4(I{G%z($NX|&iOHVCUD9H!fr{U}9 z9ONIY;25G89O4)hqUZ0X=i}+;s^IDy5E2PuPQJjX%xYj_Wn?(9!-3IwvnA7|pN!s< zdHzUCD5o<30fNZL2l07XC)@s!3o=&-b`5d!^l=Rc2~sdMQ1B0M^$QLOa&`1o0EQ5V z7of?jVQ!=l5)uit(8Uwz0_Pyd5N8hsGeazbrlynE{z+ry)le`onJn>FfsuE!<= Date: Fri, 13 Aug 2021 19:38:51 -0700 Subject: [PATCH 4/5] 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 --- sources/FILEIO | 128 ++++++++-------------- sources/FILEIO.LCOM | Bin 49672 -> 49380 bytes sources/LLREAD | 252 ++++++++++++++++++++++++++------------------ sources/LLREAD.LCOM | Bin 25489 -> 25524 bytes sources/XCCS | 30 +++--- sources/XCCS.LCOM | Bin 3458 -> 3550 bytes 6 files changed, 209 insertions(+), 201 deletions(-) diff --git a/sources/FILEIO b/sources/FILEIO index 3c4155b4b..d1e42be77 100644 --- a/sources/FILEIO +++ b/sources/FILEIO @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 8-Aug-2021 14:53:49"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;85 181632 +(FILECREATED "13-Aug-2021 18:39:18"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;87 178368 changes to%: (FNS COPYCHARS) - previous date%: " 8-Aug-2021 14:30:40" -{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;83) + previous date%: " 8-Aug-2021 14:53:49" +{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;86) (* ; " @@ -2453,7 +2453,7 @@ update the map") ]) (COPYCHARS - [LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 8-Aug-2021 14:53 by rmk:") + [LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 13-Aug-2021 18:39 by rmk:") (* ; "Edited 14-Jun-2021 22:08 by rmk:") (* ; "Edited 8-Dec-95 16:38 by rmk:") (* ; "Edited 26-Mar-99 12:13 by rmk:") @@ -2463,13 +2463,15 @@ update the map") [PROG ((SRCSTRM (\GETSTREAM SRCFIL)) (DSTSTRM (\GETSTREAM DSTFIL)) (ACTUALSTART 0) - RAP ACTUALEND EOF SRCEOLC DSTEOLC CH SAMEEXTFORM) - [COND - ([AND (EQ (SETQ SRCEOLC (fetch EOLCONVENTION of SRCSTRM)) - (SETQ DSTEOLC (fetch EOLCONVENTION of DSTSTRM))) - (SETQ SAMEEXTFORM (EQ (FETCH EXTERNALFORMAT OF SRCSTRM) - (FETCH EXTERNALFORMAT OF DSTSTRM] - (RETURN (COPYBYTES SRCSTRM DSTSTRM START END] + RAP ACTUALEND EOF SRCEOLC DSTEOLC CH) + (CL:WHEN (AND (EQ (SETQ SRCEOLC (fetch EOLCONVENTION of SRCSTRM)) + (SETQ DSTEOLC (fetch EOLCONVENTION of DSTSTRM))) + (EQ (FETCH EXTERNALFORMAT OF SRCSTRM) + (FETCH EXTERNALFORMAT OF DSTSTRM))) + (RETURN (COPYBYTES SRCSTRM DSTSTRM START END))) + + (* ;; "Format or EOL convention are different. So first decode the START END specification") + [COND ((SETQ RAP (fetch RANDOMACCESSP of (fetch DEVICE of SRCSTRM))) (SETQ EOF (\GETEOFPTR SRCSTRM] @@ -2492,62 +2494,22 @@ update the map") (T START] (RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM)) (SETQ ACTUALEND EOF)) - (T (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM SRCEOLC))) - (* ; - "Not RAP and START and END are both NIL. Slow copy to the end of the file.") + (T + (* ;; + "Not random access and START and END are both NIL, just copy to the end of file,no need to count.") + + (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM SRCEOLC))) (RETURN))) - (OR (IGEQ ACTUALEND ACTUALSTART) + (CL:UNLESS (IGEQ ACTUALEND ACTUALSTART) (ERROR "Negative number of bytes to copy" (IDIFFERENCE ACTUALEND ACTUALSTART))) - (IF SAMEEXTFORM - THEN (* ; - "We only have to worry about mismatched EOLCs") - (SELECTC SRCEOLC - (CR.EOLC (* ; "DST is either CRLF or LF") - (FRPTQ (IDIFFERENCE ACTUALEND ACTUALSTART) - (SELCHARQ (SETQ CH (\BIN SRCSTRM)) - (CR (AND (EQ DSTEOLC CRLF.EOLC) - (\BOUT DSTSTRM (CHARCODE CR))) - (\BOUT DSTSTRM (CHARCODE LF))) - (\BOUT DSTSTRM CH)))) - (LF.EOLC (* ; "DST is either CRLF or CR") - (FRPTQ (IDIFFERENCE ACTUALEND ACTUALSTART) - (SELCHARQ (SETQ CH (\BIN SRCSTRM)) - (LF (\BOUT DSTSTRM (CHARCODE CR)) - (AND (EQ DSTEOLC CRLF.EOLC) - (\BOUT DSTSTRM (CHARCODE LF)))) - (\BOUT DSTSTRM CH)))) - (CRLF.EOLC (* ; "DST is either CR or LF") - [for I from (IDIFFERENCE ACTUALEND ACTUALSTART) - to 1 by -1 - do (\BOUT DSTSTRM (COND - ((OR (NEQ (SETQ CH (\BIN - SRCSTRM)) - (CHARCODE CR)) - (EQ I 1)) - CH) - [(PROGN (add I -1) - (* ; "Adjust for second character") - (EQ (SETQ CH (\BIN - SRCSTRM)) - (CHARCODE LF))) - (COND - ((EQ DSTEOLC CR.EOLC) - (CHARCODE CR)) - (T (CHARCODE LF] - (T (\BOUT DSTSTRM (CHARCODE - CR)) - CH]) - (SHOULDNT)) - ELSE (* ; - "Extformat mismatch. The \INCHAR and \OUTCHAR will also handle any EOL conversion issues.") - (BIND (CNT _ (IDIFFERENCE ACTUALEND ACTUALSTART)) DECLARE (SPECVARS CNT) - WHILE (IGREATERP CNT 0) DO - - (* ;; - "Let the \INCHAR macro decrement the byte count") - - (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL - 'CNT CNT] + + (* ;; "We now know which bytes we need to copy, in the case that there is an EOL/format mismatch. If we assume that this is fairly unusual and that we don't want to assume here that we know how the CR and LF are byte-coded, we don't try to optimize for an EOL-only change. We just go generic.") + + (* ;; "The \INCCODE.EOLC and \OUTCHAR handle all format and EOL issues.") + + (BIND (CNT _ (IDIFFERENCE ACTUALEND ACTUALSTART)) DECLARE (SPECVARS CNT) + WHILE (IGREATERP CNT 0) DO (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL + 'CNT CNT] T]) (COPYFILE @@ -3454,23 +3416,23 @@ update the map") \FILE.WONT.OPEN 111700 . 112028) (\ILLEGAL.DEVICEOP 112030 . 112312) (\IS.NOT.RANDACCESSP 112314 . 112760) (\STREAM.NOT.OPEN 112762 . 113081)) (113218 115516 (\FDEVINSTANCE 113228 . 115514)) (117066 124440 (CNDIR 117076 . 118381) (DIRECTORYNAME 118383 . 122566) (DIRECTORYNAMEP 122568 . 123184) ( -HOSTNAMEP 123186 . 123993) (\ADD.CONNECTED.DIR 123995 . 124438)) (124485 155136 (\BACKFILEPTR 124495 +HOSTNAMEP 123186 . 123993) (\ADD.CONNECTED.DIR 123995 . 124438)) (124485 151872 (\BACKFILEPTR 124495 . 124683) (\BACKPEEKBIN 124685 . 125046) (\BACKBIN 125048 . 125399) (BIN 125401 . 125618) (\BIN 125620 . 125897) (\BINS 125899 . 126185) (BOUT 126187 . 126549) (\BOUT 126551 . 126866) (\BOUTS 126868 - . 127179) (COPYBYTES 127181 . 130513) (COPYCHARS 130515 . 137445) (COPYFILE 137447 . 138244) ( -\COPYOPENFILE 138246 . 141319) (\INFER.FILE.TYPE 141321 . 142275) (EOFP 142277 . 142574) (FORCEOUTPUT -142576 . 142823) (\FLUSH.OPEN.STREAMS 142825 . 143181) (CHARSET 143183 . 144847) (ACCESS-CHARSET -144849 . 145066) (GETEOFPTR 145068 . 145318) (GETFILEINFO 145320 . 148513) (\TYPE.FROM.FILETYPE 148515 - . 148985) (\FILETYPE.FROM.TYPE 148987 . 149166) (GETFILEPTR 149168 . 149420) (SETFILEINFO 149422 . -153035) (SETFILEPTR 153037 . 154756) (BOUT16 154758 . 154943) (BIN16 154945 . 155134)) (155239 160444 -(\GENERIC.BINS 155249 . 155529) (\GENERIC.BOUTS 155531 . 155796) (\GENERIC.RENAMEFILE 155798 . 157629) - (\GENERIC.OPENP 157631 . 158946) (\GENERIC.READP 158948 . 159989) (\GENERIC.CHARSET 159991 . 160442)) - (160445 160784 (\MAP-OPEN-STREAMS 160455 . 160782)) (162654 164734 (\EOF.ACTION 162664 . 162915) ( -\EOSERROR 162917 . 163110) (\GETEOFPTR 163112 . 163294) (\INCFILEPTR 163296 . 163646) (\PEEKBIN 163648 - . 163839) (\SETCLOSEDFILELENGTH 163841 . 164175) (\SETEOFPTR 164177 . 164365) (\SETFILEPTR 164367 . -164732)) (164735 165277 (\FIXPOUT 164745 . 165045) (\FIXPIN 165047 . 165275)) (165278 165844 (\BOUTEOL - 165288 . 165842)) (168936 178800 (\BUFFERED.BIN 168946 . 169798) (\BUFFERED.PEEKBIN 169800 . 170582) -(\BUFFERED.BOUT 170584 . 171444) (\BUFFERED.BINS 171446 . 175131) (\BUFFERED.BOUTS 175133 . 176934) ( -\BUFFERED.COPYBYTES 176936 . 178798)) (178829 181181 (\NULLDEVICE 178839 . 180857) (\NULL.OPENFILE -180859 . 181179))))) + . 127179) (COPYBYTES 127181 . 130513) (COPYCHARS 130515 . 134181) (COPYFILE 134183 . 134980) ( +\COPYOPENFILE 134982 . 138055) (\INFER.FILE.TYPE 138057 . 139011) (EOFP 139013 . 139310) (FORCEOUTPUT +139312 . 139559) (\FLUSH.OPEN.STREAMS 139561 . 139917) (CHARSET 139919 . 141583) (ACCESS-CHARSET +141585 . 141802) (GETEOFPTR 141804 . 142054) (GETFILEINFO 142056 . 145249) (\TYPE.FROM.FILETYPE 145251 + . 145721) (\FILETYPE.FROM.TYPE 145723 . 145902) (GETFILEPTR 145904 . 146156) (SETFILEINFO 146158 . +149771) (SETFILEPTR 149773 . 151492) (BOUT16 151494 . 151679) (BIN16 151681 . 151870)) (151975 157180 +(\GENERIC.BINS 151985 . 152265) (\GENERIC.BOUTS 152267 . 152532) (\GENERIC.RENAMEFILE 152534 . 154365) + (\GENERIC.OPENP 154367 . 155682) (\GENERIC.READP 155684 . 156725) (\GENERIC.CHARSET 156727 . 157178)) + (157181 157520 (\MAP-OPEN-STREAMS 157191 . 157518)) (159390 161470 (\EOF.ACTION 159400 . 159651) ( +\EOSERROR 159653 . 159846) (\GETEOFPTR 159848 . 160030) (\INCFILEPTR 160032 . 160382) (\PEEKBIN 160384 + . 160575) (\SETCLOSEDFILELENGTH 160577 . 160911) (\SETEOFPTR 160913 . 161101) (\SETFILEPTR 161103 . +161468)) (161471 162013 (\FIXPOUT 161481 . 161781) (\FIXPIN 161783 . 162011)) (162014 162580 (\BOUTEOL + 162024 . 162578)) (165672 175536 (\BUFFERED.BIN 165682 . 166534) (\BUFFERED.PEEKBIN 166536 . 167318) +(\BUFFERED.BOUT 167320 . 168180) (\BUFFERED.BINS 168182 . 171867) (\BUFFERED.BOUTS 171869 . 173670) ( +\BUFFERED.COPYBYTES 173672 . 175534)) (175565 177917 (\NULLDEVICE 175575 . 177593) (\NULL.OPENFILE +177595 . 177915))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index c56219c09ae375b6b38a0a921d6ab5a4ded39bd0..c4b4e82cc6e77200a1cda15eb0bdeab965235714 100644 GIT binary patch delta 771 zcmZWnO=}ZT6wS0Eb{dB?gisLl8Ym`<)Vz6`%@si3A!YZB5#ZAB4u zRfH_MRAy`4>PCpkLMTGkaUr-;aoZozfIq;Qd|B&TJkCAm+z;M;2krUem-DY`K7_;a zvqqSY@CXoz<5(P#*Uyc#6oSA%niNNoI1&SJ|4F^N_vmr+VZ8=yb!U6GQGdD;2Za{z zC|TJkL30-Z>2+NPge{Ko$Nn$FqdB6!yV<5xgQm8 zzec^o?zKMkb^^)Hm9_5Lq$WFRGbmJij^D@K?dLz|^x@&2Q(VveWJgVGu*A6Oa%`ue6(dE%ddy9viSIL0Ky(3Qei2D%BOh zyl_fJu`@Cs6G1f$Y5=lPS<`hjBkQZOkpU!12+AeZbQV)IZATPCS=UO%NrL@F#>mOc zsHRHOj!hJ-gKBUeixFoDfH8q|O1*6Z1SQj6a2|LuI_CH&nQ=&(a40h65E7=4ps^~= rnCPsWfTym%Ev)M`ZjKP^TV(}^2q+?9NkD|hfNcBeFhY9mT6^OUG9<>u delta 1047 zcmZuwO-$2Z7~Y04P+{3{5`qNY)TnR(+J0@<&IH*{$BJbi*$;^X89yV)HUu#y+=zyQ zG0~vC7?leb@wRoIj7iUUG#)e_(US+e=w18mPept9`h3s(JkR^K`M%G0TJG(%>}Gu+ z4Fzwn3~>y{0?P*k6cCt4TZxD;2=uWULIH-OVR3VLX?<;DwXmE8YI$p8^VazQgz?nX za4eWe!s-p6qiIb8kaUl;Oa4!YL=RE}QB_mI2_=|PBL8%FRUFZG7y7n)No=p%_*8NnsMu4h z=Zi1$mcciJ9#(@W%Q(}Fs3tzQgYN#}dKb6b7&Cd>m;p1>XW~8#-^+28__Jh^VG~0( zZ)Y$bE z!eYAmw`=nkzc>a28Nn=0r^q=1L6TrrjfcZHq6{lo3xgoYkc{E&v=)h{K;Uh0$X0`Z zggW8{v4N1kff%likZ9`~@knHj#Us99=42U^L;@#(wb87qY07v|8xAJMffb1=sies1 zol4mX(o$2CQ*{H!*R8}kuA~$kB{EUcvx@_3g2a;33dk=*G@?w~fP-Ypz6F!OiBgT@ zM7GIsOr2vTfbaQ^pH=$#+_BU+QqltbTUsLca_w<41m;l{jQyb@8t) L%a-StcCP&bD_9}Q diff --git a/sources/LLREAD b/sources/LLREAD index d1761ad17..c097a6fef 100644 --- a/sources/LLREAD +++ b/sources/LLREAD @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 8-Aug-2021 14:52:26"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;76 100285 +(FILECREATED "13-Aug-2021 14:19:45"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;83 102595 - changes to%: (FNS \INCCODE.EOLC) + changes to%: (FNS \BACKCCODE \RSTRING2 \BACKCCODE.EOLC) + (VARS LLREADCOMS) - previous date%: " 8-Aug-2021 13:10:22" -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;75) + previous date%: "10-Aug-2021 10:29:44" +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;79) (* ; " @@ -25,7 +26,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 +44,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 \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)) @@ -461,7 +462,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 +474,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")) @@ -1117,59 +1112,6 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. TEM) (RELSTK TEM) (RETURN \READDEPTH]) - -(\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%: DONTEVAL@LOAD DOCOPY @@ -1657,7 +1599,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (DEFINEQ (\OUTCHAR - [LAMBDA (STREAM CODE) (* ; "Edited 8-Aug-2021 13:08 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.") @@ -1673,7 +1615,8 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.  (STREAM CHARPOSITION) OF STREAM))))) (CL:FUNCALL (OR (ffetch (STREAM OUTCHARFN) of STREAM) \DEFAULTOUTCHAR) - STREAM CODE]) + STREAM CODE) + CODE]) (\INCCODE [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 7-Aug-2021 00:11 by rmk:") @@ -1696,21 +1639,70 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. STREAM]) (\BACKCCODE - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 6-Aug-2021 15:57 by rmk:") + [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 13-Aug-2021 14:19 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*)) - (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) - \DEFAULTINCCODE) - STREAM - '*BYTECOUNTER* 0 (SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 - BYTECOUNTVAR - )) - *BYTECOUNTER*] + (PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) + \DEFAULTINCCODE) + STREAM T) + (SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)) + *BYTECOUNTER*)))] ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) \DEFAULTINCCODE) STREAM]) +(\BACKCCODE.EOLC + [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 13-Aug-2021 13:34 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) + \DEFAULTINCCODE) + 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 + ) + \DEFAULTINCCODE) + 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) @@ -1788,6 +1780,59 @@ 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 @@ -1847,19 +1892,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 - (FILEMAP (NIL (3472 11701 (LASTC 3482 . 3788) (PEEKC 3790 . 4178) (PEEKCCODE 4180 . 4473) (RATOM 4475 - . 5556) (READ 5558 . 6118) (READC 6120 . 6761) (READCCODE 6763 . 7522) (READP 7524 . 8076) ( -SETREADMACROFLG 8078 . 8377) (SKIPSEPRCODES 8379 . 9362) (SKIPSEPRS 9364 . 9750) (SKREAD 9752 . 11699) -) (11747 20422 (CL:READ 11757 . 12306) (CL:READ-PRESERVING-WHITESPACE 12308 . 13030) ( -CL:READ-DELIMITED-LIST 13032 . 13947) (CL:PARSE-INTEGER 13949 . 20420)) (20515 33460 (RSTRING 20525 . -21257) (READ-EXTENDED-TOKEN 21259 . 25131) (\RSTRING2 25133 . 33458)) (33496 67202 (\TOP-LEVEL-READ -33506 . 35489) (\SUBREAD 35491 . 61052) (\SUBREADCONCAT 61054 . 61677) (\ORIG-READ.SYMBOL 61679 . -62747) (\ORIG-INVALID.SYMBOL 62749 . 63648) (\APPLYREADMACRO 63650 . 64066) (INREADMACROP 64068 . -64634) (\CHECKEOLC.CRLF 64636 . 67200)) (67361 67536 (READQUOTE 67371 . 67534)) (67561 79465 (READVBAR - 67571 . 68902) (READHASHMACRO 68904 . 74714) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 74716 . 74936) ( -DIGITBASEP 74938 . 75672) (READNUMBERINBASE 75674 . 77560) (ESTIMATE-DIMENSIONALITY 77562 . 77887) ( -SKIP.HASH.COMMENT 77889 . 78857) (CMLREAD.FEATURE.PARSER 78859 . 79463)) (79509 86042 (CHARACTER.READ -79519 . 80773) (CHARCODE.DECODE 80775 . 86040)) (90510 97729 (\OUTCHAR 90520 . 91646) (\INCCODE 91648 - . 92834) (\BACKCCODE 92836 . 93796) (\PEEKCCODE 93798 . 94114) (\PEEKCCODE.NOEOLC 94116 . 94378) ( -\INCCODE.EOLC 94380 . 96239) (\FORMATBYTESTREAM 96241 . 97727))))) + (FILEMAP (NIL (3549 11778 (LASTC 3559 . 3865) (PEEKC 3867 . 4255) (PEEKCCODE 4257 . 4550) (RATOM 4552 + . 5633) (READ 5635 . 6195) (READC 6197 . 6838) (READCCODE 6840 . 7599) (READP 7601 . 8153) ( +SETREADMACROFLG 8155 . 8454) (SKIPSEPRCODES 8456 . 9439) (SKIPSEPRS 9441 . 9827) (SKREAD 9829 . 11776) +) (11824 20499 (CL:READ 11834 . 12383) (CL:READ-PRESERVING-WHITESPACE 12385 . 13107) ( +CL:READ-DELIMITED-LIST 13109 . 14024) (CL:PARSE-INTEGER 14026 . 20497)) (20592 33069 (RSTRING 20602 . +21334) (READ-EXTENDED-TOKEN 21336 . 25208) (\RSTRING2 25210 . 33067)) (33105 64245 (\TOP-LEVEL-READ +33115 . 35098) (\SUBREAD 35100 . 60661) (\SUBREADCONCAT 60663 . 61286) (\ORIG-READ.SYMBOL 61288 . +62356) (\ORIG-INVALID.SYMBOL 62358 . 63257) (\APPLYREADMACRO 63259 . 63675) (INREADMACROP 63677 . +64243)) (64404 64579 (READQUOTE 64414 . 64577)) (64604 76508 (READVBAR 64614 . 65945) (READHASHMACRO +65947 . 71757) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71759 . 71979) (DIGITBASEP 71981 . 72715) ( +READNUMBERINBASE 72717 . 74603) (ESTIMATE-DIMENSIONALITY 74605 . 74930) (SKIP.HASH.COMMENT 74932 . +75900) (CMLREAD.FEATURE.PARSER 75902 . 76506)) (76552 83085 (CHARACTER.READ 76562 . 77816) ( +CHARCODE.DECODE 77818 . 83083)) (87553 100039 (\OUTCHAR 87563 . 88699) (\INCCODE 88701 . 89887) ( +\BACKCCODE 89889 . 90779) (\BACKCCODE.EOLC 90781 . 93540) (\PEEKCCODE 93542 . 93858) ( +\PEEKCCODE.NOEOLC 93860 . 94122) (\INCCODE.EOLC 94124 . 95983) (\FORMATBYTESTREAM 95985 . 97471) ( +\CHECKEOLC.CRLF 97473 . 100037))))) STOP diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM index 617a2b22f277c41db0a6f76182a444934684a2d5..222bd714c12b9e906567b7780287d6cbe964c425 100644 GIT binary patch delta 1595 zcmZux-*4Mg6t>-xf!VC3Eo^10be5?lsoFHxvC|}U$TyDDWOd@ic8e-pLAyjPGwXR`cBBOV#E;`>Se`Yk$#FZdP9NL?~sCCAi%nA zs9jm2@(BY;jGr)wr;=dhjYU0MvLTLWxE`y-1a(&Pn!4bTDyo`#ZWqvO44gu#!#gA< zfHpHv0YHkj`PjEZ!&&KAE7HhauZ|8SV0;{#CSIP-U`wNukWwP#vf2_zNf|oxfw)NF zEfmTi(pdB`Uj~$vpk(+oN3skae{7u5HL9WT)jT$R5m2mOO3e1DWZC`W>e&nKwYe9= zQ;-8%W>(ALMcpbxs7s=oq3yMm;t;$xe*Mq z%F*26nfE;^JW=XRt{~vd;mcK@8~I;+7PiQv%IoB%%J7g(_qLm>+Ya(~WpvPM9I05t zWV`(4F3rAo#tVNidXf(%4@o003%3lsl&^6TPdR9o>!pXhWC$ zln0VK5GbGg)prH+>7e^pT4UWGmLyJ~FH%-hb!=+h(?iCV9S(T+-tzaHaFW#|55S~usZO`-9MSTzj`$j45K<;jD!2`|aKZe(a%yvL6`a4z@?AQLMB`El(c ODXv^*dAGh24*Uy1Ii#Ba delta 1665 zcmZuxU2NM_6t=T6hG|2hZQ5Ud4ndWYPK{za|EiE3$C*tXyEslETe@zotNxjF+Ez9p zqzH-UiPk*8B!t+8_P|RUGXVk=;AQIGc;jUnmBu5(+7nNdV<%l{i(h>2x#xW6-1B|+ zeEoo2c|d+-9)avIzdSq4Bp4d#WIn~@ne@tyHyfFB3?h3DSvH?wA~1DjW_szJ%k$QZ z3DnGu%U7-r=AkaDf}j<}xTq-t%wK{?sj4XOUxau(9s%>>H4OVd}dhX(-*_o?wZ3(N0mek7bQetrV%FMg-OUqaN)abK2 zH=Cyuc?NGq+3%CD2Qn$=df-p8K^}XFAOf=le&G)easGnxcD0TC*-vGD&N}c$aGh9_ zdEYuW8El<5Z?6-dTU%~ZlA$FZ^t?By_D}j=HsL&;eWBjO)q-octgR0*1wl*(t-xro zr3E(;qXT!o;S9{JRrX-~AkSF=#rM;Km$nGEc^ng|o1LI1vX9qVJGCe7M=!1%+*F@T zhD?icn-PspM|R*&0^_(zQe*Lm7G{L-`nZu9q+JnvsMq=iC6 zl*zDA7bH;__4tkpx>5o zEWK^RQhc{`a@#_)Agg0l1Cs5!bP?-TFhz{gou9hslcZ`t>woQK?AX0g)9cMy`_#Zl z@3#{6_-S*!D zv*e0>0haqtal7O;GI^xMnTy(y;O+H)2>Tf%8(9_vO%-@Ukt+tIJZ36oz9M1Eu=9{g zv%o8gCUo{m-0yNorc%2d*aTE0t*R7N1K1S8dCdDG0GQl9aWsHQpigH=0F5jns}dHl zUl=<;ncQ==eCeqOFuNXQ7s^(89 zI-3TRRMFrIC|3J%U*9Vk1_X)MeG8-$&SIqdnDa?hB%SNIr-zdmu-d8eMUAJt>s)EPx9U}3yo0sH6rG5eP(u;qy$0=iSj R?WKucduTf7+?qIf@Lvo^%Z&g4 diff --git a/sources/XCCS b/sources/XCCS index ac4f22be4..cb5021158 100644 --- a/sources/XCCS +++ b/sources/XCCS @@ -1,10 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 8-Aug-2021 12:56:55" {DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;44 13384 +(FILECREATED "13-Aug-2021 14:08:48" {DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;48 13416 - changes to%: (FNS \XCCSOUTCHAR) + changes to%: (FNS \XCCSBACKCCODE \XCCSOUTCHAR) - previous date%: " 6-Aug-2021 15:57:41" -{DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;43) + previous date%: " 8-Aug-2021 12:56:55" +{DSK}kaplan>Local>medley3.5>git-medley>sources>XCCS.;45) (PRETTYCOMPRINT XCCSCOMS) @@ -145,7 +145,7 @@ CHAR)))]) (\XCCSOUTCHAR - [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-Aug-2021 12:56 by rmk:") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 13-Aug-2021 10:24 by rmk:") (* ;; "Closed function for the :XCCS external format, also called when :XCCS is the default") @@ -168,7 +168,7 @@ (\BOUTEOL STREAM)) (T (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) - (ADD1 DATUM)) + (IPLUS16 1 DATUM)) (COND ((NOT (\RUNCODED STREAM)) (\BOUT STREAM (\CHARSET CHARCODE)) @@ -183,7 +183,7 @@ (\BOUT STREAM (\CHAR8CODE CHARCODE]) (\XCCSBACKCCODE - [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 15:53 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 13-Aug-2021 14:08 by rmk:") (DECLARE (USEDFREE *BYTECOUNTER*)) (CL:WHEN (\BACKFILEPTR STREAM) @@ -197,10 +197,10 @@ THEN (IF (\BACKFILEPTR STREAM) THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2)) T - ELSEIF COUNTP - THEN (SETQ *BYTECOUNTER* -1)) - ELSEIF COUNTP - THEN (SETQ *BYTECOUNTER* -1)))]) + ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) + NIL) + ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) + T))]) (\XCCSFORMATBYTESTREAM [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 16:47 by rmk:") @@ -290,8 +290,8 @@ (\CREATE.XCCS.EXTERNALFORMAT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1318 1547 (ACCESS-CHARSET 1328 . 1545)) (1548 10399 (\XCCSINCCODE 1558 . 4330) ( -\XCCSPEEKCCODE 4332 . 6868) (\XCCSOUTCHAR 6870 . 9085) (\XCCSBACKCCODE 9087 . 10070) ( -\XCCSFORMATBYTESTREAM 10072 . 10397)) (10400 10956 (\CREATE.XCCS.EXTERNALFORMAT 10410 . 10954)) (10957 - 11788 (\NSIN.24BITENCODING.ERROR 10967 . 11786))))) + (FILEMAP (NIL (1333 1562 (ACCESS-CHARSET 1343 . 1560)) (1563 10431 (\XCCSINCCODE 1573 . 4345) ( +\XCCSPEEKCCODE 4347 . 6883) (\XCCSOUTCHAR 6885 . 9105) (\XCCSBACKCCODE 9107 . 10102) ( +\XCCSFORMATBYTESTREAM 10104 . 10429)) (10432 10988 (\CREATE.XCCS.EXTERNALFORMAT 10442 . 10986)) (10989 + 11820 (\NSIN.24BITENCODING.ERROR 10999 . 11818))))) STOP diff --git a/sources/XCCS.LCOM b/sources/XCCS.LCOM index 6da816b4e6d4f5bc4f40c855304c0d8bde194308..7fbe63861c259becb6f6ca0f6dc9d10879ae75fe 100644 GIT binary patch delta 475 zcmZpYz9&5)Ma0lp*ReER*T}%gP{Gi|%D}?P#A0GafP{snf)cWvfu)r(5SdMUpf;JG zi=R6)PeI8o)W=7`(0H;SqnIV8S`$MhO)d>LPajw3AXmo_R~J+RVU|r!V6@k?P~b8& zHZe3)NX|&iOHVCUD9Kl~QqXYo3s#7UaCQ!Ma&-1~cJ_C1oxGD#QP={>$wpSDW>%)A zlixBrFq&@GW7^6rx|E55fypt4_roR|hpe+~4r~lSF!?j9p#+$f4G}oOcHuHyQisj2 z-poiL#>qc4M8VJ$&N7Cx3{7CN1~3*(gR8%ff~hG~+QbmT0D9fRLLoQ==yhKOb2Avr z%o4^jG=;K&DmA%cA|_vClVmb6o&26jaxyEs5U)EUBLkBIC&=wv>?g}JORD7j|FB64 iA~M}^a_+xmrc43HE$q4flbJFEfC4}|b8`Z_5*q-1hIbtR delta 387 zcmca7-6TCBMMS|u*ReER*T}%gP{Gj1%G3;qCRPMUm}n{}Af@uJU@=*NQOpukow2EsCYOerr;n?1kgH>es|%`OP>W0_=QG+%nJ91>8XH@f zC?sbj=B1|=E0pA`S}AC_`2|nD&ZsD6hU7j|D^qhT6GJ5huE~Xrwv5J`eVDc~3rt{Q zU|@30;r+15+#%~Mo5N%=Hbah-6KvTxK%96szd#d1g%~IQ&=3VfV>rtY#rziGg*yYp2^H$GB2~_ Date: Sat, 14 Aug 2021 00:33:25 -0700 Subject: [PATCH 5/5] 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. --- sources/LLREAD | 55 ++++++++++++++++++++++---------------------- sources/LLREAD.LCOM | Bin 25524 -> 25412 bytes sources/TTYIN.LCOM | Bin 72735 -> 73276 bytes 3 files changed, 27 insertions(+), 28 deletions(-) diff --git a/sources/LLREAD b/sources/LLREAD index c097a6fef..cdaf7be8d 100644 --- a/sources/LLREAD +++ b/sources/LLREAD @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED "13-Aug-2021 14:19:45"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;83 102595 +(FILECREATED "14-Aug-2021 00:27:49"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;85 102555 - changes to%: (FNS \BACKCCODE \RSTRING2 \BACKCCODE.EOLC) - (VARS LLREADCOMS) + changes to%: (FNS \BACKCCODE \BACKCCODE.EOLC) - previous date%: "10-Aug-2021 10:29:44" -{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;79) + previous date%: "13-Aug-2021 14:19:45" +{DSK}kaplan>Local>medley3.5>git-medley>sources>LLREAD.;84) (* ; " @@ -1639,7 +1638,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. STREAM]) (\BACKCCODE - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 13-Aug-2021 14:19 by rmk:") + [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)") @@ -1648,16 +1647,16 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. THEN [LET ((*BYTECOUNTER* 0)) (DECLARE (SPECVARS *BYTECOUNTER*)) (PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) - \DEFAULTINCCODE) + \DEFAULTBACKCCODE) STREAM T) (SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)) *BYTECOUNTER*)))] ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) - \DEFAULTINCCODE) + \DEFAULTBACKCCODE) STREAM]) (\BACKCCODE.EOLC - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 13-Aug-2021 13:34 by rmk:") + [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.") @@ -1670,7 +1669,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (* ;; "In almost all cases, we just execute the first backup") (PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM) - \DEFAULTINCCODE) + \DEFAULTBACKCCODE) STREAM) (IF (AND (EQ CRLF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)) (EQ (CHARCODE LF) @@ -1684,7 +1683,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation. (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM ) - \DEFAULTINCCODE) + \DEFAULTBACKCCODE) STREAM) (CL:UNLESS (EQ (CHARCODE CR) (CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) @@ -1892,20 +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 - (FILEMAP (NIL (3549 11778 (LASTC 3559 . 3865) (PEEKC 3867 . 4255) (PEEKCCODE 4257 . 4550) (RATOM 4552 - . 5633) (READ 5635 . 6195) (READC 6197 . 6838) (READCCODE 6840 . 7599) (READP 7601 . 8153) ( -SETREADMACROFLG 8155 . 8454) (SKIPSEPRCODES 8456 . 9439) (SKIPSEPRS 9441 . 9827) (SKREAD 9829 . 11776) -) (11824 20499 (CL:READ 11834 . 12383) (CL:READ-PRESERVING-WHITESPACE 12385 . 13107) ( -CL:READ-DELIMITED-LIST 13109 . 14024) (CL:PARSE-INTEGER 14026 . 20497)) (20592 33069 (RSTRING 20602 . -21334) (READ-EXTENDED-TOKEN 21336 . 25208) (\RSTRING2 25210 . 33067)) (33105 64245 (\TOP-LEVEL-READ -33115 . 35098) (\SUBREAD 35100 . 60661) (\SUBREADCONCAT 60663 . 61286) (\ORIG-READ.SYMBOL 61288 . -62356) (\ORIG-INVALID.SYMBOL 62358 . 63257) (\APPLYREADMACRO 63259 . 63675) (INREADMACROP 63677 . -64243)) (64404 64579 (READQUOTE 64414 . 64577)) (64604 76508 (READVBAR 64614 . 65945) (READHASHMACRO -65947 . 71757) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71759 . 71979) (DIGITBASEP 71981 . 72715) ( -READNUMBERINBASE 72717 . 74603) (ESTIMATE-DIMENSIONALITY 74605 . 74930) (SKIP.HASH.COMMENT 74932 . -75900) (CMLREAD.FEATURE.PARSER 75902 . 76506)) (76552 83085 (CHARACTER.READ 76562 . 77816) ( -CHARCODE.DECODE 77818 . 83083)) (87553 100039 (\OUTCHAR 87563 . 88699) (\INCCODE 88701 . 89887) ( -\BACKCCODE 89889 . 90779) (\BACKCCODE.EOLC 90781 . 93540) (\PEEKCCODE 93542 . 93858) ( -\PEEKCCODE.NOEOLC 93860 . 94122) (\INCCODE.EOLC 94124 . 95983) (\FORMATBYTESTREAM 95985 . 97471) ( -\CHECKEOLC.CRLF 97473 . 100037))))) + (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 diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM index 222bd714c12b9e906567b7780287d6cbe964c425..65999b28da3048b3c1371e8b792ef582e0b600c3 100644 GIT binary patch delta 516 zcmZvZ%SyvQ7==5nCgM)(#a{tod9Ady>hF#iOeqdBK(hQ5BuYdQqE5=Cc9vRs zn&fT&EU{x`4G<8pq7p)&-3EKr5d)%*m*cGiV-jrd_y_CN{asio?fKmLLxyz&Ct73z zJ3-S(zd8&~y6iRGGc;q_bGDsHQV9a%K@rj@xctep;HjI#2PKmvN zs5TBcng=xjMOv`j0+s|X7*}~iJDc*p0WP{i z>@+j%bu5ZEpM&+Z*%{#PxjS45HfvL6!?^BP?7cP1vtmVP*5pr09=AFS+MurN8CRT=)RwkwsD}tm_4t&D-lOi3ZB zC^b1hw;(eoHAR6dIU_MIJ+)ZXN+BjFI3&o^&)sP9foPe@VvM@F5G^K#N}606Zk|4_ z&Oxq@A+9c{=ECfpT)^naVXVMqXkcV&Ie90eLJ-V6g%~GCXK!a`e-~FhSAQR8O$CiG z$Dm*ZA0ME3F3$eG!I}yMMX6<(`K84QDTyViK*w+?85$t@%fQMA=r0qX9S%(9mYV~a zY<(m(6&UQ87#NrxH)&-F3NkvJwAsp@zyJi3clyb(L7Du1a%!eV3NbFOZjPZoA)bC< zXDAq&p$lnF{^{q;1~hXcJHzBAf8|(+0XrSCJ^8joIm5#7z?}Hm-?ZM`SRvRo1Q= zjy_?Az;HG+wN!9(aSc;21UefSA+C}A_QcM0FrPFGd(?5ILsU!GBBAQW;&S=Ba?7Nl5onUAj9zx z5FP@BghS*|ci&rFA@quXkrq%u6d@cg@B}$z1IuAp5A=bL{i`d}Jqhe{&C9E)zw7_M z{_C%*@Bgbe?@6exPFOiMiRUfPc}utsDsWWvA6ylR%emn{RO8BN+4Ysxg+GC6Y^ z8Z~;-gvk}X#-Q;Nkq)>N>;d@W@0K+Et17JL=MHDCo(|4Ddl-%=3jjKDS~iZE5pz6VU10{%!(6 z!ih;WAby)PToENM`A}QH`=!U-`1ZPVWVG3AD6L}ri<2{TX`uZ}uX`(oRUU3<(=QhOXncr##Z@4gkr~XeWc?xF^d{K&&rPRxU+MJI)uxdrJ8WwS)vI} z*F^wD?*8pa5Zt_%7kRxX=y{(TZ=IilN6u-6=eS>24WuOg5c4NkWwRA|J-+&BU(fzV z)A)Rdt2JOIiVNvFtq}|3LH<5}Ds_Bp=xbFOy9%DugufIF(u7+DFLi<-bI6;GtVr2L z&S1882#v-oBPNn)+%D`(LAyM+Rx{oAT!AK}7F8l$y2*mbN{J4qmq%=jK;deN-Y0PL zMoyw|Ka8x<5K2ZS;g`dwU_7_j+?>QITL|FdtS)$eX$$G^#lvI5-fYx7&2Yu2*_zO9 z^w){HbW2RsejI&X8$LT`vL@t?y`u@vaoQr|E#nqwBfU!tVQQRRnVQ2T@&UxMnn1VY zJEgB^78x(RtqEsd*rN$+#utNo5N&l)nX>uX@M~p(R?*Ys6Lav;@@}|Axn5JK8t@d( zD-UZAs>>g0!Y37GP57;1Lfa^oKfvdQgn%0#Sk_fqH^D+y;lxA>U4@pDT&k5MPAVjW zJ0=_G;I+xa+C))+Iz(8K1JjbQFvY6bteCPj;W2ppX>2b7oIX^Ww~ZH?McKvbY)3LAo}}z;uW6 zZAC>cM}Qagd46OypkR&=@`LPCx4Grzx)_)Ba|$)km2-GikS@+Kli(!HwL$Bh+XdS3 zb1R``A}kG;HR4p&@%%{4K|37zn>r%Rn%99*XC#W05b)OVsrbYBH#D`sE@-a#CGB3g zki0!}QJV5Dsd&*u1}GV(*ApR*gO+Z^%degTwY`fwLwj~Hakb5o9WCLIn-mp%cu6;S zc4Nr^?L~c-{)<4jUzVmL2Tv4ze1V9W2_13%vL31$Ua-ud3Hz4CuwBOTVcN)?zZ&J&r}7;yQYLB zu=gtq=o;wO#k}Ldx}7bf`!^5wDIJ7AT;Jt)kF)f{daOkruh_T<@~4SIK{3EPa*>fm z6Q@^H&~W#8bE)bJu6}cZDoDmncgd8{=4|R%+2&Qi|3-U*%q_LvvXHpH^6kCNAitU{ z9G;wr;KAf~G+c>!w>?R6$=l~bi??S$`|XtVZ@fOf_d|XiYclF6-q2h!lyC3 zy!6wXpli0Mx@KdHuC)BK4P?D~9qB_I%s--$9Dd`-R&`~ue_96|Ji0}D@Zjj?#OO9t z&NKe}*of7~p3yY)$ChcrfnzZxiT{h)Jv3XWN_TTv|~U;LwFw_@VN9OX#=rJ z9ljdC(7B5zrnLSdzDZn@zz0nhRK;z;H75q*l#@M~a_l@gCS>MN5g0gJEfr!Fik=g2DB1;=qFqR($~q$(i?Tglo+Lvr?;8RMuU$>2HdIaT6GXk>=dq<`Aa!X* z%{W+{i#1)T_^4(Ih*M4_Q*r63ED+J@dhzP1K`~;bu@#eqhn*e{&o-S-rxu@|-q#tn zF$B+%%Of+31ThD4JBNgT2kIaE)){j|=N9z2LSB%rLwYtcqat_EpMjViO_{j3;yCy# zB~44xv||%ISFc{JXzr{J@!G|~l zi*kj0rR*gOj!br3Q_`V{$;RS#81B?~YjY*d=R-9pHR zOt6DRk!aF|F|me5z`z-?1}tpISOeC=KJH?K_{ahS6%FG@kPRUUzPwx~><6RO_=Jb> z(#JF{P-r}64F{#sGdM0B@D)w^hy!n-poxgeY@B%_yf}zVW>a(yP_&o~u@Y;s5sQWf ztkH^Gf`0^JAvqP1VR&m$bcj4M!qFppOfJ@j68DOK_K9$CPGA*-LI7nW&Vq{IrbB6s$bbiji1ciz$Pow#A=0-~Fuf8O zSdI*o(63+9IHp})n|5_ix2x;hXmf^<9PTO$NI7u=B1bOVQ7#uc)`lZp7= zsnOF{R#&MUx+F97we4IAXJUKR`jE9f;K$<-KPupAyJ3xlaAgB1V^09b0nnR3`B3z@<| z!KMN1@;3&^k;B=t5XqqkISN7+AY|2s-E!C|3vMA>aB2u^m6+@l=ub{#xPTn?%R+#n z1r)TQfHt%??32S@S?~#d!Kk|8N1Gcfl0@Fc*Jt;rR{^?he~l_26di9^c*+Wlh`2 zDHstm)Gx7oZ3gBk$}Z#sf*+ZI2ep`S7T^f@M&ShV9}*Dqd~VN z0yDEFO7@Y4Z2u$@w?7FJDEV<>w{j-RwHBz56w0`L#9n#A>DQhw5DM!wBJ{_^oJ~qPZjE zl25CWOBNGQXQc(7 z{(7;hjMrWdse<&=^%D%eMKlgHb?Z{?L;%XY;iW*EZY&0|=S?FO3vVugdpMlP98XY$ z>eZkaNk87~PF~;fRxfC?Zlysx`WE@VWx4H!>m)FM0j0y28Q9Q>&v$r-iy2ULuD)HG z4D~dJdPA*Q|Crp#apIkrk2^!}1ORB$oqlwtU)>oP4?Uv|qfj^8ziw+wdW|O^g`d7Z z7(aDy8>sKQ*PS|i<=%Fvd|?OHUje}tB;<+e)$7W=Bx&D&ZpJqSC9_$%<{kN|3J_lU znUvs{e*aRbQ2!s$o9#K)k zqX;&9YMhqvkfuc~U!jF0_X80r0Z~DG@Tf>ZXa$>6K$3u3r4a3zJK1}0fPT%FZ+8AO z=bSk+bLN~gcmMvx`n`#-%t+-&xfYj=;>;Y2ST@J($T73EPlvqr;V7HcjhUS}Jp9|T z(bT7AOq(}%{_Khw(^1c9v!+y*%~&`z2T4+iKWK`$!!F6~^ZEkk7>64aIlSekq4I_Jr9BvfT$0qnFb4d%fqS5H@UdGtxY4k; zpTX!r5r0ljScnKxQ84NcdK4A%iie&}0FgU=S`&#%+?sL{;K9^F1KA0VRgDPvPNkX>!s4{h$F7LcoYbSg3EoOvKs zcgy@HqYB{PbCoKPGkHIgZZL9IB!~gG&lPry9zn4YKWo{f_(8B_*h?R%rlSuni$t>+z6^^?6}z~ue@`dS7+%RSDreA z^K;8IurGIt1_rw?fI`OeC{<|j>{Z9)Z#{>ZUT}m~I|}%Noh$pmdtT$%p65;m@z%&H zYTsgMLOkFTc&4Xw&W3>1k)R;XTvm zYrr()x&{W%9It^DGgoRLscZr)%i>g)<#J0x7;&5isK>1?dtQ_1IqP)|?4G5aDPBB# zGMEQDtsbara|Zrl_8g6WPI)*fc0+=a509Lag|C#GG=|uEMH; zzg5gtfgG7zN_M`X(nfdwYNcBnw9cDA249(Pri1Uz&sPU=-vuER$nzF#)=olBS-4t5 zxPFn&$Kn_7P^Iwh#V=^Uy`)qF+m?tLaD`Iwo+TOhkt&ZyTv(+UiVsv>RY&B8r#;MI zh*Wk|>UM<%$y5|Vb~B3j#Apa`P<7(I&$jE#?DgCPRR>=1oS*{vz;jlz4c|WRfOgcf zOlW_;tPa{s%Q(6*{i<_Sc09FOca64HZ&yd;lI7{zgz}OVJ#}d9%I-Q;w`vuca^UK0 zWdhl?x{`s&32PdPki`Nm^{_)P{1w?EO^`6ETDb3cC=V^%rw<{Dju>bXvL_D`-0sBCiMx)Jdz!e70#O9Pu;entiI zz*lO?#DA)_KpsJ?okQ6slPMdLo)cvw6C#=5R_#Gm03Uj_MFTr=l?vohznVhQ&C7Mg zbpNl_?MjVZ52++1m~xA}ULlNoR}H{NHq<;A8!N)eWn=M%jhX-V?#iES#M*h_d7D>* z(Yyskq_E&BKrDwU7gto!Lr8w@Mb$LCyO4-s%mdw<9sh#=twS6FXJG`O+IHBw>BGeHpZib_{0>b*>~P4L9vLO%`L;#aCVj z6bt2Te_Td#z_4A#&{ps25ADWXTfr2_lloFX4m6xjgu(3H&Cp)j?S|w#Y|jxgaqIqL z(7yfWGHA07lt8=mz&Tiz&4KR>dl*06?59h7zxi5k#U79NxVwOs2l(JY-Q6B?Xa`82 zIFv;NzB^Pu01UCCun-Ek+>jnP1A>7m*$Iga$_AwtYeFHEU^xUKlpe|HTW*?K%gvuc+MH?m^(Wx+u1R5w8J_1 z&W^)^O7n!E5ca!G;Q1bs#Sv$>YSd`hFA0=vvuWgzAmmdjlqx<|M^RAIV(GMq+NtMf|;-88Mwnz}Zbvic?N=jD&^LEVNap1Bsm7g7C#N>1iA| zLxDJ6FiE0`>@u9c4WD$TC2*XB{3dd6!|{!l^dim-UPcqUM~nvH=3AjW4ZGa=ba^az zVHZs-T>UNrJl|Eo44N;VNvkH_0qz2KSdhQ~5DT~>lA<-YNRq^01hGzVC$*|zq5jh$ z7D~9g1;DRL2{B(NiAXL`OZ>450TxaPqhc%&3%jy_{dy7VB^S?(tY+aJx{JaQF^s&3 z1vVk*p&^7|Py;7SdN74692TRb-#NcYS*BkM4o3-tdUcCq`m{fEpHr+;LQZ4cFZ74m z=^*P%mBEHtu`#{#^o{w6&Uu=K#E3fQSx=P=raze~2mbfjLEZa-8!i$1;eqFP24V4B zpgQ|O;-}5Ncz^t)%;rf0ngcW{wl|rYef~g_G8!Eu4iGbyem&{+BveJP;VFU}W-7C_ zHx1TtHf5;tex_5V!L4I>RUELQcXZG`RpX?zX~Xb{FQ)PxfA?)rg$s(eHgK)Efw+YTN~pJ`Q-l5A<;p&`HQUhjv9RF3qHPMJnnn`$+SD)=WlJibF*M? z@a(PPj<$xg-~Y zO*w~|l1M}_)7@YY&QG~TQ?&V~y zYOG?R{_7GV5X*N?$-)!9pqkjjlEA5tBM2gAR|2Gvt^}}<>?q>z4oMKBl(pRz&6Lp8 zW5mT@j?qe>+6!s8;Y+VZD8%V<>P1fXiYWN%usSUF`^QF7p*6LPR??k(qh%1m zy)WBo`pdsOS!KrZ<){kelz$y(Xq|ZXKGPU_`${D!D!&?_iuPSy12Fd*OJUWuweaSG zjr92=66AWbA|&_udN7&Zdi@b-pS+$8?egoVppCS8l$VX!jEo_8cuFNm81D)cO2Z)s z?`kbegOqPUBM^L>qGaV$*@!mX+q|qT42t%(jiM{P);1+t{l#)p&s^AoTn-4=+*?F@Jt%(~r^=vvs3LoI3Sa6uj7M7dCZKz*?^ zD0=+x0WK^&Pj}An;}Y#nCD;6P6!x)BVwkDP