MACHIINEINDEPENDENT

MAKEFILE NEW with Interlisp read table, as per Larry's request

library/UNICODE

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED " 3-Jul-2021 13:37:33" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;175
 66483  
+
(FILECREATED " 1-Aug-2021 23:18:29" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;181
 64649  
 
-      changes to%:  (FNS READ-UNICODE-MAPPING MAKE-UNICODE-FORMATS)
+      changes to%:  (VARS UNICODECOMS)
+                    (FNS MAKE-UNICODE-FORMATS)
 
-      previous date%: " 3-Jul-2021 11:41:05" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;173)
+      previous date%: " 1-Aug-2021 10:01:35" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;180)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
@@ -14,8 +15,8 @@
        [(COMS 
               (* ;; "External formats")

 
-              (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCHARFN)
-              (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCHARFN)
+              (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
+              (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
               (INITVARS (EXTERNALEOL 'LF))
               (FNS MAKE-UNICODE-FORMATS)
               (P (MAKE-UNICODE-FORMATS EXTERNALEOL))
@@ -78,7 +79,7 @@
 (DEFINEQ
 
 (UTF8.OUTCHARFN

-  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  1-Feb-2021 15:50 by rmk:")


+  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  1-Aug-2021 10:00 by rmk:")


                                                             (* ; "Edited 17-Aug-2020 08:45 by rmk:")


                                                             (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
@@ -88,12 +89,7 @@
 
     (IF
 (EQ CHARCODE (CHARCODE EOL))
         THEN
 (REPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
-              (\BOUT STREAM (SELECTC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM)
-                                (LF.EOLC (CHARCODE LF))
-                                (CR.EOLC (CHARCODE CR))
-                                (CRLF.EOLC (\BOUT STREAM (CHARCODE CR))
-                                           (CHARCODE LF))
-                                (SHOULDNT)))
+              (\BOUTEOL STREAM)
       ELSE
 (CHANGE
 (FETCH
 (STREAM CHARPOSITION) OF
 STREAM)
                       (IPLUS DATUM 1))                       (* ; "Avoid overflow")

             (FOR
 C INSIDE
 (CL:IF RAW
@@ -131,7 +127,17 @@
   [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.")

+    (* ;; "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
 
 
@@ -155,61 +161,57 @@
                              (LF (CL:IF (EQ LF.EOLC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM))
                                      (CHARCODE EOL)
                                      BYTE1))
-                                                          (CL:WHEN BYTECOUNTVAR
+                             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)
-                             (LF (CL:IF (EQ LF.EOLC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM))
+                                     18)
                                (LLSH (LOADBYTE BYTE2 0 6)
                                      12)
                                (LLSH (LOADBYTE BYTE3 0 6)
                                      6)
                                (LOADBYTE BYTE4 0 6))
-                        (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)))
+                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])
 
@@ -993,15 +995,15 @@
        '*XCCSTOUNICODE*
        '*UNICODETOXCCS*)
 )
-         (CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS))
-                (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
-         (CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS))
-                (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS))
-
-         (* ;; "")

-
-         (CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY))
-         (CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY))
-         (LIST LTORARRAY RTOLARRAY])
-)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS*)
+)
+(DEFINEQ
+
+(HEXSTRING

+  [LAMBDA (N WIDTH)
                                     (* ; "Edited 23-Jul-2020 08:28 by rmk:")


+                                                             (* ; "Edited 20-Dec-93 17:51 by rmk:")

+
+    (* ;; 
 
  "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")