github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-04 15:16:50 +00:00
Code Issues Projects Releases Wiki Activity

MACHIINEINDEPENDENT

Browse Source 
MAKEFILE NEW with Interlisp read table, as per Larry's request
This commit is contained in:
rmkaplan
2021-08-05 15:17:41 -07:00
parent c94e044bf3
commit c2cff44a64
4 changed files with 943 additions and 954 deletions
Download Patch File Download Diff File Expand all files Collapse all files

142
library/UNICODE
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 3-Jul-2021 13:37:33"  (FILECREATED " 1-Aug-2021 23:18:29" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;175 66483 {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" previous date%: " 1-Aug-2021 10:01:35"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;173) {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;180)
(PRETTYCOMPRINT UNICODECOMS) (PRETTYCOMPRINT UNICODECOMS)
@@ -14,8 +15,8 @@
[(COMS [(COMS
(* ;; "External formats") (* ;; "External formats")
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCHARFN) (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCHARFN) (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
(INITVARS (EXTERNALEOL 'LF)) (INITVARS (EXTERNALEOL 'LF))
(FNS MAKE-UNICODE-FORMATS) (FNS MAKE-UNICODE-FORMATS)
(P (MAKE-UNICODE-FORMATS EXTERNALEOL)) (P (MAKE-UNICODE-FORMATS EXTERNALEOL))
@@ -78,7 +79,7 @@
(DEFINEQ (DEFINEQ
(UTF8.OUTCHARFN (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 17-Aug-2020 08:45 by rmk:")
(* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:")
@@ -88,12 +89,7 @@
(IF (EQ CHARCODE (CHARCODE EOL)) (IF (EQ CHARCODE (CHARCODE EOL))
THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) THEN (REPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
(\BOUT STREAM (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM) (\BOUTEOL STREAM)
(LF.EOLC (CHARCODE LF))
(CR.EOLC (CHARCODE CR))
(CRLF.EOLC (\BOUT STREAM (CHARCODE CR))
(CHARCODE LF))
(SHOULDNT)))
ELSE (CHANGE (FETCH (STREAM CHARPOSITION) OF STREAM) ELSE (CHANGE (FETCH (STREAM CHARPOSITION) OF STREAM)
(IPLUS DATUM 1)) (* ; "Avoid overflow") (IPLUS DATUM 1)) (* ; "Avoid overflow")
(FOR C INSIDE (CL:IF RAW (FOR C INSIDE (CL:IF RAW
@@ -131,7 +127,17 @@
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL RAW) (* ; "Edited 15-Jun-2021 13:35 by rmk:") [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL RAW) (* ; "Edited 15-Jun-2021 13:35 by rmk:")
(* ; "Edited 6-Aug-2020 17:13 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) (IF (ILESSP BYTE1 128)
THEN THEN
@@ -155,61 +161,57 @@
(LF (CL:IF (EQ LF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)) (LF (CL:IF (EQ LF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM))
(CHARCODE EOL) (CHARCODE EOL)
BYTE1)) 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)) (SETQ BYTE4 (\BIN STREAM))
(CL:WHEN (OR (NOT (SMALLP BYTE4)) (CL:WHEN (OR (NOT (SMALLP BYTE4))
(ILESSP BYTE4 128)) (ILESSP BYTE4 128))
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4)))
(SETQ COUNT 4) (SETQ COUNT 4)
(LOGOR (LLSH (LOADBYTE BYTE1 0 3) (LOGOR (LLSH (LOADBYTE BYTE1 0 3)
(LF (CL:IF (EQ LF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)) 18)
(LLSH (LOADBYTE BYTE2 0 6) (LLSH (LOADBYTE BYTE2 0 6)
12) 12)
(LLSH (LOADBYTE BYTE3 0 6) (LLSH (LOADBYTE BYTE3 0 6)
6) 6)
(LOADBYTE BYTE4 0 6)) (LOADBYTE BYTE4 0 6))
(SETQ BYTE2 (\BIN STREAM)) ELSEIF (IGEQ BYTE1 (LLSH 7 5))
(CL:WHEN (OR (NOT (SMALLP BYTE2)) THEN (* ; "3 bytes")
(ILESSP BYTE2 128)) (SETQ BYTE2 (\BIN STREAM))
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (CL:WHEN (OR (NOT (SMALLP BYTE2))
(SETQ BYTE3 (\BIN STREAM)) (ILESSP BYTE2 128))
(CL:WHEN (OR (NOT (SMALLP BYTE3)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
(ILESSP BYTE3 128)) (SETQ BYTE3 (\BIN STREAM))
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) (CL:WHEN (OR (NOT (SMALLP BYTE3))
(SETQ BYTE4 (\BIN STREAM)) (ILESSP BYTE3 128))
(CL:WHEN (OR (NOT (SMALLP BYTE4)) (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
(ILESSP BYTE4 128)) (SETQ COUNT 3)
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) (LOGOR (LLSH (LOADBYTE BYTE1 0 4)
(SETQ COUNT 4) 12)
(LOGOR (LLSH (LOADBYTE BYTE1 0 3) (LLSH (LOADBYTE BYTE2 0 6)
18) 6)
(LLSH (LOADBYTE BYTE2 0 6) (LOADBYTE BYTE3 0 6))
12) ELSE (* ; "Must be 2 bytes")
(LLSH (LOADBYTE BYTE3 0 6) (SETQ COUNT 2)
6) (SETQ BYTE2 (\BIN STREAM))
(LOADBYTE BYTE4 0 6)) (CL:WHEN (OR (NOT (SMALLP BYTE2))
ELSEIF (IGEQ BYTE1 (LLSH 7 5)) (ILESSP BYTE2 128))
THEN (* ; "3 bytes") (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
(SETQ BYTE2 (\BIN STREAM)) (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
(CL:WHEN (OR (NOT (SMALLP BYTE2)) 6)
(ILESSP BYTE2 128)) (LOADBYTE BYTE2 0 6])
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) (CL:UNLESS (OR RAW (NOT (SMALLP CODE)))
(SETQ BYTE3 (\BIN STREAM)) (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
(CL:WHEN (OR (NOT (SMALLP BYTE3)) (CL:WHEN BYTECOUNTVAR
(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)))
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL COUNT))) (SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL COUNT)))
CODE]) CODE])
@@ -993,15 +995,15 @@
'*XCCSTOUNICODE* '*XCCSTOUNICODE*
'*UNICODETOXCCS*) '*UNICODETOXCCS*)
) )
(CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS)) (DECLARE%: DOEVAL@COMPILE DONTCOPY
(CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
(CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS)) (GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS*)
(CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)) )
(DEFINEQ
(* ;; "")
(HEXSTRING
(CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY)) [LAMBDA (N WIDTH) (* ; "Edited 23-Jul-2020 08:28 by rmk:")
(CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY)) (* ; "Edited 20-Dec-93 17:51 by rmk:")
(LIST LTORARRAY RTOLARRAY])
) (* ;;
 "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")  "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

1755
sources/MACHINEINDEPENDENT
View File

File diff suppressed because it is too large Load Diff

BIN
sources/MACHINEINDEPENDENT.LCOM
View File

Binary file not shown.