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

Format implementation functions set a known variable *BYTECOUNTER* (#402)

Browse Source 
* 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

* 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.

* TTYIN:  Fix an ancient coding error

but still doesn't solve the  (DIRECTORY ?=  problem #402

* 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

* 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.
This commit is contained in:
rmkaplan
2021-08-15 18:45:04 -07:00
committed by GitHub
parent d6d47953d9
commit 0d2c6622bb
24 changed files with 1320 additions and 798 deletions
Download Patch File Download Diff File Expand all files Collapse all files

161
lispusers/ISO8859IO
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "23-Jun-2021 17:00:30" 
{DSK}<Users>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}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;9)
previous date%: " 6-Aug-2021 16:12:42"
{DSK}<Users>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
(\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
(DECLARE%: DOEVAL@COMPILE DONTCOPY
[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)))
(61925 252)
(61931 253)
(252 254)
(61933 255)
(61805 376]
(SETQ *XEROXTOISO8859MAP* (\MAKERECODEMAP XEROXTOISO))
(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
(* ; "IBM-PC Extended Ascii")
[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
(DEFINEQ
(* ;; "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")
(\IBMOUTCHARFN
[LAMBDA (STREAM CHARCODE) (* ; "Edited 5-May-2021 16:38 by rmk:")
(\PRINTCCODE (IF (IGREATERP CHARCODE 127)
(\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
(\RECODECCODE CHARCODE *XEROXTOIBMMAP*)
[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
(* ; "Edited 3-Jan-96 14:23 by ")
[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))
(167 21)
(171 174)
(176 248)
(177 241)
(178 253)
(181 230)
(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
PEEKCCODEFN _ (FUNCTION \IBMPEEKCCODEFN)
[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.")
(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
(DEFINEQ
(* ;; "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")
(\MACOUTCHARFN
[LAMBDA (STREAM CHARCODE) (* ; "Edited 5-May-2021 16:28 by rmk:")
(* ;; "Converts CHARCODE from internal encoding to MAC before printing.")
(\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 ")
(* ;; "Calls \PRINTCCODE instead of \OUTCHAR so that recompiling is not needed if the default external format changes.")
(CL:WHEN BYTECOUNTVAR
(SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL)))
(\RECODECCODE (\BIN STRM)
*MACTOXEROXMAP*])
@@ -364,7 +378,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
*MACTOXEROXMAP*])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* ; "Edited 8-Dec-95 13:29 by ")
(GLOBALVARS *XEROXTOMACMAP* *MACTOXEROXMAP*)
)
(DEFINEQ
@@ -478,12 +492,10 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
(61476 222)
(61477 223)
(61233 224)
(171 199)
(187 200)
(8516 201)
(32 202)
(61220 208)
(61221 209)
(183 225)
(9138 226)
(61224 227)
(61249 228]
(SETQ *XEROXTOMACMAP* (\MAKERECODEMAP XEROXTOMAC))
(SETQ *MACTOXEROXMAP* (\MAKERECODEMAP XEROXTOMAC T))
(MAKE-EXTERNALFORMAT :MACINTOSH (FUNCTION \MACINCCODEFN)
@@ -494,7 +506,13 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
(MAKEMACFORMAT)
(61224 227)
(* ; "Independent of char encoding")
(DEFINEQ
(\COMMONBACKCCODEFN
[LAMBDA (STRM COUNTP) (* ; "Edited 6-Aug-2021 16:12 by rmk:")
(* ; "Edited 8-Dec-95 13:26 by ")
(DECLARE (USEDFREE *BYTECOUNTER*))
@@ -528,17 +546,12 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
[LAMBDA (CODE MAPARRAY) (* ; "Edited 9-Mar-99 17:28 by rmk:")
(* ; "Edited 21-Jun-95 10:18 by rmk:")
[SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
(CAR C])
(FOR M (MAPARRAY _ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
CSMAP IN CODEMAP UNLESS (EQ (CAR M)
(CADR M))
(* ;; "Recodes a singleton charcode. Leaves everything else unchanged.")
(SETQ CSMAP (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
(CL:SETF (CL:SVREF MAPARRAY (LRSH (CAR M)
8))
CSMAP))
(CL:SETF (CL:SVREF CSMAP (LOGAND (CAR M)
255))
(LET [(CSMAP (CL:SVREF MAPARRAY (LRSH CODE 8]
(OR (AND CSMAP (CL:SVREF CSMAP (LOGAND CODE 255)))
CODE])
)
(PUTPROPS ISO8859IO COPYRIGHT ("Xerox Corporation" 1995 1996 1997 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1909 4233 (\8859OUTCHARFN 1919 . 3222) (\8859INCCODEFN 3224 . 3710) (\8859PEEKCCODEFN

BIN
lispusers/ISO8859IO.LCOM
View File

Binary file not shown.