github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-13 15:37:38 +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
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
24 changed files with 1320 additions and 798 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

203
library/UNICODE
View File

File diff suppressed because one or more lines are too long

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

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 [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
[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")
(* ;; "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])
(\RECODECCODE CHARCODE *XEROXTOIBMMAP*)
ELSEIF CHARCODE])
(\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*])
(\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.")
(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 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

BIN
lispusers/ISO8859IO.LCOM
View File

Binary file not shown.

194
sources/AOFD
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "13-Jun-2021 11:35:32" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;2 35745
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 9-Aug-2021 23:30:19" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;5 38301
changes to%: (FNS CLOSEF INPUT OUTPUT RANDACCESSP \MAKEBASEBYTESTREAM \BASEBYTES.PEEKBIN
\SEARCHOPENFILES)
changes to%: (VARS AOFDCOMS)
(FNS \STRINGSTREAM.INIT)
previous date%: "10-May-2021 15:44:43"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;1)
previous date%: " 8-Aug-2021 00:11:00"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;4)
(* ; "
@ -36,12 +36,15 @@ 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))
[COMS
(* ;; "STREAM interface for old-style strings")
(FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT)
(P (MAKE-STRING-FORMAT)))
(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))
@ -532,50 +535,98 @@ 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.")
[LAMBDA (STR ACCESS) (* ; "Edited 8-Aug-2021 00:02 by rmk:")
(* rmk%: "28-Mar-85 08:40")
(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])
(* ;; "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")
(* ;;
"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)
@ -588,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)
@ -597,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
@ -614,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
@ -748,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 (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 (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

BIN
sources/AOFD.LCOM
View File

Binary file not shown.

49
sources/ATERM
View File

@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Jun-2021 12:31:16" {DSK}<Users>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}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;1)
previous date%: "23-Jun-2021 12:31:16"
{DSK}<Users>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

BIN
sources/ATERM.LCOM
View File

Binary file not shown.

243
sources/FILEIO
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 6-Aug-2021 10:31:59" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;75 181074
(FILECREATED "13-Aug-2021 18:39:18" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;87 178368
changes to%: (FNS \THROUGHIN)
changes to%: (FNS COPYCHARS)
previous date%: " 5-Aug-2021 22:31:41"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;74)
previous date%: " 8-Aug-2021 14:53:49"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;86)
(* ; "
@ -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 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:")
@ -2449,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]
@ -2478,62 +2494,22 @@ update the map")
(T START]
(RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM))
(SETQ ACTUALEND EOF))
(T (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCHAR SRCSTRM NIL 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")
(* ;; "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.")
(\OUTCHAR DSTSTRM (\INCHAR SRCSTRM
'CNT NIL CNT]
(* ;; "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
@ -3082,11 +3058,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 +3395,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 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 . 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

BIN
sources/FILEIO.LCOM
View File

Binary file not shown.

364
sources/JAPANESE
View File

File diff suppressed because one or more lines are too long

BIN
sources/JAPANESE.LCOM
View File

Binary file not shown.

108
sources/LLDISPLAY
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 1-Aug-2021 23:41:37" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;5 268898
(FILECREATED " 8-Aug-2021 00:19:22" 
{DSK}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;4)
previous date%: " 1-Aug-2021 23:41:37"
{DSK}<Users>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

36
sources/LLDISPLAY.LCOM
View File

@ -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}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;5
268898 changes to%: (FNS DSPCREATE) previous date%: " 1-Aug-2021 23:37:06"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;4)
(FILECREATED " 8-Aug-2021 00:19:22" ("compiled on "
{DSK}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;7
268927 changes to%: (FNS READBITMAP) previous date%: " 1-Aug-2021 23:41:37"
{DSK}<Users>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ó‘N<E28098>OH
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<12>‰JôW

364
sources/LLREAD
View File

@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "29-Jul-2021 22:16:26" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;50 97706
(FILECREATED "14-Aug-2021 00:27:49" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;85 102555
changes to%: (VARS CHARACTERSETNAMES)
changes to%: (FNS \BACKCCODE \BACKCCODE.EOLC)
previous date%: "29-Jul-2021 22:14:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;48)
previous date%: "13-Aug-2021 14:19:45"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;84)
(* ; "
@ -25,7 +25,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 +43,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 \INCHAR \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))
@ -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))
@ -461,7 +461,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 +473,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"))
@ -635,7 +629,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 +727,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 +736,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))
@ -1116,56 +1111,6 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
TEM)
(RELSTK TEM)
(RETURN \READDEPTH])
(\CHECKEOLC.CRLF
[LAMBDA (STREAM PEEKBINFLG BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 23-Jun-2021 13:08 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.")
(LET (CH (NUM 0))
[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.")
(\INCCODE STREAM BYTECOUNTVAR BYTECOUNTVAL)
(CHARCODE EOL))
(T (CHARCODE CR]
(CL:WHEN BYTECOUNTVAR
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
NUM)))
CH])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@ -1653,21 +1598,109 @@ 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 10-Aug-2021 10:29 by rmk:")
(* ;; "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")
(* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.")
(* ;; "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])
STREAM CODE)
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 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)")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM])
(\BACKCCODE.EOLC
[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.")
(* ;; "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)
\DEFAULTBACKCCODE)
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
)
\DEFAULTBACKCCODE)
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:")
@ -1682,35 +1715,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:")
(* ;; "EOL conversion around essentially what \INCCODE does, without 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])
(\INCCODE.EOLC
[LAMBDA (STREAM BYTECOUNTVAR EOLC BYTECOUNTVAL) (* ; "Edited 22-Jun-2021 10:48 by rmk:")
[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*))
(* ;; "The INCCODEFN first sets *BYTECOUNTER*")
(CL:UNLESS BYTECOUNTVAL
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
(SETQ CODE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM T))
(* ;; "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")
(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:")
@ -1735,10 +1779,63 @@ 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
(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 +1854,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 +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 (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 (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

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.

42
sources/PMAP
View File

@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Jun-2021 12:40:35" {DSK}<Users>kaplan>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}<Users>kaplan>Local>medley3.5>git-medley>sources>PMAP.;7 60192
changes to%: (FNS \PAGEDREADP)
previous date%: "21-Jun-2021 21:45:16"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PMAP.;5)
previous date%: "23-Jun-2021 12:40:35"
{DSK}<Users>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

BIN
sources/PMAP.LCOM
View File

Binary file not shown.

158
sources/PRINTFN
View File

@ -1,11 +1,9 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "27-Jun-2021 23:29:20" 
{DSK}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;18 13138
changes to%: (FNS PFCOPYBYTES)
previous date%: "22-Jun-2021 10:48:42"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;14)
previous date%: " 8-Aug-2021 14:52:38"
{DSK}<Users>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:")
(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])
(* ;; "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.")
(PMORE [LAMBDA NIL (* lmm " 9-AUG-78 17:21") (* lmm "17-MAY-78 15:38") (PRINTFNDEF (CAR LASTFNDEF) T (CADDR LASTFNDEF) -1 (CADDDR LASTFNDEF])
(* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files")
(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])
(* ;; "If FN is NIL, prints the function named by LASTWORD")
(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))])
(* ;; "If FN is a list, then extra args are interpreted as:")
(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])
(* ;; " 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 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

BIN
sources/PRINTFN.LCOM
View File

Binary file not shown.

136
sources/TTYIN
View File

@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jun-2021 10:11:51" {DSK}<Users>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}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>sources>TTYIN.;3)
previous date%: "13-Jun-2021 10:11:51"
{DSK}<Users>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

BIN
sources/TTYIN.LCOM
View File

Binary file not shown.

60
sources/XCCS
View File

@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 1-Aug-2021 23:16:58" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;37 13678
(FILECREATED "13-Aug-2021 14:08:48" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;48 13416
changes to%: (FNS \CREATE.XCCS.EXTERNALFORMAT)
changes to%: (FNS \XCCSBACKCCODE \XCCSOUTCHAR)
previous date%: "24-Jun-2021 23:15:05"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;36)
previous date%: " 8-Aug-2021 12:56:55"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;45)
(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 13-Aug-2021 10:24 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)
(IPLUS16 1 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 13-Aug-2021 14:08 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
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 (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 (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

BIN
sources/XCCS.LCOM
View File

Binary file not shown.