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

Rmk63 backccode peekccode eolc (#853)

Browse Source 
* EXTERNALFORMAT,UNICODE,XCCS: Consistent naming of \PEEKCCODE(.EOL), \BACKCCODE returns the code

It was confusing that the naming of the peek functions was inconsistent with the inccode and backccode functions with respect to the EOLC qualifier.  Now uniformaly, the unqualified names (\PEEKCCODE, \BACKCCODE, \INCCODE) do not do any EOL interpretation.  The qualified-name functions (\PEEKCCODE.EOLC, \INCCODE.EOLC, \BACKCCODE.EOLC) do EOL interpretation.

Also, the \BACKCCODE interface is changed so that it returns the code corresponding to the bytes that it passed over.  This simplifies some of the callers.

* Clients of \PEEKCCODE \BACKCCODE and .EOL

Small changes either to fix inconsistencies (backing, reading, peeking with inconsistent EOL interpretation), updating the names in a few other cases, a few simplifications.

* glitches in ATERM, HARDCOPY updates
This commit is contained in:
rmkaplan
2022-07-21 10:36:19 -07:00
committed by GitHub
parent 5db76b4998
commit 6376579b1c
26 changed files with 855 additions and 813 deletions
Download Patch File Download Diff File Expand all files Collapse all files

84
library/UNICODE
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jul-2022 11:38:18" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNICODE.;196 64439
(FILECREATED "19-Jul-2022 15:36:40" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNICODE.;198 65644
:CHANGES-TO (VARS UNICODECOMS)
:CHANGES-TO (FNS MAKE-UNICODE-FORMATS \UTF16BE.BACKCCODEFN \UTF8.BACKCCODEFN)
(VARS UNICODECOMS)
:PREVIOUS-DATE "28-Jun-2022 00:02:58"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNICODE.;195)
:PREVIOUS-DATE "13-Jul-2022 11:38:18"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNICODE.;196)
(PRETTYCOMPRINT UNICODECOMS)
@@ -16,7 +17,7 @@
(* ;; "External formats")
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16BE.BACKCCODEFN)
(INITVARS (EXTERNALEOL 'LF))
(FNS MAKE-UNICODE-FORMATS)
(P (MAKE-UNICODE-FORMATS EXTERNALEOL))
@@ -298,16 +299,20 @@
(RETURN CODE])
(\UTF8.BACKCCODEFN
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:04 by rmk:")
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 19-Jul-2022 15:30 by rmk")
(* ; "Edited 6-Aug-2021 16:04 by rmk:")
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT")
(* ;; "\BACKFILEPTR is NIL at beginning of FILE. Presumably a little bit more efficient if we decoded the UTF8 bytes backwards and didn't do the peek, but probably not worth the complexity. ")
(DECLARE (USEDFREE *BYTECOUNTER*))
(BIND (C _ 0) WHILE (CL:WHEN (\BACKFILEPTR STREAM)
(ADD C -1)
(EQ 2 (LRSH (\PEEKBIN STREAM)
6))) REPEATUNTIL (EQ C -4)
FINALLY (CL:WHEN COUNTP (SETQ *BYTECOUNTER* C])
(BIND (C _ 0) WHILE (IF (\BACKFILEPTR STREAM)
THEN (ADD C -1)
(EQ 2 (LRSH (\PEEKBIN STREAM)
6))
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* C))
(RETURN NIL)) REPEATUNTIL (EQ C -4)
FINALLY (CL:WHEN COUNTP (SETQ *BYTECOUNTER* C))
(RETURN (UTF8.PEEKCCODEFN STREAM NIL RAW])
)
(DEFINEQ
@@ -373,8 +378,9 @@
THEN NIL
ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
(\UTF16.BACKCCODEFN
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:07 by rmk:")
(\UTF16BE.BACKCCODEFN
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 19-Jul-2022 15:14 by rmk")
(* ; "Edited 6-Aug-2021 16:07 by rmk:")
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")
@@ -382,17 +388,25 @@
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
(IF (\BACKFILEPTR STREAM)
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
ELSEIF COUNTP
THEN (SETQ *BYTECOUNTER* -1)))])
(LET (CODE (BYTE2 (\PEEKBIN STREAM)))
(IF (\BACKFILEPTR STREAM)
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
(SETQ CODE (LOGOR (LLSH BYTE2 8)
(\PEEKBIN STREAM)))
(CL:IF RAW
CODE
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
ELSEIF COUNTP
THEN (SETQ *BYTECOUNTER* -1)
NIL)))])
)
(RPAQ? EXTERNALEOL 'LF)
(DEFINEQ
(MAKE-UNICODE-FORMATS
[LAMBDA (EXTERNALEOL) (* ; "Edited 6-Aug-2021 16:08 by rmk:")
[LAMBDA (EXTERNALEOL) (* ; "Edited 19-Jul-2022 15:36 by rmk")
(* ; "Edited 6-Aug-2021 16:08 by rmk:")
(* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")
@@ -407,20 +421,22 @@
(UTF8.INCCODEFN STREAM COUNTP T]
[FUNCTION (LAMBDA (STREAM NOERROR)
(UTF8.PEEKCCODEFN STREAM NOERROR T]
(FUNCTION \UTF8.BACKCCODEFN)
[FUNCTION (LAMBDA (STREAM COUNTP)
(\UTF8.BACKCCODEFN STREAM COUNTP T]
[FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF8.OUTCHARFN STREAM CHARCODE T]
NIL EXTERNALEOL)
(MAKE-EXTERNALFORMAT :UTF-16BE (FUNCTION UTF16BE.INCCODEFN)
(FUNCTION UTF16BE.PEEKCCODEFN)
(FUNCTION \UTF16.BACKCCODEFN)
(FUNCTION \UTF16BE.BACKCCODEFN)
(FUNCTION UTF16BE.OUTCHARFN)
NIL EXTERNALEOL)
(MAKE-EXTERNALFORMAT :UTF-16BE-RAW [FUNCTION (LAMBDA (STREAM COUNTP)
(UTF16BE.INCCODEFN STREAM COUNTP T]
[FUNCTION (LAMBDA (STREAM NOERROR)
(UTF16BE.PEEKCCODEFN STREAM NOERROR T]
(FUNCTION \UTF16.BACKCCODEFN)
[FUNCTION (LAMBDA (STREAM COUNTP)
(\UTF16BE.BACKCCODEFN STREAM COUNTP T]
[FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF16BE.OUTCHARFN STREAM CHARCODE T]
NIL EXTERNALEOL])
@@ -1202,15 +1218,15 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3945 17625 (UTF8.OUTCHARFN 3955 . 6786) (UTF8.INCCODEFN 6788 . 12278) (UTF8.PEEKCCODEFN
12280 . 17054) (\UTF8.BACKCCODEFN 17056 . 17623)) (17626 20952 (UTF16BE.OUTCHARFN 17636 . 18460) (
UTF16BE.INCCODEFN 18462 . 19361) (UTF16BE.PEEKCCODEFN 19363 . 20434) (\UTF16.BACKCCODEFN 20436 . 20950
)) (20982 22790 (MAKE-UNICODE-FORMATS 20992 . 22788)) (22887 24193 (UNICODE.UNMAPPED 22897 . 24191)) (
24194 24730 (XCCS-UTF8-AFTER-OPEN 24204 . 24728)) (25563 25912 (XTOUCODE 25573 . 25741) (UTOXCODE
25743 . 25910)) (25952 42074 (READ-UNICODE-MAPPING-FILENAMES 25962 . 27063) (READ-UNICODE-MAPPING
27065 . 30363) (WRITE-UNICODE-MAPPING 30365 . 34582) (WRITE-UNICODE-INCLUDED 34584 . 39306) (
WRITE-UNICODE-MAPPING-HEADER 39308 . 40540) (WRITE-UNICODE-MAPPING-FILENAME 40542 . 42072)) (45287
53766 (MAKE-UNICODE-TRANSLATION-TABLES 45297 . 53764)) (54183 62209 (HEXSTRING 54193 . 55354) (
UTF8HEXSTRING 55356 . 57561) (NUTF8CODEBYTES 57563 . 58348) (NUTF8STRINGBYTES 58350 . 58831) (
XTOUSTRING 58833 . 61844) (XCCSSTRING 61846 . 62207)) (62210 63679 (SHOWCHARS 62220 . 63677)))))
(FILEMAP (NIL (4031 18122 (UTF8.OUTCHARFN 4041 . 6872) (UTF8.INCCODEFN 6874 . 12364) (UTF8.PEEKCCODEFN
12366 . 17140) (\UTF8.BACKCCODEFN 17142 . 18120)) (18123 21904 (UTF16BE.OUTCHARFN 18133 . 18957) (
UTF16BE.INCCODEFN 18959 . 19858) (UTF16BE.PEEKCCODEFN 19860 . 20931) (\UTF16BE.BACKCCODEFN 20933 .
21902)) (21934 23995 (MAKE-UNICODE-FORMATS 21944 . 23993)) (24092 25398 (UNICODE.UNMAPPED 24102 .
25396)) (25399 25935 (XCCS-UTF8-AFTER-OPEN 25409 . 25933)) (26768 27117 (XTOUCODE 26778 . 26946) (
UTOXCODE 26948 . 27115)) (27157 43279 (READ-UNICODE-MAPPING-FILENAMES 27167 . 28268) (
READ-UNICODE-MAPPING 28270 . 31568) (WRITE-UNICODE-MAPPING 31570 . 35787) (WRITE-UNICODE-INCLUDED
35789 . 40511) (WRITE-UNICODE-MAPPING-HEADER 40513 . 41745) (WRITE-UNICODE-MAPPING-FILENAME 41747 .
43277)) (46492 54971 (MAKE-UNICODE-TRANSLATION-TABLES 46502 . 54969)) (55388 63414 (HEXSTRING 55398 .
56559) (UTF8HEXSTRING 56561 . 58766) (NUTF8CODEBYTES 58768 . 59553) (NUTF8STRINGBYTES 59555 . 60036) (
XTOUSTRING 60038 . 63049) (XCCSSTRING 63051 . 63412)) (63415 64884 (SHOWCHARS 63425 . 64882)))))
STOP

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

24
lispusers/GREP
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Jun-2022 14:36:21" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9 4685
(FILECREATED "19-Jul-2022 22:26:08" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;11 4725
:CHANGES-TO (FNS DOGREP)
:PREVIOUS-DATE "26-Jun-2022 13:28:34"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;7)
:PREVIOUS-DATE "26-Jun-2022 14:36:21"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9)
(* ; "
@@ -22,6 +22,8 @@ Copyright (c) 1984-1986 by Xerox Corporation.
(DOGREP
[LAMBDA (STRS FILES OUTSTREAM)
(* ;; "Edited 19-Jul-2022 22:26 by rmk")
(* ;; "Edited 26-Jun-2022 14:36 by rmk")
(* ;; "Edited 18-Jun-2022 10:38 by rmk: Search for linebreaks directly, without calling BFILEPOS or FILEPOS just for EOL character. Also now compatible with external formats (if FFILEPOS is), and upgraded to full directory specification")
@@ -55,12 +57,12 @@ Copyright (c) 1984-1986 by Xerox Corporation.
(* ;; "Copying from the beginning of this line. Originally this used BFILEPOS (backwards FILEPOS?), which did repeated calls to forward FFILEPOS in what appears to be a binary set of probes. But FFILEPOS is really SLOW-POS for a single character, and the last line-start is presumaby not that far back. So just walk backwards.")
(COPYCHARS STREAM OUTSTREAM (OR [WHILE (\BACKCCODE.EOLC STREAM 'ANY)
WHEN (EQ (CHARCODE EOL)
(\PEEKCCODE STREAM T
'ANY))
DO (RETURN (ADD1 (GETFILEPTR STREAM]
0)
(COPYCHARS STREAM OUTSTREAM (DO (SELCHARQ (\BACKCCODE.EOLC STREAM
'ANY)
(EOL (\INCCODE.EOLC STREAM)
(RETURN (GETFILEPTR STREAM)))
(NIL (RETURN 0))
NIL))
POS)
(DSPFONT BOLDFONT OUTSTREAM)
(COPYCHARS STREAM OUTSTREAM POS (ADD POS (NCHARS STR)))
@@ -97,5 +99,5 @@ Copyright (c) 1984-1986 by Xerox Corporation.
(RPAQ? PHONELISTFILES )
(PUTPROPS GREP COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (517 4570 (DOGREP 527 . 3904) (GREP 3906 . 4383) (PHONE 4385 . 4568)))))
(FILEMAP (NIL (518 4610 (DOGREP 528 . 3944) (GREP 3946 . 4423) (PHONE 4425 . 4608)))))
STOP

BIN
lispusers/GREP.LCOM
View File

Binary file not shown.

120
sources/ATERM
View File

@@ -1,10 +1,11 @@
(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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \FILLBUFFER)
(FILECREATED "20-Jul-2022 17:05:17" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ATERM.;5 57463
previous date%: "23-Jun-2021 12:31:16"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;2)
:CHANGES-TO (FNS \CHDEL1)
:PREVIOUS-DATE "19-Jul-2022 22:49:20"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ATERM.;4)
(* ; "
@@ -14,7 +15,7 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT ATERMCOMS)
(RPAQQ ATERMCOMS
[ (* ; "Line-buffering")
[ (* ; "Line-buffering")
(FNS BKLINBUF CLEARBUF LINBUF PAGEFULLFN SETLINELENGTH SYSBUF TERMCHARWIDTH TERMINAL-INPUT
TERMINAL-OUTPUT \CHDEL1 \CLOSELINE \DECPARENCOUNT \ECHOCHAR \FILLBUFFER
\FILLBUFFER.WORDSEPRP \FILLBUFFER.BACKUP \GETCHAR \INCPARENCOUNT \RESETLINE
@@ -29,8 +30,8 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(FNS DRIBBLE DRIBBLEFILE)
(FNS \SETUP.DEFAULT.LINEBUF \CREATELINEBUFFER \LINEBUF.READP \LINEBUF.EOFP \LINEBUF.PEEKBIN
\OPENLINEBUF)
(COMS (* ;
 "User entries to make up for fact that (EOFP T) = NIL now.")
(COMS (* ;
 "User entries to make up for fact that (EOFP T) = NIL now.")
(FNS LINEBUFFER-EOFP LINEBUFFER-SKIPSEPRS))
(DECLARE%: DOCOPY DONTEVAL@LOAD (VARS (\#DISPLAYLINES 58)
(\DISPLAYLINELENGTH 82)
@@ -181,11 +182,12 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(SETQ TtyDisplayStream (SETQ \TERM.OFD STREAM])])
(\CHDEL1
[LAMBDA NIL (* ; "Edited 23-Jun-2021 12:29 by rmk:")
(COND
((\BACKCCODE \LINEBUF.OFD)
(PROG1 (\PEEKCCODE \LINEBUF.OFD)
(\SETEOFPTR \LINEBUF.OFD (GETFILEPTR \LINEBUF.OFD)))])
[LAMBDA NIL (* ; "Edited 20-Jul-2022 17:05 by rmk")
(* ; "Edited 23-Jun-2021 12:29 by rmk:")
(LET (CODE)
(CL:WHEN (SETQ CODE (\BACKCCODE.EOLC \LINEBUF.OFD))
(\SETEOFPTR \LINEBUF.OFD (GETFILEPTR \LINEBUF.OFD)))
CODE])
(\CLOSELINE
[LAMBDA NIL (* lmm "10-Jan-86 03:07")
@@ -587,8 +589,8 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
)
(RPAQQ BCPLDISPLAYCOMS ((FNS \DSCCOUT \INITBCPLDISPLAY)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INITBCPLDISPLAY)))
(EXPORT (GLOBALVARS \BCPLDISPLAY))))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INITBCPLDISPLAY)))
(EXPORT (GLOBALVARS \BCPLDISPLAY))))
(DEFINEQ
(\DSCCOUT
@@ -706,16 +708,16 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(PUTPROPS \RAISECHAR MACRO (OPENLAMBDA (C)
(COND
((AND (fetch RAISEFLG of \PRIMTERMTABLE)
(IGEQ C (CHARCODE a))
(ILEQ C (CHARCODE z)))
(IDIFFERENCE C 32))
(T C))))
(COND
((AND (fetch RAISEFLG of \PRIMTERMTABLE)
(IGEQ C (CHARCODE a))
(ILEQ C (CHARCODE z)))
(IDIFFERENCE C 32))
(T C))))
(PUTPROPS \LINEBUFBOUT MACRO (OPENLAMBDA (STRM CHAR)
(\BOUT STRM (\CHARSET CHAR))
(\BOUT STRM (\CHAR8CODE CHAR))))
(\BOUT STRM (\CHARSET CHAR))
(\BOUT STRM (\CHAR8CODE CHAR))))
)
)
(DEFINEQ
@@ -1056,26 +1058,26 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(ACCESSFNS LINEBUFFER ((LPARCOUNT (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE))
(LBRKCOUNT (fetch FW7 of DATUM)
(replace FW7 of DATUM with NEWVALUE))
(LINEBUFSTATE (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE))
(* ; "F4 is free. EJS, 7/8/85")
(KEYBOARDSTREAM (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(PEEKEDCHAR (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(* ; "Character read by PEEKC")
(LBFLAGS (fetch FW9 of DATUM)
(replace FW9 of DATUM with NEWVALUE))
(replace FW6 of DATUM with NEWVALUE))
(LBRKCOUNT (fetch FW7 of DATUM)
(replace FW7 of DATUM with NEWVALUE))
(LINEBUFSTATE (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE))
(* ; "F4 is free. EJS, 7/8/85")
(KEYBOARDSTREAM (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(PEEKEDCHAR (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(* ; "Character read by PEEKC")
(LBFLAGS (fetch FW9 of DATUM)
(replace FW9 of DATUM with NEWVALUE))
(* ;; "True if peeked char was echoed when peeked. Could use this to determine whether to echo later or not, but that would be incompatible with Interlisp-10, so this field not used")
(* ;; "True if peeked char was echoed when peeked. Could use this to determine whether to echo later or not, but that would be incompatible with Interlisp-10, so this field not used")
)
[ACCESSFNS LINEBUFFER [(LBFLAGBASE (LOCF (fetch LBFLAGS of DATUM]
(BLOCKRECORD LBFLAGBASE ((PEEKEDECHOFLG FLAG)
(INSTRINGP FLAG])
)
[ACCESSFNS LINEBUFFER [(LBFLAGBASE (LOCF (fetch LBFLAGS of DATUM]
(BLOCKRECORD LBFLAGBASE ((PEEKEDECHOFLG FLAG)
(INSTRINGP FLAG])
)
@@ -1095,10 +1097,10 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(PUTPROPS \INTERMP MACRO ((OFD)
(EQ OFD \LINEBUF.OFD)))
(EQ OFD \LINEBUF.OFD)))
(PUTPROPS \OUTTERMP MACRO ((OFD)
(EQ OFD \TERM.OFD)))
(EQ OFD \TERM.OFD)))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -1112,8 +1114,8 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
(DECLARE%: DONTCOPY
(RPAQQ FILLTYPES ((READ.FT 0)
(RATOM/RSTRING.FT 1)
(READC.FT 2)))
(RATOM/RSTRING.FT 1)
(READC.FT 2)))
(DECLARE%: EVAL@COMPILE
(RPAQQ READ.FT 0)
@@ -1142,18 +1144,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 (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)))))
(FILEMAP (NIL (2982 32059 (BKLINBUF 2992 . 3467) (CLEARBUF 3469 . 4801) (LINBUF 4803 . 4989) (
PAGEFULLFN 4991 . 6472) (SETLINELENGTH 6474 . 6670) (SYSBUF 6672 . 6858) (TERMCHARWIDTH 6860 . 7277) (
TERMINAL-INPUT 7279 . 7847) (TERMINAL-OUTPUT 7849 . 8435) (\CHDEL1 8437 . 8826) (\CLOSELINE 8828 .
9117) (\DECPARENCOUNT 9119 . 10702) (\ECHOCHAR 10704 . 11396) (\FILLBUFFER 11398 . 24389) (
\FILLBUFFER.WORDSEPRP 24391 . 24636) (\FILLBUFFER.BACKUP 24638 . 24817) (\GETCHAR 24819 . 25208) (
\INCPARENCOUNT 25210 . 27822) (\RESETLINE 27824 . 28148) (\RESETTERMINAL 28150 . 28914) (\SAVELINEBUF
28916 . 30887) (\STOPSCROLL? 30889 . 32057)) (32262 36118 (\DSCCOUT 32272 . 35412) (\INITBCPLDISPLAY
35414 . 36116)) (36311 37561 (VIDEOCOLOR 36321 . 37559)) (38329 44183 (\PEEKREFILL 38339 . 42450) (
\READREFILL 42452 . 43046) (\RATOM/RSTRING-REFILL 43048 . 43626) (\READCREFILL 43628 . 44181)) (44184
46013 (DRIBBLE 44194 . 45795) (DRIBBLEFILE 45797 . 46011)) (46014 52689 (\SETUP.DEFAULT.LINEBUF 46024
. 48481) (\CREATELINEBUFFER 48483 . 50905) (\LINEBUF.READP 50907 . 51256) (\LINEBUF.EOFP 51258 .
51597) (\LINEBUF.PEEKBIN 51599 . 51806) (\OPENLINEBUF 51808 . 52687)) (52764 54003 (LINEBUFFER-EOFP
52774 . 53232) (LINEBUFFER-SKIPSEPRS 53234 . 54001)) (54360 54634 (\INTERMP 54370 . 54501) (\OUTTERMP
54503 . 54632)))))
STOP

BIN
sources/ATERM.LCOM
View File

Binary file not shown.

152
sources/CLSTREAMS
View File

@@ -1,13 +1,31 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 6-Jul-2022 11:56:07" 
|{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;37| 65858
(FILECREATED "20-Jul-2022 00:03:06" 
|{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;41| 67657
:CHANGES-TO (FUNCTIONS CL:MAKE-SYNONYM-STREAM CL:MAKE-BROADCAST-STREAM
CL:MAKE-CONCATENATED-STREAM CL:MAKE-TWO-WAY-STREAM CL:MAKE-ECHO-STREAM)
:CHANGES-TO (SETFS FILE-STREAM-POSITION)
(VARS CLSTREAMSCOMS)
(FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT CL:STREAM-ELEMENT-TYPE
CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P FILE-STREAM-POSITION
CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL
XCL:FOLLOW-SYNONYM-STREAMS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P
XCL:BROADCAST-STREAM-STREAMS CL:MAKE-CONCATENATED-STREAM
XCL:CONCATENATED-STREAM-P XCL:CONCATENATED-STREAM-STREAMS
CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM
XCL:TWO-WAY-STREAM-INPUT-STREAM CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P
XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM
CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM
%MAKE-INITIAL-STRING-STREAM-CONTENTS CL:WITH-OPEN-STREAM
CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE
CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM
CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN
\\ADJUSTABLE-STRING-STREAM-OUTCHARFN %NEW-FILE PREDICT-NAME INTERLISP-ACCESS
%BROADCAST-STREAM-DEVICE-CHARSETFN %CONCATENATED-STREAM-DEVICE-CHARSETFN
%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
(FNS %TWO-WAY-STREAM-PEEKCCODEFN)
:PREVIOUS-DATE " 5-Jul-2022 23:12:39"
|{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;36|)
:PREVIOUS-DATE "19-Jul-2022 22:58:32"
|{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;40|)
; Copyright (c) 1985-1988, 1990-1991 by Venue & Xerox Corporation.
@@ -925,7 +943,8 @@
(\\INCCODE OTHER-STREAM BYTECOUNTVAR BYTECOUNTVAL))))
(%SYNONYM-STREAM-PEEKCCODEFN
(LAMBDA (STREAM NOERROR EOL) (* \; "Edited 3-Jul-2022 21:31 by rmk")
(LAMBDA (STREAM NOERROR) (* \; "Edited 19-Jul-2022 22:58 by rmk")
(* \; "Edited 3-Jul-2022 21:31 by rmk")
(* \; "Edited 3-Jan-90 15:25 by jds")
(* |;;| " PEEKCCODEFN for synonym streams")
@@ -933,7 +952,8 @@
(LET ((OTHER-STREAM (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM)))
(|freplace| (STREAM EOLCONVENTION) |of| STREAM |with| (|ffetch| (STREAM EOLCONVENTION)
|of| OTHER-STREAM))
(\\PEEKCCODE OTHER-STREAM NOERROR EOL))))
(CL:FUNCALL (|ffetch| (STREAM PEEKCCODEFN) |of| OTHER-STREAM)
OTHER-STREAM NOERROR))))
(%SYNONYM-STREAM-BACKCCODEFN
(LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* \; "Edited 3-Jul-2022 21:31 by rmk")
@@ -984,13 +1004,19 @@
|of| STREAM))))))
(%TWO-WAY-STREAM-PEEKCCODEFN
(LAMBDA (STREAM NOERROR EOL) (* \; "Edited 4-Jul-2022 00:02 by rmk")
(* \; "Edited 3-Jan-90 15:26 by jds")
(LAMBDA (STREAM NOERROR)
(* |;;| "Edited 20-Jul-2022 00:02 by rmk: No EOL argument at this level, make direct FUNCALL.")
(* |;;| "Edited 4-Jul-2022 00:02 by rmk")
(* |;;| "Edited 3-Jan-90 15:26 by jds")
(* |;;| "peekccodefn for two-way streams")
(\\PEEKCCODE (|fetch| (STREAM F1) |of| STREAM)
NOERROR EOL)))
(CL:FUNCALL (|ffetch| (STREAM PEEKCCODEFN) |of| (|fetch| (STREAM F1) |of| STREAM))
(|fetch| (STREAM F1) |of| STREAM)
NOERROR)))
)
(DEFINEQ
@@ -1343,56 +1369,56 @@
(PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE)
(PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (6268 15243 (OPEN 6268 . 15243)) (15245 16171 (CL:CLOSE 15245 . 16171)) (16173 16251 (
CL:STREAM-EXTERNAL-FORMAT 16173 . 16251)) (16253 16320 (CL:STREAM-ELEMENT-TYPE 16253 . 16320)) (16322
16556 (CL:INPUT-STREAM-P 16322 . 16556)) (16558 16794 (CL:OUTPUT-STREAM-P 16558 . 16794)) (16796 16933
(XCL:OPEN-STREAM-P 16796 . 16933)) (16935 17002 (FILE-STREAM-POSITION 16935 . 17002)) (17054 18558 (
CL:MAKE-SYNONYM-STREAM 17054 . 18558)) (18560 18649 (XCL:SYNONYM-STREAM-P 18560 . 18649)) (18651 18789
(XCL:SYNONYM-STREAM-SYMBOL 18651 . 18789)) (18791 19069 (XCL:FOLLOW-SYNONYM-STREAMS 18791 . 19069)) (
19071 19556 (CL:MAKE-BROADCAST-STREAM 19071 . 19556)) (19558 19701 (XCL:BROADCAST-STREAM-P 19558 .
19701)) (19703 19918 (XCL:BROADCAST-STREAM-STREAMS 19703 . 19918)) (19920 20504 (
CL:MAKE-CONCATENATED-STREAM 19920 . 20504)) (20506 20605 (XCL:CONCATENATED-STREAM-P 20506 . 20605)) (
20607 20820 (XCL:CONCATENATED-STREAM-STREAMS 20607 . 20820)) (20822 22563 (CL:MAKE-TWO-WAY-STREAM
20822 . 22563)) (22565 22702 (XCL:TWO-WAY-STREAM-P 22565 . 22702)) (22704 22849 (
XCL:TWO-WAY-STREAM-OUTPUT-STREAM 22704 . 22849)) (22851 22995 (XCL:TWO-WAY-STREAM-INPUT-STREAM 22851
. 22995)) (22997 24544 (CL:MAKE-ECHO-STREAM 22997 . 24544)) (24546 24675 (XCL:ECHO-STREAM-P 24546 .
24675)) (24677 24815 (XCL:ECHO-STREAM-INPUT-STREAM 24677 . 24815)) (24817 24956 (
XCL:ECHO-STREAM-OUTPUT-STREAM 24817 . 24956)) (24958 25685 (CL:MAKE-STRING-INPUT-STREAM 24958 . 25685)
) (25687 26180 (MAKE-CONCATENATED-STRING-INPUT-STREAM 25687 . 26180)) (26182 26342 (
%MAKE-INITIAL-STRING-STREAM-CONTENTS 26182 . 26342)) (26344 26774 (CL:WITH-OPEN-STREAM 26344 . 26774))
(26776 28005 (CL:WITH-INPUT-FROM-STRING 26776 . 28005)) (28007 28509 (CL:WITH-OUTPUT-TO-STRING 28007
. 28509)) (28511 29165 (CL:WITH-OPEN-FILE 28511 . 29165)) (29389 30915 (
MAKE-FILL-POINTER-OUTPUT-STREAM 29389 . 30915)) (30917 31638 (CL:GET-OUTPUT-STREAM-STRING 30917 .
31638)) (31640 32119 (\\STRING-STREAM-OUTCHARFN 31640 . 32119)) (32121 33976 (
\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 32121 . 33976)) (34005 34087 (%NEW-FILE 34005 . 34087)) (34089
34234 (PREDICT-NAME 34089 . 34234)) (34270 34421 (INTERLISP-ACCESS 34270 . 34421)) (34510 35245 (
%BROADCAST-STREAM-DEVICE-BOUT 34520 . 34743) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34745 . 34984) (
%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34986 . 35243)) (35247 35574 (%BROADCAST-STREAM-DEVICE-CHARSETFN
35247 . 35574)) (35575 36370 (%BROADCAST-STREAM-OUTCHARFN 35585 . 36368)) (36409 38468 (
%CONCATENATED-STREAM-DEVICE-BIN 36419 . 36824) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36826 . 37139) (
%CONCATENATED-STREAM-DEVICE-EOFP 37141 . 37505) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 37507 . 37982) (
%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 37984 . 38466)) (38469 41099 (%CONCATENATED-STREAM-INCCODEFN
38479 . 39349) (%CONCATENATED-STREAM-PEEKCCODEFN 39351 . 40223) (%CONCATENATED-STREAM-BACKCCODEFN
40225 . 41097)) (41101 41432 (%CONCATENATED-STREAM-DEVICE-CHARSETFN 41101 . 41432)) (41433 41964 (
%ECHO-STREAM-DEVICE-BIN 41443 . 41650) (%ECHO-STREAM-INCCODEFN 41652 . 41962)) (41999 42224 (
%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 41999 . 42224)) (42225 44861 (%SYNONYM-STREAM-DEVICE-BIN
42235 . 42423) (%SYNONYM-STREAM-DEVICE-BOUT 42425 . 42626) (%SYNONYM-STREAM-DEVICE-EOFP 42628 . 42819)
(%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 42821 . 43059) (%SYNONYM-STREAM-DEVICE-GETFILEINFO 43061 . 43298)
(%SYNONYM-STREAM-DEVICE-PEEKBIN 43300 . 43523) (%SYNONYM-STREAM-DEVICE-READP 43525 . 43636) (
%SYNONYM-STREAM-DEVICE-BACKFILEPTR 43638 . 43784) (%SYNONYM-STREAM-DEVICE-SETFILEINFO 43786 . 44035) (
%SYNONYM-STREAM-DEVICE-CHARSETFN 44037 . 44273) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 44275 . 44859)) (
44889 45128 (%SYNONYM-STREAM-DEVICE-GET-STREAM 44899 . 45126)) (45172 47937 (%SYNONYM-STREAM-OUTCHARFN
45182 . 46128) (%SYNONYM-STREAM-INCCODEFN 46130 . 46659) (%SYNONYM-STREAM-PEEKCCODEFN 46661 . 47290)
(%SYNONYM-STREAM-BACKCCODEFN 47292 . 47935)) (47971 49864 (%TWO-WAY-STREAM-BACKCCODEFN 47981 . 48382)
(%TWO-WAY-STREAM-INCCODEFN 48384 . 48779) (%TWO-WAY-STREAM-OUTCHARFN 48781 . 49473) (
%TWO-WAY-STREAM-PEEKCCODEFN 49475 . 49862)) (49865 54190 (%TWO-WAY-STREAM-DEVICE-BIN 49875 . 50048) (
%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 50050 . 50241) (%TWO-WAY-STREAM-DEVICE-BOUT 50243 . 50415) (
%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 50417 . 50607) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 50609 . 51471) (
%TWO-WAY-STREAM-DEVICE-CLOSEFILE 51473 . 52896) (%TWO-WAY-STREAM-DEVICE-EOFP 52898 . 53074) (
%TWO-WAY-STREAM-DEVICE-READP 53076 . 53269) (%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 53271 . 53407) (
%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 53409 . 53638) (%TWO-WAY-STREAM-DEVICE-PEEKBIN 53640 . 53853) (
%TWO-WAY-STREAM-DEVICE-CHARSETFN 53855 . 54188)) (54230 54455 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE
54230 . 54455)) (54457 54576 (%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 54457 . 54576)) (55014 55557 (
%INITIALIZE-STANDARD-STREAMS 55014 . 55557)) (55558 65584 (%INITIALIZE-CLSTREAM-TYPES 55568 . 65582)))
(FILEMAP (NIL (7779 16754 (OPEN 7779 . 16754)) (16756 17682 (CL:CLOSE 16756 . 17682)) (17684 17762 (
CL:STREAM-EXTERNAL-FORMAT 17684 . 17762)) (17764 17831 (CL:STREAM-ELEMENT-TYPE 17764 . 17831)) (17833
18067 (CL:INPUT-STREAM-P 17833 . 18067)) (18069 18305 (CL:OUTPUT-STREAM-P 18069 . 18305)) (18307 18444
(XCL:OPEN-STREAM-P 18307 . 18444)) (18446 18513 (FILE-STREAM-POSITION 18446 . 18513)) (18565 20069 (
CL:MAKE-SYNONYM-STREAM 18565 . 20069)) (20071 20160 (XCL:SYNONYM-STREAM-P 20071 . 20160)) (20162 20300
(XCL:SYNONYM-STREAM-SYMBOL 20162 . 20300)) (20302 20580 (XCL:FOLLOW-SYNONYM-STREAMS 20302 . 20580)) (
20582 21067 (CL:MAKE-BROADCAST-STREAM 20582 . 21067)) (21069 21212 (XCL:BROADCAST-STREAM-P 21069 .
21212)) (21214 21429 (XCL:BROADCAST-STREAM-STREAMS 21214 . 21429)) (21431 22015 (
CL:MAKE-CONCATENATED-STREAM 21431 . 22015)) (22017 22116 (XCL:CONCATENATED-STREAM-P 22017 . 22116)) (
22118 22331 (XCL:CONCATENATED-STREAM-STREAMS 22118 . 22331)) (22333 24074 (CL:MAKE-TWO-WAY-STREAM
22333 . 24074)) (24076 24213 (XCL:TWO-WAY-STREAM-P 24076 . 24213)) (24215 24360 (
XCL:TWO-WAY-STREAM-OUTPUT-STREAM 24215 . 24360)) (24362 24506 (XCL:TWO-WAY-STREAM-INPUT-STREAM 24362
. 24506)) (24508 26055 (CL:MAKE-ECHO-STREAM 24508 . 26055)) (26057 26186 (XCL:ECHO-STREAM-P 26057 .
26186)) (26188 26326 (XCL:ECHO-STREAM-INPUT-STREAM 26188 . 26326)) (26328 26467 (
XCL:ECHO-STREAM-OUTPUT-STREAM 26328 . 26467)) (26469 27196 (CL:MAKE-STRING-INPUT-STREAM 26469 . 27196)
) (27198 27691 (MAKE-CONCATENATED-STRING-INPUT-STREAM 27198 . 27691)) (27693 27853 (
%MAKE-INITIAL-STRING-STREAM-CONTENTS 27693 . 27853)) (27855 28285 (CL:WITH-OPEN-STREAM 27855 . 28285))
(28287 29516 (CL:WITH-INPUT-FROM-STRING 28287 . 29516)) (29518 30020 (CL:WITH-OUTPUT-TO-STRING 29518
. 30020)) (30022 30676 (CL:WITH-OPEN-FILE 30022 . 30676)) (30900 32426 (
MAKE-FILL-POINTER-OUTPUT-STREAM 30900 . 32426)) (32428 33149 (CL:GET-OUTPUT-STREAM-STRING 32428 .
33149)) (33151 33630 (\\STRING-STREAM-OUTCHARFN 33151 . 33630)) (33632 35487 (
\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 33632 . 35487)) (35516 35598 (%NEW-FILE 35516 . 35598)) (35600
35745 (PREDICT-NAME 35600 . 35745)) (35781 35932 (INTERLISP-ACCESS 35781 . 35932)) (36021 36756 (
%BROADCAST-STREAM-DEVICE-BOUT 36031 . 36254) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 36256 . 36495) (
%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 36497 . 36754)) (36758 37085 (%BROADCAST-STREAM-DEVICE-CHARSETFN
36758 . 37085)) (37086 37881 (%BROADCAST-STREAM-OUTCHARFN 37096 . 37879)) (37920 39979 (
%CONCATENATED-STREAM-DEVICE-BIN 37930 . 38335) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 38337 . 38650) (
%CONCATENATED-STREAM-DEVICE-EOFP 38652 . 39016) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 39018 . 39493) (
%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 39495 . 39977)) (39980 42610 (%CONCATENATED-STREAM-INCCODEFN
39990 . 40860) (%CONCATENATED-STREAM-PEEKCCODEFN 40862 . 41734) (%CONCATENATED-STREAM-BACKCCODEFN
41736 . 42608)) (42612 42943 (%CONCATENATED-STREAM-DEVICE-CHARSETFN 42612 . 42943)) (42944 43475 (
%ECHO-STREAM-DEVICE-BIN 42954 . 43161) (%ECHO-STREAM-INCCODEFN 43163 . 43473)) (43510 43735 (
%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 43510 . 43735)) (43736 46372 (%SYNONYM-STREAM-DEVICE-BIN
43746 . 43934) (%SYNONYM-STREAM-DEVICE-BOUT 43936 . 44137) (%SYNONYM-STREAM-DEVICE-EOFP 44139 . 44330)
(%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 44332 . 44570) (%SYNONYM-STREAM-DEVICE-GETFILEINFO 44572 . 44809)
(%SYNONYM-STREAM-DEVICE-PEEKBIN 44811 . 45034) (%SYNONYM-STREAM-DEVICE-READP 45036 . 45147) (
%SYNONYM-STREAM-DEVICE-BACKFILEPTR 45149 . 45295) (%SYNONYM-STREAM-DEVICE-SETFILEINFO 45297 . 45546) (
%SYNONYM-STREAM-DEVICE-CHARSETFN 45548 . 45784) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 45786 . 46370)) (
46400 46639 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46410 . 46637)) (46683 49626 (%SYNONYM-STREAM-OUTCHARFN
46693 . 47639) (%SYNONYM-STREAM-INCCODEFN 47641 . 48170) (%SYNONYM-STREAM-PEEKCCODEFN 48172 . 48979)
(%SYNONYM-STREAM-BACKCCODEFN 48981 . 49624)) (49660 51663 (%TWO-WAY-STREAM-BACKCCODEFN 49670 . 50071)
(%TWO-WAY-STREAM-INCCODEFN 50073 . 50468) (%TWO-WAY-STREAM-OUTCHARFN 50470 . 51162) (
%TWO-WAY-STREAM-PEEKCCODEFN 51164 . 51661)) (51664 55989 (%TWO-WAY-STREAM-DEVICE-BIN 51674 . 51847) (
%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 51849 . 52040) (%TWO-WAY-STREAM-DEVICE-BOUT 52042 . 52214) (
%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 52216 . 52406) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 52408 . 53270) (
%TWO-WAY-STREAM-DEVICE-CLOSEFILE 53272 . 54695) (%TWO-WAY-STREAM-DEVICE-EOFP 54697 . 54873) (
%TWO-WAY-STREAM-DEVICE-READP 54875 . 55068) (%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 55070 . 55206) (
%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 55208 . 55437) (%TWO-WAY-STREAM-DEVICE-PEEKBIN 55439 . 55652) (
%TWO-WAY-STREAM-DEVICE-CHARSETFN 55654 . 55987)) (56029 56254 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE
56029 . 56254)) (56256 56375 (%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 56256 . 56375)) (56813 57356 (
%INITIALIZE-STANDARD-STREAMS 56813 . 57356)) (57357 67383 (%INITIALIZE-CLSTREAM-TYPES 57367 . 67381)))
))
STOP

BIN
sources/CLSTREAMS.LCOM
View File

Binary file not shown.

61
sources/CMLREAD
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Aug-2021 23:42:49" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;16 12625
changes to%: (RECORDS READER-ENVIRONMENT)
(FILECREATED "19-Jul-2022 23:31:31" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CMLREAD.;15 12803
previous date%: "14-Aug-2021 20:32:52"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;15)
:CHANGES-TO (FNS CL:PEEK-CHAR)
:PREVIOUS-DATE "16-Aug-2021 23:42:49"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CMLREAD.;14)
(* ; "
@@ -16,21 +17,21 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(RPAQQ CMLREADCOMS
[(COMS
(* ;; "Misc Common Lisp reader functions")
(* ;; "Misc Common Lisp reader functions")
(FNS CL:COPY-READTABLE)
(FNS CL:READ-LINE CL:READ-CHAR CL:UNREAD-CHAR CL:PEEK-CHAR CL:LISTEN
CL:READ-CHAR-NO-HANG CL:CLEAR-INPUT CL:READ-FROM-STRING CL:READ-BYTE CL:WRITE-BYTE
)
(* ;
 "must turn off packed version of CLISP infix")
(* ;
 "must turn off packed version of CLISP infix")
(VARS [CLISPCHARS (LDIFFERENCE CLISPCHARS '(- *]
(CLISPCHARRAY (MAKEBITTABLE CLISPCHARS))
(DWIMINMACROSFLG))
(VARIABLES *READ-DEFAULT-FLOAT-FORMAT*)
(GLOBALVARS CMLRDTBL READ-LINE-RDTBL))
[COMS
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
(RECORDS READER-ENVIRONMENT)
(FUNCTIONS WITH-READER-ENVIRONMENT)
@@ -120,7 +121,8 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
[CL:LAMBDA (&OPTIONAL (PEEK-TYPE NIL)
(STREAM *STANDARD-INPUT*)
(EOF-ERRORP T)
EOF-VALUE RECURSIVE-P) (* ; "Edited 14-Apr-87 14:39 by bvm:")
EOF-VALUE RECURSIVE-P) (* ; "Edited 19-Jul-2022 23:29 by rmk")
(* ; "Edited 14-Apr-87 14:39 by bvm:")
(* ;; "Peeks at the next character in the input Stream. See manual for details.")
@@ -131,7 +133,7 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE (CL:SPECIAL \RefillBufferFn))
(SELECTQ PEEK-TYPE
(NIL (* ; "standard case--return next char. \peekccode to terminal requires the binding of \RefillBufferFn above")
(if (SETQ CL:CHAR (\PEEKCCODE STREAM (NULL EOF-ERRORP)))
(if (SETQ CL:CHAR (\PEEKCCODE.EOLC STREAM (NULL EOF-ERRORP)))
then (CL:CODE-CHAR CL:CHAR)
else EOF-VALUE))
(T (* ; "skip whitespace before peeking")
@@ -142,12 +144,16 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
else EOF-VALUE))
(if (CL:CHARACTERP PEEK-TYPE)
then (LET ((DESIREDCHAR (CL:CHAR-CODE PEEK-TYPE))
(NOERROR (NULL EOF-ERRORP)))
(until (EQ (SETQ CL:CHAR (\PEEKCCODE STREAM NOERROR))
DESIREDCHAR)
do (if (NULL CL:CHAR)
then (RETURN EOF-VALUE))
(READCCODE STREAM) finally (RETURN PEEK-TYPE)))
(NOERROR (NULL EOF-ERRORP)))
(until (EQ (SETQ CL:CHAR (\PEEKCCODE.EOLC STREAM NOERROR))
DESIREDCHAR) do (if (NULL CL:CHAR)
then (RETURN EOF-VALUE))
(* ;;
 "READCCODE sets STREAM's LASTCCODE, \INCCODE.EOLC doesn't")
(READCCODE STREAM)
finally (RETURN PEEK-TYPE)))
else (\ILLEGAL.ARG PEEK-TYPE])
(CL:LISTEN
@@ -239,8 +245,7 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE REPACKAGEFORM REFORMAT REREADTABLEFORM
))
(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE REPACKAGEFORM REFORMAT REREADTABLEFORM))
)
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER POINTER)
@@ -269,9 +274,8 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*)
)
(RPAQ? *COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _ (CL:FIND-PACKAGE
"USER")
REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :XCCS))
(RPAQ? *COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _ (CL:FIND-PACKAGE "USER")
REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :XCCS))
(PUTPROPS CMLREAD FILETYPE CL:COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -280,13 +284,14 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR
CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
(ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR
CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
)
(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2527 3512 (CL:COPY-READTABLE 2537 . 3510)) (3513 10146 (CL:READ-LINE 3523 . 4395) (
CL:READ-CHAR 4397 . 4947) (CL:UNREAD-CHAR 4949 . 5410) (CL:PEEK-CHAR 5412 . 7396) (CL:LISTEN 7398 .
7663) (CL:READ-CHAR-NO-HANG 7665 . 8437) (CL:CLEAR-INPUT 8439 . 8676) (CL:READ-FROM-STRING 8678 . 9433
) (CL:READ-BYTE 9435 . 9888) (CL:WRITE-BYTE 9890 . 10144)))))
(FILEMAP (NIL (2525 3510 (CL:COPY-READTABLE 2535 . 3508)) (3511 10454 (CL:READ-LINE 3521 . 4393) (
CL:READ-CHAR 4395 . 4945) (CL:UNREAD-CHAR 4947 . 5408) (CL:PEEK-CHAR 5410 . 7704) (CL:LISTEN 7706 .
7971) (CL:READ-CHAR-NO-HANG 7973 . 8745) (CL:CLEAR-INPUT 8747 . 8984) (CL:READ-FROM-STRING 8986 . 9741
) (CL:READ-BYTE 9743 . 10196) (CL:WRITE-BYTE 10198 . 10452)) (11448 11921 (WITH-READER-ENVIRONMENT
11448 . 11921)))))
STOP

BIN
sources/CMLREAD.LCOM
View File

Binary file not shown.

132
sources/EXTERNALFORMAT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Jul-2022 16:44:11" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;58 36624
(FILECREATED "20-Jul-2022 13:05:12" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;67 36927
:CHANGES-TO (FNS \FORMATBYTESTRING)
:CHANGES-TO (FNS \BACKCCODE.EOLC)
:PREVIOUS-DATE " 7-Jul-2022 10:42:34"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;57)
:PREVIOUS-DATE "19-Jul-2022 23:52:46"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;66)
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
@@ -29,7 +29,7 @@
(COMS
(* ;; "Generic functions not compiled open (originally on LLREAD)")
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.EOLC
\INCCODE.EOLC \FORMATBYTESTREAM \FORMATBYTESTRING \CHECKEOLC.CRLF)
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC))
(RESOURCES \FORMATBYTESTRING.STREAM))
@@ -355,78 +355,82 @@
STREAM])
(\BACKCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:00 by rmk")
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 19-Jul-2022 15:55 by rmk")
(* ; "Edited 30-Jun-2022 10:00 by rmk")
(* ; "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)")
(* ;; "Format function returns the backed-over character code if the backup succeed, NIL otherwise (e.g at the beginning of the file). FIXP test and PEEKCCODE here for implementations that don't want to bother computing the code from the bytes.")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM])
(LET (CODE)
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(SETQ CODE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM T))
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*))
(CL:WHEN CODE
(OR (FIXP CODE)
(CLFUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM)))]
ELSEIF (SETQ CODE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM))
THEN (OR (FIXP CODE)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM])
(\BACKCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:02 by rmk")
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 20-Jul-2022 13:05 by rmk")
(* ; "Edited 30-Jun-2022 10:02 by rmk")
(* ; "Edited 18-Jun-2022 18:45 by rmk")
(* ; "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]
(CL:UNLESS EOLC
(SETQ EOLC (ffetch (STREAM EOLCONVENTION) OF STREAM)))
(LET (CODE (*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(* ;; "In almost all cases, we just execute the first backup")
(PROG1 (CL:WHEN (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM)
(SELECTC (OR EOLC (ffetch (STREAM EOLCONVENTION) OF STREAM))
((LIST CRLF.EOLC ANY.EOLC 'CRLF 'ANY)
(CL:WHEN (EQ (CHARCODE LF)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM))
(SELCHARQ (SETQ CODE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM BYTECOUNTVAR))
(LF (SELECTC EOLC
((LIST LF.EOLC 'LF)
(SETQ CODE (CHARCODE EOL)))
((LIST CRLF.EOLC ANY.EOLC 'CRLF 'ANY)
(SETQ CODE (CHARCODE EOL)) (* ;
 "Also an EOL, but back over a preceding CR")
(CL:UNLESS (EQ (CHARCODE CR)
(CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM BYTECOUNTVAR))
(* ;;
 "We just backed over an LF with EOLC= CRLF or ANY. If we go one more, do we get a CR?")
(* ;; "Not a preceding CR, reread it.")
(CL:WHEN (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM)
STREAM)
(CL:UNLESS (EQ (CHARCODE CR)
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN)
of STREAM)
STREAM))
(* ;; "Not a preceding CR, reread it.")
(CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM)))))
NIL)
T)
(CL:WHEN BYTECOUNTVAR
[SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
(CL:FUNCALL (ffetch (STREAM INCCODEFN) of STREAM)
STREAM BYTECOUNTVAR)))
NIL))
(CR (CL:WHEN [MEMB EOLC (CONSTANT (LIST CR.EOLC ANY.EOLC 'CR 'ANY]
(SETQ CODE (CHARCODE EOL))))
NIL)
(CL:WHEN BYTECOUNTVAR
[SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR *BYTECOUNTER*])
CODE])
(\PEEKCCODE
[LAMBDA (STREAM NOERROR) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM NOERROR])
(\PEEKCCODE.EOLC
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 14-Jun-2021 12:40 by rmk:")
(\CHECKEOLC (CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM NOERROR)
EOL STREAM T])
(\PEEKCCODE.NOEOLC
[LAMBDA (STREAM NOERROR) (* ; "Edited 30-Jun-2022 10:03 by rmk")
(* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM)
STREAM NOERROR])
(\INCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 30-Jun-2022 10:12 by rmk")
(* ; "Edited 8-Aug-2021 14:52 by rmk:")
@@ -701,13 +705,13 @@
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6575 13210 (\EXTERNALFORMAT 6585 . 10363) (MAKE-EXTERNALFORMAT 10365 . 12737) (
\EXTERNALFORMAT.DEFPRINT 12739 . 13208)) (13211 16252 (\INSTALL.EXTERNALFORMAT 13221 . 14670) (
\REMOVE.EXTERNALFORMAT 14672 . 15503) (FIND-FORMAT 15505 . 16250)) (16253 16466 (SYSTEM-EXTERNALFORMAT
16263 . 16464)) (16815 30707 (\OUTCHAR 16825 . 18042) (\INCCODE 18044 . 19197) (\BACKCCODE 19199 .
20062) (\BACKCCODE.EOLC 20064 . 22651) (\PEEKCCODE 22653 . 23027) (\PEEKCCODE.NOEOLC 23029 . 23361) (
\INCCODE.EOLC 23363 . 25043) (\FORMATBYTESTREAM 25045 . 26678) (\FORMATBYTESTRING 26680 . 28139) (
\CHECKEOLC.CRLF 28141 . 30705)) (32309 34545 (\NULLDEVICE 32319 . 34221) (\NULL.OPENFILE 34223 . 34543
)) (34685 36528 (\CREATE.THROUGH.EXTERNALFORMAT 34695 . 35497) (\THROUGHIN 35499 . 35919) (
\THROUGHBACKCCODE 35921 . 36188) (\THROUGHOUTCHARFN 36190 . 36526)))))
(FILEMAP (NIL (6571 13206 (\EXTERNALFORMAT 6581 . 10359) (MAKE-EXTERNALFORMAT 10361 . 12733) (
\EXTERNALFORMAT.DEFPRINT 12735 . 13204)) (13207 16248 (\INSTALL.EXTERNALFORMAT 13217 . 14666) (
\REMOVE.EXTERNALFORMAT 14668 . 15499) (FIND-FORMAT 15501 . 16246)) (16249 16462 (SYSTEM-EXTERNALFORMAT
16259 . 16460)) (16811 31010 (\OUTCHAR 16821 . 18038) (\INCCODE 18040 . 19193) (\BACKCCODE 19195 .
20764) (\BACKCCODE.EOLC 20766 . 22956) (\PEEKCCODE 22958 . 23283) (\PEEKCCODE.EOLC 23285 . 23664) (
\INCCODE.EOLC 23666 . 25346) (\FORMATBYTESTREAM 25348 . 26981) (\FORMATBYTESTRING 26983 . 28442) (
\CHECKEOLC.CRLF 28444 . 31008)) (32612 34848 (\NULLDEVICE 32622 . 34524) (\NULL.OPENFILE 34526 . 34846
)) (34988 36831 (\CREATE.THROUGH.EXTERNALFORMAT 34998 . 35800) (\THROUGHIN 35802 . 36222) (
\THROUGHBACKCCODE 36224 . 36491) (\THROUGHOUTCHARFN 36493 . 36829)))))
STOP

BIN
sources/EXTERNALFORMAT.LCOM
View File

Binary file not shown.

101
sources/FILEIO
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 8-Jul-2022 10:59:15" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;114 160097
(FILECREATED "19-Jul-2022 23:23:39" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;115 160200
:CHANGES-TO (FNS COPYFILE \COPYOPENFILE)
:CHANGES-TO (FNS \GENERIC.READP)
:PREVIOUS-DATE " 6-Jul-2022 00:01:09"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;113)
:PREVIOUS-DATE " 8-Jul-2022 10:59:15"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEIO.;114)
(* ; "
@@ -2623,22 +2623,21 @@ update the map")
(fetch USERVISIBLE of S])
(\GENERIC.READP
[LAMBDA (STRM FLG) (* ; "Edited 23-Jun-2021 13:09 by rmk:")
(* ;
 "The 10 does not do the EOL check on the peeked character.")
(* ;
 "If FLG is NIL, a single EOL doesn't count.")
[LAMBDA (STRM FLG) (* ; "Edited 19-Jul-2022 23:23 by rmk")
(* ; "Edited 23-Jun-2021 13:09 by rmk:")
(* ;
 "The 10 does not do the EOL check on the peeked character.")
(* ;
 "If FLG is NIL, a single EOL doesn't count.")
(CL:UNLESS (\EOFP STRM)
[PROG NIL
(RETURN (OR FLG [NEQ EOL.TC (\SYNCODE \PRIMTERMSA (OR (\PEEKCCODE STRM T)
(RETURN (OR FLG [NEQ EOL.TC (\SYNCODE \PRIMTERMSA (OR (\PEEKCCODE.EOLC STRM T)
(RETURN]
(UNINTERRUPTABLY
(\INCCODE STRM)
(* ;; "To find out if the EOL is the last character, we BIN the stream, check for EOF, then back it up again.")
(\INCCODE.EOLC STRM) (* ;
 "Read what we peeked (EOLC), see if anything comes after")
(PROG1 (NOT (\EOFP STRM))
(\BACKCCODE STRM)))])])
(\BACKCCODE.EOLC STRM)))])])
(\GENERIC.CHARSET
[LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 16:20 by bvm:")
@@ -3072,39 +3071,39 @@ 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 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (27467 31273 (STREAMPROP 27477 . 27911) (GETSTREAMPROP 27913 . 28508) (PUTSTREAMPROP
28510 . 31121) (STREAMP 31123 . 31271)) (31316 33835 (\DEFPRINT.BY.NAME 31326 . 32478) (
\STREAM.DEFPRINT 32480 . 33528) (\FDEV.DEFPRINT 33530 . 33833)) (34093 39134 (\GETACCESS 34103 . 34557
) (\SETACCESS 34559 . 39132)) (59360 65329 (\DEFINEDEVICE 59370 . 61686) (\GETDEVICEFROMNAME 61688 .
62161) (\GETDEVICEFROMHOSTNAME 62163 . 63207) (\REMOVEDEVICE 63209 . 64332) (\REMOVEDEVICE.NAMES 64334
. 65327)) (65369 90260 (\CLOSEFILE 65379 . 66204) (\DELETEFILE 66206 . 66500) (\DEVICEEVENT 66502 .
68272) (\GENERATEFILES 68274 . 69221) (\GENERATENEXTFILE 69223 . 69874) (\GENERATEFILEINFO 69876 .
70337) (\GETFILENAME 70339 . 70728) (\GENERIC.OUTFILEP 70730 . 71200) (\OPENFILE 71202 . 73780) (
\DO.PARAMS.AT.OPEN 73782 . 76097) (\RENAMEFILE 76099 . 76523) (\REVALIDATEFILE 76525 . 79127) (
\PAGED.REVALIDATEFILELST 79129 . 80687) (\PAGED.REVALIDATEFILES 80689 . 82408) (\PAGED.REVALIDATEFILE
82410 . 84693) (\BUFFERED.REVALIDATEFILE 84695 . 86981) (\BUFFERED.REVALIDATEFILELST 86983 . 88167) (
\PRINT-REVALIDATION-RESULT 88169 . 88584) (\TRUNCATEFILE 88586 . 88977) (\FILE-CONFLICT 88979 . 90258)
) (90296 94959 (\GENERATENOFILES 90306 . 92402) (\NULLFILEGENERATOR 92404 . 92648) (\NOFILESNEXTFILEFN
92650 . 94641) (\NOFILESINFOFN 94643 . 94957)) (95078 96986 (\FILE.NOT.OPEN 95088 . 95601) (
\FILE.WONT.OPEN 95603 . 95931) (\ILLEGAL.DEVICEOP 95933 . 96215) (\IS.NOT.RANDACCESSP 96217 . 96663) (
\STREAM.NOT.OPEN 96665 . 96984)) (97121 99419 (\FDEVINSTANCE 97131 . 99417)) (100621 107995 (CNDIR
100631 . 101936) (DIRECTORYNAME 101938 . 106121) (DIRECTORYNAMEP 106123 . 106739) (HOSTNAMEP 106741 .
107548) (\ADD.CONNECTED.DIR 107550 . 107993)) (108040 136313 (\BACKFILEPTR 108050 . 108238) (
\BACKPEEKBIN 108240 . 108601) (\BACKBIN 108603 . 108954) (BIN 108956 . 109173) (\BIN 109175 . 109452)
(\BINS 109454 . 109740) (BOUT 109742 . 110104) (\BOUT 110106 . 110421) (\BOUTS 110423 . 110734) (
COPYBYTES 110736 . 114068) (COPYCHARS 114070 . 117736) (COPYFILE 117738 . 118802) (\COPYOPENFILE
118804 . 122003) (\INFER.FILE.TYPE 122005 . 122959) (EOFP 122961 . 123258) (FORCEOUTPUT 123260 .
123507) (\FLUSH.OPEN.STREAMS 123509 . 123865) (CHARSET 123867 . 125531) (ACCESS-CHARSET 125533 .
125750) (GETEOFPTR 125752 . 126002) (GETFILEINFO 126004 . 129197) (\TYPE.FROM.FILETYPE 129199 . 129669
) (\FILETYPE.FROM.TYPE 129671 . 129850) (GETFILEPTR 129852 . 130104) (SETFILEINFO 130106 . 134212) (
SETFILEPTR 134214 . 135933) (BOUT16 135935 . 136120) (BIN16 136122 . 136311)) (136416 141621 (
\GENERIC.BINS 136426 . 136706) (\GENERIC.BOUTS 136708 . 136973) (\GENERIC.RENAMEFILE 136975 . 138806)
(\GENERIC.OPENP 138808 . 140123) (\GENERIC.READP 140125 . 141166) (\GENERIC.CHARSET 141168 . 141619))
(141622 141961 (\MAP-OPEN-STREAMS 141632 . 141959)) (143745 145825 (\EOF.ACTION 143755 . 144006) (
\EOSERROR 144008 . 144201) (\GETEOFPTR 144203 . 144385) (\INCFILEPTR 144387 . 144737) (\PEEKBIN 144739
. 144930) (\SETCLOSEDFILELENGTH 144932 . 145266) (\SETEOFPTR 145268 . 145456) (\SETFILEPTR 145458 .
145823)) (145826 146368 (\FIXPOUT 145836 . 146136) (\FIXPIN 146138 . 146366)) (146369 146935 (\BOUTEOL
146379 . 146933)) (149831 159695 (\BUFFERED.BIN 149841 . 150693) (\BUFFERED.PEEKBIN 150695 . 151477)
(\BUFFERED.BOUT 151479 . 152339) (\BUFFERED.BINS 152341 . 156026) (\BUFFERED.BOUTS 156028 . 157829) (
\BUFFERED.COPYBYTES 157831 . 159693)))))
(FILEMAP (NIL (27459 31265 (STREAMPROP 27469 . 27903) (GETSTREAMPROP 27905 . 28500) (PUTSTREAMPROP
28502 . 31113) (STREAMP 31115 . 31263)) (31308 33827 (\DEFPRINT.BY.NAME 31318 . 32470) (
\STREAM.DEFPRINT 32472 . 33520) (\FDEV.DEFPRINT 33522 . 33825)) (34085 39126 (\GETACCESS 34095 . 34549
) (\SETACCESS 34551 . 39124)) (59352 65321 (\DEFINEDEVICE 59362 . 61678) (\GETDEVICEFROMNAME 61680 .
62153) (\GETDEVICEFROMHOSTNAME 62155 . 63199) (\REMOVEDEVICE 63201 . 64324) (\REMOVEDEVICE.NAMES 64326
. 65319)) (65361 90252 (\CLOSEFILE 65371 . 66196) (\DELETEFILE 66198 . 66492) (\DEVICEEVENT 66494 .
68264) (\GENERATEFILES 68266 . 69213) (\GENERATENEXTFILE 69215 . 69866) (\GENERATEFILEINFO 69868 .
70329) (\GETFILENAME 70331 . 70720) (\GENERIC.OUTFILEP 70722 . 71192) (\OPENFILE 71194 . 73772) (
\DO.PARAMS.AT.OPEN 73774 . 76089) (\RENAMEFILE 76091 . 76515) (\REVALIDATEFILE 76517 . 79119) (
\PAGED.REVALIDATEFILELST 79121 . 80679) (\PAGED.REVALIDATEFILES 80681 . 82400) (\PAGED.REVALIDATEFILE
82402 . 84685) (\BUFFERED.REVALIDATEFILE 84687 . 86973) (\BUFFERED.REVALIDATEFILELST 86975 . 88159) (
\PRINT-REVALIDATION-RESULT 88161 . 88576) (\TRUNCATEFILE 88578 . 88969) (\FILE-CONFLICT 88971 . 90250)
) (90288 94951 (\GENERATENOFILES 90298 . 92394) (\NULLFILEGENERATOR 92396 . 92640) (\NOFILESNEXTFILEFN
92642 . 94633) (\NOFILESINFOFN 94635 . 94949)) (95070 96978 (\FILE.NOT.OPEN 95080 . 95593) (
\FILE.WONT.OPEN 95595 . 95923) (\ILLEGAL.DEVICEOP 95925 . 96207) (\IS.NOT.RANDACCESSP 96209 . 96655) (
\STREAM.NOT.OPEN 96657 . 96976)) (97113 99411 (\FDEVINSTANCE 97123 . 99409)) (100613 107987 (CNDIR
100623 . 101928) (DIRECTORYNAME 101930 . 106113) (DIRECTORYNAMEP 106115 . 106731) (HOSTNAMEP 106733 .
107540) (\ADD.CONNECTED.DIR 107542 . 107985)) (108032 136305 (\BACKFILEPTR 108042 . 108230) (
\BACKPEEKBIN 108232 . 108593) (\BACKBIN 108595 . 108946) (BIN 108948 . 109165) (\BIN 109167 . 109444)
(\BINS 109446 . 109732) (BOUT 109734 . 110096) (\BOUT 110098 . 110413) (\BOUTS 110415 . 110726) (
COPYBYTES 110728 . 114060) (COPYCHARS 114062 . 117728) (COPYFILE 117730 . 118794) (\COPYOPENFILE
118796 . 121995) (\INFER.FILE.TYPE 121997 . 122951) (EOFP 122953 . 123250) (FORCEOUTPUT 123252 .
123499) (\FLUSH.OPEN.STREAMS 123501 . 123857) (CHARSET 123859 . 125523) (ACCESS-CHARSET 125525 .
125742) (GETEOFPTR 125744 . 125994) (GETFILEINFO 125996 . 129189) (\TYPE.FROM.FILETYPE 129191 . 129661
) (\FILETYPE.FROM.TYPE 129663 . 129842) (GETFILEPTR 129844 . 130096) (SETFILEINFO 130098 . 134204) (
SETFILEPTR 134206 . 135925) (BOUT16 135927 . 136112) (BIN16 136114 . 136303)) (136408 141724 (
\GENERIC.BINS 136418 . 136698) (\GENERIC.BOUTS 136700 . 136965) (\GENERIC.RENAMEFILE 136967 . 138798)
(\GENERIC.OPENP 138800 . 140115) (\GENERIC.READP 140117 . 141269) (\GENERIC.CHARSET 141271 . 141722))
(141725 142064 (\MAP-OPEN-STREAMS 141735 . 142062)) (143848 145928 (\EOF.ACTION 143858 . 144109) (
\EOSERROR 144111 . 144304) (\GETEOFPTR 144306 . 144488) (\INCFILEPTR 144490 . 144840) (\PEEKBIN 144842
. 145033) (\SETCLOSEDFILELENGTH 145035 . 145369) (\SETEOFPTR 145371 . 145559) (\SETFILEPTR 145561 .
145926)) (145929 146471 (\FIXPOUT 145939 . 146239) (\FIXPIN 146241 . 146469)) (146472 147038 (\BOUTEOL
146482 . 147036)) (149934 159798 (\BUFFERED.BIN 149944 . 150796) (\BUFFERED.PEEKBIN 150798 . 151580)
(\BUFFERED.BOUT 151582 . 152442) (\BUFFERED.BINS 152444 . 156129) (\BUFFERED.BOUTS 156131 . 157932) (
\BUFFERED.COPYBYTES 157934 . 159796)))))
STOP

BIN
sources/FILEIO.LCOM
View File

Binary file not shown.

38
sources/FILEPKG
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Jul-2022 22:10:13" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEPKG.;36 280887
(FILECREATED "19-Jul-2022 22:34:15" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEPKG.;37 280917
:CHANGES-TO (FNS EDITCALLERS)
:PREVIOUS-DATE "30-Jun-2022 20:19:02"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEPKG.;35)
:PREVIOUS-DATE " 9-Jul-2022 22:10:13"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>FILEPKG.;36)
(* ; "
@@ -3111,14 +3111,14 @@ compiling " T)
(ADDTOVAR USERMACROS
(M NIL (MAKE FILE FILE))
(M (X . Y)
(E (MARKASCHANGED (COND ((LISTP 'X)
(CAR 'X))
(T 'X))
'USERMACROS)
T)
(ORIGINAL (M X . Y))))
(ORIGINAL (M X . Y)))
(M NIL (MAKE FILE FILE)))
(ADDTOVAR EDITMACROS
(M (X . Y)
@@ -4408,6 +4408,8 @@ compiling " T)
(EDITCALLERS
[LAMBDA (ATOMS FILES COMS)
(* ;; "Edited 19-Jul-2022 22:33 by rmk")
(* ;; "Edited 9-Jul-2022 22:09 by rmk")
(* ;; "Edited 30-Jun-2022 20:18 by rmk: Make confirmation of separator boundaries as a posttest on successful matches rather than a case-array test. This means this can run at byte-level FFILEPOS speed for arbitrary external formats.")
@@ -4472,7 +4474,7 @@ compiling " T)
 "Keep MKSTRING from putting a prefix on")
(SETQ ATOM (MKSTRING ATOM T RDTBL))))
(LIST ATOM PREESCAPE POSTESCAPE])
(for PATTERN NEXTCODE HIT (CABASE _ (FETCH (ARRAYP BASE) OF CA))
(for PATTERN CODE HIT (CABASE _ (FETCH (ARRAYP BASE) OF CA))
(CASIZE _ (FETCH (ARRAYP LENGTH) OF CA))
(CAFAT _ (EQ \ST.POS16 (FETCH (ARRAYP TYP) OF CA))) in PATTERNS
do
@@ -4485,13 +4487,13 @@ compiling " T)
FILESTREAM I NIL NIL 'BOTH]
when [AND [OR (CADR PATTERN)
(PROGN (SETFILEPTR FILESTREAM (CAR HIT))
(PROG1 [OR (NOT (\BACKCCODE FILESTREAM))
(ZEROP (\CATRANSLATE CABASE CASIZE CAFAT
(\INCCODE FILESTREAM]
(PROG1 (OR (NOT (SETQ CODE (\BACKCCODE FILESTREAM)))
(ZEROP (\CATRANSLATE CABASE CASIZE CAFAT CODE
)))
(\SETFILEPTR FILESTREAM I]
(OR (CADDR PATTERN)
(NOT (SETQ NEXTCODE (\PEEKCCODE.NOEOLC FILESTREAM T)))
(ZEROP (\CATRANSLATE CABASE CASIZE CAFAT NEXTCODE]
(NOT (SETQ CODE (\PEEKCCODE FILESTREAM T)))
(ZEROP (\CATRANSLATE CABASE CASIZE CAFAT CODE]
do
(* ;; "The next search begins after the last search, since I is the tail of a match, even if the fileptr is set to 0 to get the map")
@@ -4982,10 +4984,10 @@ GETDEFFROMFILE 197000 . 201280) (GETDEFSAVED 201282 . 202386) (PUTDEF 202388 . 2
(DWIMDEF 207291 . 208145) (DELDEF 208147 . 211161) (DELFROMLIST 211163 . 211667) (HASDEF 211669 .
217991) (GETFILEDEF 217993 . 218515) (SAVEDEF 218517 . 220176) (UNSAVEDEF 220178 . 221074) (
COMPAREDEFS 221076 . 224886) (COMPARE 224888 . 225592) (TYPESOF 225594 . 229854)) (230006 238777 (
FILEPKGCOM 230016 . 234949) (FILEPKGTYPE 234951 . 238775)) (250810 267277 (FINDCALLERS 250820 . 251335
) (EDITCALLERS 251337 . 260782) (EDITFROMFILE 260784 . 266592) (FINDATS 266594 . 266866) (LOOKIN
266868 . 267275)) (267278 269005 (SEPRCASE 267288 . 269003)) (269522 275079 (IMPORTFILE 269532 .
270506) (IMPORTEVAL 270508 . 271388) (IMPORTFILESCAN 271390 . 271811) (CHECKIMPORTS 271813 . 273149) (
GATHEREXPORTS 273151 . 274489) (\DUMPEXPORTS 274491 . 275077)) (275417 277625 (CLEARFILEPKG 275427 .
277623)))))
FILEPKGCOM 230016 . 234949) (FILEPKGTYPE 234951 . 238775)) (250810 267307 (FINDCALLERS 250820 . 251335
) (EDITCALLERS 251337 . 260812) (EDITFROMFILE 260814 . 266622) (FINDATS 266624 . 266896) (LOOKIN
266898 . 267305)) (267308 269035 (SEPRCASE 267318 . 269033)) (269552 275109 (IMPORTFILE 269562 .
270536) (IMPORTEVAL 270538 . 271418) (IMPORTFILESCAN 271420 . 271841) (CHECKIMPORTS 271843 . 273179) (
GATHEREXPORTS 273181 . 274519) (\DUMPEXPORTS 274521 . 275107)) (275447 277655 (CLEARFILEPKG 275457 .
277653)))))
STOP

BIN
sources/FILEPKG.LCOM
View File

Binary file not shown.

138
sources/HARDCOPY
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 8-Oct-2021 22:23:49" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;13 103499
(FILECREATED "20-Jul-2022 17:14:14" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>HARDCOPY.;7 103298
changes to%: (FNS COPY.TEXT.TO.IMAGE)
:CHANGES-TO (FNS COPY.TEXT.TO.IMAGE)
previous date%: " 7-Oct-2021 10:43:32"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;12)
:PREVIOUS-DATE "19-Jul-2022 23:40:21"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>HARDCOPY.;6)
(* ; "
@@ -27,7 +27,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(* ; "filename diddlers")
(FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
(COMS (* ;
 "Interface for PRINTERS and IMAGEFILES")
 "Interface for PRINTERS and IMAGEFILES")
(FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS
HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE
PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE
@@ -44,19 +44,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES
PRINTFILETYPES))
(COMS (* ;
 "Converting text files to imagestreams")
 "Converting text files to imagestreams")
(INITVARS (TEXTDEFAULTTABS (LIST 20320))
(TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
(* ;
 "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
 "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
(FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
(COMS (FNS \BLTSHADE.GENERICPRINTER)
(* ;
 "hack for printers that can't really BLTSHADE")
 "hack for printers that can't really BLTSHADE")
)
[COMS (* ;
 "stuff to support hardcopy streams on the display.")
 "stuff to support hardcopy streams on the display.")
(FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY
\DSPFONT.HDCPYDISPLAY \DSPRIGHTMARGIN.HDCPYDISPLAY \DSPXPOSITION.HDCPYDISPLAY
\DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \STRINGWIDTH.HCPYDISPLAYAUX
@@ -68,7 +68,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
[COMS (* ;
 "Stuff to support MICA-unit hardcopy streams on the display")
 "Stuff to support MICA-unit hardcopy streams on the display")
(FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE
\BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE
\DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE
@@ -723,7 +723,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(CLOSEF IMAGESTREAM])])
(COPY.TEXT.TO.IMAGE
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 8-Oct-2021 22:23 by rmk:")
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk")
(* ; "Edited 8-Oct-2021 22:23 by rmk:")
(* ; "Edited 10-Apr-95 21:23 by rmk:")
(* ;; "Copy text to an image stream, obeying PSPOOL control characters")
@@ -737,31 +738,31 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
(* ;;
"RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")
 "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")
(SETFILEINFO INSTRM 'ENDOFSTREAMOP (FUNCTION NILL))
[while (SETQ C (\INCCODE INSTRM))
[while (SETQ C (\INCCODE.EOLC INSTRM ANY.EOLC))
do
(COND
((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
RIGHTMAR)) (* ;
 "Not to walk off the right edge of the paper")
 "Not to walk off the right edge of the paper")
(TERPRI IMAGESTREAM)))
(COND
([> C (CONSTANT (APPLY (FUNCTION MAX)
(CHARCODE (^F CR LF ^L TAB]
(CHARCODE (^F CR LF ^L EOL TAB]
(\OUTCHAR IMAGESTREAM C))
(T
(SELCHARQ C
(^F (* ; "Font shift")
(* ;;
 "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")
 "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")
(DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
1)
IMAGESTREAM)
[SELCHARQ (SETQ FC (\INCCODE INSTRM))
[SELCHARQ (SETQ FC (\INCCODE.EOLC INSTRM ANY.EOLC))
(^T (* ; "tab to absolute pos.")
(CL:UNLESS (SETQ FC (\INCCODE INSTRM))
(\OUTCHAR IMAGESTREAM (CHARCODE ^F))
@@ -773,14 +774,12 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
[SETQ FC
(IF TABS
THEN (OR (CAR (NTH TABS FC))
(ERROR "Undefined absolute tab number" FC))
(ERROR "Undefined absolute tab number" FC))
ELSE (TIMES FC (OR DEFAULTTAB
(SETQ DEFAULTTAB
(TIMES 8 (CHARWIDTH (CHARCODE SPACE)
(FONTCREATE (ELT FONTARRAY 1
)
NIL NIL NIL
IMAGESTREAM]
(SETQ DEFAULTTAB
(TIMES 8 (CHARWIDTH (CHARCODE SPACE)
(FONTCREATE (ELT FONTARRAY 1)
NIL NIL NIL IMAGESTREAM]
(DSPXPOSITION FC IMAGESTREAM))
(NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(* ; "EOS after ^F")
@@ -792,16 +791,10 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
IMAGESTREAM))
(T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(\OUTCHAR IMAGESTREAM FC])
(CR
(* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text. Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file
as a carriage-return. But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously. Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, wh
ich is to treat all instances of CR, CRLF, and LF as end-of-line.")
(EOL
(* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text. Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file as a carriage-return. But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously. Given that just this information can be lost in text-mode file transfers, we adopt here the 99%% correct solution, which is to treat all instances of CR, CRLF, and LF as end-of-line (ANY.EOLC above)")
(COND
((EQ (CHARCODE LF)
(\PEEKCCODE.NOEOLC INSTRM T))
(\INCCODE INSTRM)))
(TERPRI IMAGESTREAM))
(TERPRI IMAGESTREAM))
(LF (* ; "Isolatedx LF, see comment at CR")
(TERPRI IMAGESTREAM))
(TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
@@ -1066,9 +1059,9 @@ ich is to treat all instances of CR, CRLF, and LF as end-of-line.")
)
(ADDTOVAR IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS))
(INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS)))
(CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS))
(INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)
(CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS)))
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\HCPYMODEDISPLAYINIT)
@@ -1084,39 +1077,40 @@ ich is to treat all instances of CR, CRLF, and LF as end-of-line.")
(PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
1993 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6184 10368 (HARDCOPY.SOMEHOW 6194 . 7552) (HARDCOPYIMAGEW 7554 . 7706) (
HARDCOPYIMAGEW.TOFILE 7708 . 8016) (HARDCOPYIMAGEW.TOPRINTER 8018 . 8683) (HARDCOPYREGION.TOFILE 8685
. 8983) (HARDCOPYREGION.TOPRINTER 8985 . 9607) (COPY.WINDOW.TO.BITMAP 9609 . 10366)) (10440 20990 (
MakeMenuOfPrinters 10450 . 11675) (PRINTERS.WHENSELECTEDFN 11677 . 13419) (MakeMenuOfImageTypes 13421
. 13939) (GetNewPrinterFromUser 13941 . 14369) (PopUpWindowAndGetAtom 14371 . 15756) (
PopUpWindowAndGetList 15758 . 17324) (NewPrinter 17326 . 18274) (GetPrinterName 18276 . 18556) (
GetImageFile 18558 . 20845) (FetchDefaultPrinter 20847 . 20988)) (21025 21563 (
ExtensionForPrintFileType 21035 . 21228) (PRINTFILETYPE.FROM.EXTENSION 21230 . 21561)) (21618 38002 (
DEFAULTPRINTER 21628 . 21788) (CAN.PRINT.DIRECTLY 21790 . 21946) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
21948 . 22992) (EMPRESS 22994 . 23307) (HARDCOPYW 23309 . 26269) (LISTFILES1 26271 . 26444) (
PRINTER.BITMAPFILE 26446 . 26693) (PRINTER.BITMAPSCALE 26695 . 26960) (PRINTER.SCRATCH.FILE 26962 .
27085) (PRINTERPROP 27087 . 27270) (PRINTERSTATUS 27272 . 27461) (PRINTERTYPE 27463 . 29772) (
PRINTERNAME 29774 . 30076) (PRINTFILEPROP 30078 . 30269) (PRINTFILETYPE 30271 . 32215) (
\EXPECTED.FILE.TYPE 32217 . 32999) (SEND.FILE.TO.PRINTER 33001 . 38000)) (38003 42985 (PRINTERDEVICE
38013 . 42983)) (43800 51762 (TEXTTOIMAGEFILE 43810 . 46000) (COPY.TEXT.TO.IMAGE 46002 . 51760)) (
51763 52898 (\BLTSHADE.GENERICPRINTER 51773 . 52896)) (53026 71778 (MAKEHARDCOPYSTREAM 53036 . 54040)
(UNMAKEHARDCOPYSTREAM 54042 . 54726) (HARDCOPYSTREAMTYPE 54728 . 55007) (\CHARWIDTH.HDCPYDISPLAY 55009
. 55440) (\DSPFONT.HDCPYDISPLAY 55442 . 56847) (\DSPRIGHTMARGIN.HDCPYDISPLAY 56849 . 57426) (
\DSPXPOSITION.HDCPYDISPLAY 57428 . 57689) (\DSPYPOSITION.HDCPYDISPLAY 57691 . 57952) (
\STRINGWIDTH.HDCPYDISPLAY 57954 . 58461) (\STRINGWIDTH.HCPYDISPLAYAUX 58463 . 60795) (\HDCPYBLTCHAR
60797 . 63332) (\HDCPYDISPLAY.FIX.XPOS 63334 . 63754) (\HDCPYDISPLAY.FIX.YPOS 63756 . 64176) (
\HDCPYDISPLAYINIT 64178 . 64955) (\HDCPYDSPPRINTCHAR 64957 . 67117) (\SLOWHDCPYBLTCHAR 67119 . 70622)
(\CHANGECHARSET.HDCPYDISPLAY 70624 . 71776)) (72500 102797 (MAKEHARDCOPYMODESTREAM 72510 . 74419) (
UNMAKEHARDCOPYMODESTREAM 74421 . 75499) (\BLTSHADE.HCPYMODE 75501 . 75948) (\BITBLT.HCPYMODE 75950 .
76572) (\BRUSHCONVERT.HCPYMODE 76574 . 76811) (\CHANGECHARSET.HCPYMODE 76813 . 78580) (
\DASHINGCONVERT.HCPYMODE 78582 . 78845) (\CHARWIDTH.HCPYMODE 78847 . 79134) (\DRAWLINE.HCPYMODE 79136
. 79448) (\DRAWCURVE.HCPYMODE 79450 . 79879) (\DRAWCIRCLE.HCPYMODE 79881 . 80276) (
\DRAWELLIPSE.HCPYMODE 80278 . 80790) (\DSPFONT.HCPYMODE 80792 . 81948) (\DSPLEFTMARGIN.HCPYMODE 81950
. 82534) (\DSPLINEFEED.HCPYMODE 82536 . 82946) (\DSPRIGHTMARGIN.HCPYMODE 82948 . 83577) (
\DSPSPACEFACTOR.HCPYMODE 83579 . 84100) (\DSPXPOSITION.HCPYMODE 84102 . 84683) (\DSPYPOSITION.HCPYMODE
84685 . 85090) (\MOVETO.HCPYMODE 85092 . 85244) (\FONTCREATE.HCPYMODE.PRESS 85246 . 86258) (
\CREATECHARSET.HCPYMODE.PRESS 86260 . 87231) (\FONTCREATE.HCPYMODE.INTERPRESS 87233 . 88267) (
\CREATECHARSET.HCPYMODE.INTERPRESS 88269 . 89257) (\STRINGWIDTH.HCPYMODE 89259 . 89693) (
\HCPYMODEBLTCHAR 89695 . 92664) (\HCPYMODEDISPLAYINIT 92666 . 95597) (\HCPYMODEDSPPRINTCHAR 95599 .
97780) (\SLOWHCPYMODEBLTCHAR 97782 . 101296) (\SFFixY.HCPYMODE 101298 . 102795)))))
(FILEMAP (NIL (6199 10383 (HARDCOPY.SOMEHOW 6209 . 7567) (HARDCOPYIMAGEW 7569 . 7721) (
HARDCOPYIMAGEW.TOFILE 7723 . 8031) (HARDCOPYIMAGEW.TOPRINTER 8033 . 8698) (HARDCOPYREGION.TOFILE 8700
. 8998) (HARDCOPYREGION.TOPRINTER 9000 . 9622) (COPY.WINDOW.TO.BITMAP 9624 . 10381)) (10455 21005 (
MakeMenuOfPrinters 10465 . 11690) (PRINTERS.WHENSELECTEDFN 11692 . 13434) (MakeMenuOfImageTypes 13436
. 13954) (GetNewPrinterFromUser 13956 . 14384) (PopUpWindowAndGetAtom 14386 . 15771) (
PopUpWindowAndGetList 15773 . 17339) (NewPrinter 17341 . 18289) (GetPrinterName 18291 . 18571) (
GetImageFile 18573 . 20860) (FetchDefaultPrinter 20862 . 21003)) (21040 21578 (
ExtensionForPrintFileType 21050 . 21243) (PRINTFILETYPE.FROM.EXTENSION 21245 . 21576)) (21633 38017 (
DEFAULTPRINTER 21643 . 21803) (CAN.PRINT.DIRECTLY 21805 . 21961) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
21963 . 23007) (EMPRESS 23009 . 23322) (HARDCOPYW 23324 . 26284) (LISTFILES1 26286 . 26459) (
PRINTER.BITMAPFILE 26461 . 26708) (PRINTER.BITMAPSCALE 26710 . 26975) (PRINTER.SCRATCH.FILE 26977 .
27100) (PRINTERPROP 27102 . 27285) (PRINTERSTATUS 27287 . 27476) (PRINTERTYPE 27478 . 29787) (
PRINTERNAME 29789 . 30091) (PRINTFILEPROP 30093 . 30284) (PRINTFILETYPE 30286 . 32230) (
\EXPECTED.FILE.TYPE 32232 . 33014) (SEND.FILE.TO.PRINTER 33016 . 38015)) (38018 43000 (PRINTERDEVICE
38028 . 42998)) (43815 51573 (TEXTTOIMAGEFILE 43825 . 46015) (COPY.TEXT.TO.IMAGE 46017 . 51571)) (
51574 52709 (\BLTSHADE.GENERICPRINTER 51584 . 52707)) (52837 71589 (MAKEHARDCOPYSTREAM 52847 . 53851)
(UNMAKEHARDCOPYSTREAM 53853 . 54537) (HARDCOPYSTREAMTYPE 54539 . 54818) (\CHARWIDTH.HDCPYDISPLAY 54820
. 55251) (\DSPFONT.HDCPYDISPLAY 55253 . 56658) (\DSPRIGHTMARGIN.HDCPYDISPLAY 56660 . 57237) (
\DSPXPOSITION.HDCPYDISPLAY 57239 . 57500) (\DSPYPOSITION.HDCPYDISPLAY 57502 . 57763) (
\STRINGWIDTH.HDCPYDISPLAY 57765 . 58272) (\STRINGWIDTH.HCPYDISPLAYAUX 58274 . 60606) (\HDCPYBLTCHAR
60608 . 63143) (\HDCPYDISPLAY.FIX.XPOS 63145 . 63565) (\HDCPYDISPLAY.FIX.YPOS 63567 . 63987) (
\HDCPYDISPLAYINIT 63989 . 64766) (\HDCPYDSPPRINTCHAR 64768 . 66928) (\SLOWHDCPYBLTCHAR 66930 . 70433)
(\CHANGECHARSET.HDCPYDISPLAY 70435 . 71587)) (71999 72140 (\MICASTOPTS 71999 . 72140)) (72311 102608 (
MAKEHARDCOPYMODESTREAM 72321 . 74230) (UNMAKEHARDCOPYMODESTREAM 74232 . 75310) (\BLTSHADE.HCPYMODE
75312 . 75759) (\BITBLT.HCPYMODE 75761 . 76383) (\BRUSHCONVERT.HCPYMODE 76385 . 76622) (
\CHANGECHARSET.HCPYMODE 76624 . 78391) (\DASHINGCONVERT.HCPYMODE 78393 . 78656) (\CHARWIDTH.HCPYMODE
78658 . 78945) (\DRAWLINE.HCPYMODE 78947 . 79259) (\DRAWCURVE.HCPYMODE 79261 . 79690) (
\DRAWCIRCLE.HCPYMODE 79692 . 80087) (\DRAWELLIPSE.HCPYMODE 80089 . 80601) (\DSPFONT.HCPYMODE 80603 .
81759) (\DSPLEFTMARGIN.HCPYMODE 81761 . 82345) (\DSPLINEFEED.HCPYMODE 82347 . 82757) (
\DSPRIGHTMARGIN.HCPYMODE 82759 . 83388) (\DSPSPACEFACTOR.HCPYMODE 83390 . 83911) (
\DSPXPOSITION.HCPYMODE 83913 . 84494) (\DSPYPOSITION.HCPYMODE 84496 . 84901) (\MOVETO.HCPYMODE 84903
. 85055) (\FONTCREATE.HCPYMODE.PRESS 85057 . 86069) (\CREATECHARSET.HCPYMODE.PRESS 86071 . 87042) (
\FONTCREATE.HCPYMODE.INTERPRESS 87044 . 88078) (\CREATECHARSET.HCPYMODE.INTERPRESS 88080 . 89068) (
\STRINGWIDTH.HCPYMODE 89070 . 89504) (\HCPYMODEBLTCHAR 89506 . 92475) (\HCPYMODEDISPLAYINIT 92477 .
95408) (\HCPYMODEDSPPRINTCHAR 95410 . 97591) (\SLOWHCPYMODEBLTCHAR 97593 . 101107) (\SFFixY.HCPYMODE
101109 . 102606)))))
STOP

BIN
sources/HARDCOPY.LCOM
View File

Binary file not shown.

494
sources/LLREAD
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Sep-2021 19:41:58" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;101 90912
changes to%: (VARS LLREADCOMS)
(FILECREATED "19-Jul-2022 23:36:54" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLREAD.;102 89980
previous date%: "24-Aug-2021 10:04:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;100)
:CHANGES-TO (FNS PEEKCCODE SKIPSEPRCODES \SUBREAD)
:PREVIOUS-DATE "10-Sep-2021 19:41:58"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLREAD.;101)
(* ; "
@@ -47,7 +48,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(INITVARS (*READ-NEWLINE-SUPPRESS*)
(\RefillBufferFn (FUNCTION \READCREFILL)))
(* ;
 "Top level val of \RefillBufferFn means act like READC--we must be doing a raw BIN (or PEEKBIN?)")
 "Top level val of \RefillBufferFn means act like READC--we must be doing a raw BIN (or PEEKBIN?)")
(LOCALVARS . T)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
@@ -80,10 +81,11 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(FCHARACTER (PEEKCCODE STREAM])
(PEEKCCODE
[LAMBDA (FILE NOERROR) (* ; "Edited 3-May-2021 16:47 by rmk:")
[LAMBDA (FILE NOERROR) (* ; "Edited 19-Jul-2022 23:36 by rmk")
(* ; "Edited 3-May-2021 16:47 by rmk:")
(LET ((\RefillBufferFn (FUNCTION \PEEKREFILL)))
(DECLARE (SPECVARS \RefillBufferFn))
(\PEEKCCODE (\GETSTREAM FILE 'INPUT)
(\PEEKCCODE.EOLC (\GETSTREAM FILE 'INPUT)
NOERROR])
(RATOM
@@ -163,18 +165,19 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
NIL])
(SKIPSEPRCODES
[LAMBDA (FILE RDTBL) (* ; "Edited 18-Jun-2021 11:38 by rmk:")
[LAMBDA (FILE RDTBL) (* ; "Edited 19-Jul-2022 23:36 by rmk")
(* ; "Edited 18-Jun-2021 11:38 by rmk:")
(* ;; "Passes over non-separators to peek at the first non-separator on FILE. Returns either last peeked character, or NIL if no non-seprs left in the file.")
(* ;; "Passes over non-separators to peek at the first non-separator on FILE. Returns either last peeked character, or NIL if no non-seprs left in the file.")
(* ;; "Assumes that CR and LF are both seprs so that no EOL processing is needed.")
(* ;; "Assumes that CR and LF are both seprs so that no EOL processing is needed.")
(bind PREVC C (STRM _ (\GETSTREAM FILE 'INPUT))
(SA _ (fetch (READTABLEP READSA) of (\GTREADTABLE RDTBL)))
(\RefillBufferFn _ '\PEEKREFILL) declare (SPECVARS \RefillBufferFn)
while [EQ SEPRCHAR.RC (\SYNCODE SA (SETQ C (OR (\PEEKCCODE STRM T)
(RETURN] do (SETQ PREVC C)
(\INCCODE STRM)
(SA _ (fetch (READTABLEP READSA) of (\GTREADTABLE RDTBL)))
(\RefillBufferFn _ '\PEEKREFILL) declare (SPECVARS \RefillBufferFn)
while [EQ SEPRCHAR.RC (\SYNCODE SA (SETQ C (OR (\PEEKCCODE.EOLC STRM T)
(RETURN] do (SETQ PREVC C)
(\INCCODE STRM)
finally (AND PREVC (replace (STREAM LASTCCODE) of STRM with PREVC))
(RETURN C])
@@ -622,27 +625,28 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(REPLACE ENDOFSTREAMOP OF STREAM WITH OLD-EOS-OP))])
(\SUBREAD
[LAMBDA (STRM SA READTYPE PNSTR CASEBASE EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE)
(* ; "Edited 6-Aug-2021 21:40 by rmk:")
[LAMBDA (STRM SA READTYPE PNSTR CASEBASE EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE)
(* ; "Edited 19-Jul-2022 23:36 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")
(* ;; "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")
(* ;; "PNSTR is an instance of the global resource \PNAMESTRING, acquired in READ and passed on from level to level. It is released during read-macro applications, then reacquired.")
(* ;; "PNSTR is an instance of the global resource \PNAMESTRING, acquired in READ and passed on from level to level. It is released during read-macro applications, then reacquired.")
(* ;; "CASEBASE is base of uppercasearray if read table is case-insensitive.")
(* ;; "CASEBASE is base of uppercasearray if read table is case-insensitive.")
(* ;; "If EOF-SUPPRESS is true, then if we are at end of file we should return EOF-VALUE instead of erroring (we need this because we might actually be sitting before end of file in front of something that reads nothing, e.g., a comment, so caller can't check EOFP itself). Always false on recursive calls.")
(* ;; "If EOF-SUPPRESS is true, then if we are at end of file we should return EOF-VALUE instead of erroring (we need this because we might actually be sitting before end of file in front of something that reads nothing, e.g., a comment, so caller can't check EOFP itself). Always false on recursive calls.")
(* ;; "If CHAR is supplied, it is a character code which, when read (in isolation), should terminate this call to read. Never on when at top-level.")
(* ;; "If CHAR is supplied, it is a character code which, when read (in isolation), should terminate this call to read. Never on when at top-level.")
(* ;; "\RBFLG is propagated for top-level calls, in case they are embedded in read-macros. SKREAD also depends on this.")
(* ;; "\RBFLG is propagated for top-level calls, in case they are embedded in read-macros. SKREAD also depends on this.")
(* ;;
 "If PRESERVE-WHITESPACE is true, doesn't throw away the whitespace that terminates the read.")
(* ;;
 "If PRESERVE-WHITESPACE is true, doesn't throw away the whitespace that terminates the read.")
(DECLARE (USEDFREE *READTABLE* \RBFLG))
(* ;; "\RDCONC is a macro that adds a new element as specified by its first argument to the current sublist. Its other arguments will be executed instead if we are the top-level call")
(* ;; "\RDCONC is a macro that adds a new element as specified by its first argument to the current sublist. Its other arguments will be executed instead if we are the top-level call")
(PROG ((TOPLEVELP (SELECTC READTYPE
((LIST READ.RT RATOM.RT)
@@ -653,221 +657,211 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
EXTRASEGMENTS LASTC)
(if (AND TOPLEVELP (NOT (\INTERMP STRM)))
then
(* ;; "EOF is allowed to terminate tokens on direct READ calls. Not if reading from terminal, because \FILLBUFFER made sure to put something at the end.")
(* ;; "EOF is allowed to terminate tokens on direct READ calls. Not if reading from terminal, because \FILLBUFFER made sure to put something at the end.")
(SETQ EOF-POSSIBILITY T))
(SETQ EOF-POSSIBILITY T))
NEWTOKEN
(* ;; "Here ready to scan a new token. First skip over separator characters")
(* ;; "Here ready to scan a new token. First skip over separator characters")
(SETQ J 0)
[SETQ EXTRASEGMENTS (SETQ INVALIDFLG (SETQ ESCAPEFLG (SETQ PACKAGE (SETQ NCOLONS NIL]
(if (AND EOF-SUPPRESS (NULL (SKIPSEPRCODES STRM)))
then (* ;
 "caller specified eof-error-p of NIL. Happens only on top-level calls")
(RETURN EOF-VALUE)) (* ; "By Skipping Separator Characters,Happens CHARSET-Mode Exchanging. (Solution of AR#114 in FX, edited by tt [Jan-22-'90])")
(repeatwhile (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE STRM]
SEPRCHAR.RC))
then (* ;
 "caller specified eof-error-p of NIL. Happens only on top-level calls")
(RETURN EOF-VALUE)) (* ; "By Skipping Separator Characters,Happens CHARSET-Mode Exchanging. (Solution of AR#114 in FX, edited by tt [Jan-22-'90])")
(repeatwhile (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE STRM]
SEPRCHAR.RC))
(COND
((EQ CH CHAR) (* ;
 "Read desired terminating char. TOPLEVELP is always false here")
(freplace (STREAM LASTCCODE) of STRM with CH)
(* ; "Save last char for LASTC.")
((EQ CH CHAR) (* ;
 "Read desired terminating char. TOPLEVELP is always false here")
(freplace (STREAM LASTCCODE) of STRM with CH) (* ; "Save last char for LASTC.")
(RETURN LST))
((EQ SNX OTHER.RC) (* ; "Start of an atom")
((EQ SNX OTHER.RC) (* ; "Start of an atom")
(COND
([AND (EQ CH (CHARCODE %.))
(fetch STOPATOM of (\SYNCODE SA (\PEEKCCODE STRM]
(fetch STOPATOM of (\SYNCODE SA (\PEEKCCODE.EOLC STRM]
(* ;; "An isolated, unescaped dot. This special check on every atom could be eliminated if . had a special SNX code")
(* ;; "An isolated, unescaped dot. This special check on every atom could be eliminated if . had a special SNX code")
(SETQ DOTLOC END) (* ;
 "DOTLOC points to CONS cell one before the dot, NIL for car of list, as desired.")
(SETQ DOTLOC END) (* ;
 "DOTLOC points to CONS cell one before the dot, NIL for car of list, as desired.")
))
(GO GOTATOMCHAR))
[(fetch STOPATOM of SNX) (* ;
 "This character definitely does not start an atom")
[(fetch STOPATOM of SNX) (* ;
 "This character definitely does not start an atom")
(COND
((EQ READTYPE RATOM.RT)
(GO SINGLECHARATOM))
(T (GO BREAK]
((EQ SNX PACKAGEDELIM.RC) (* ;
 "Starting a symbol with a package delimiter -- must be a keyword")
((EQ SNX PACKAGEDELIM.RC) (* ;
 "Starting a symbol with a package delimiter -- must be a keyword")
(SETQ NCOLONS 1)
(SETQ PACKAGE *KEYWORD-PACKAGE*)
(SETQ ESCAPEFLG T)
(GO NEXTATOMCHAR))
[(AND (SELECTC (fetch MACROCONTEXT of SNX)
(FIRST.RMC T)
(ALONE.RMC (fetch STOPATOM of (\SYNCODE SA (\PEEKCCODE STRM))))
(ALONE.RMC (fetch STOPATOM of (\SYNCODE SA (\PEEKCCODE.EOLC STRM))))
NIL)
(fetch READMACROFLG of *READTABLE*))
(COND
((EQ READTYPE RATOM.RT)
(GO SINGLECHARATOM))
(T (GO MACRO]
(T (* ;
 "Some character that starts an atom but has non-trivial syntax attributes")
(T (* ;
 "Some character that starts an atom but has non-trivial syntax attributes")
))
ATOMLOOP
(* ;; "At this point, we are accumulating an atom, and CH does not have syntax OTHER, so we have to check special cases")
(* ;; "At this point, we are accumulating an atom, and CH does not have syntax OTHER, so we have to check special cases")
(SELECTC SNX
(ESCAPE.RC (* ;
 "Take next character to be alphabetic, case exact")
(ESCAPE.RC (* ;
 "Take next character to be alphabetic, case exact")
(COND
((fetch ESCAPEFLG of *READTABLE*)
(SETQ CH (\INCCODE.EOLC STRM))
(* ;
 "No EOFP check needed -- it's an error to have escape char with nothing following")
(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))))
(MULTIPLE-ESCAPE.RC
(* ;; "Take characters up to next multiple escape to be alphabetic, except that single escape chars still escape the next char")
(* ;; "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 (\INCCODE.EOLC STRM))
(COND
([NOT (COND
(ESCFLG (SETQ ESCFLG NIL))
(T (SELECTC (SETQ SNX (\SYNCODE SA CH))
(MULTIPLE-ESCAPE.RC
(* ;
 "Finished escaped sequence, resume normal processing")
(GO NEXTATOMCHAR))
(ESCAPE.RC
(* ;
 "Pass the next char thru verbatim")
(SETQ ESCFLG T))
NIL]
(* ;
 "All others are pname chars, quoted")
(if (NOT *READ-SUPPRESS*)
then (COND
((EQ J \PNAMELIMIT)
(* ;
 "if there have been escapes, can't be a number, so ok to error now.")
(LISPERROR "ATOM TOO LONG"
(\SUBREADCONCAT
EXTRASEGMENTS PBASE J))
(GO NEWTOKEN)))
(\PNAMESTRINGPUTCHAR PBASE J CH)
(add J 1])
[bind ESCFLG do (SETQ CH (\INCCODE.EOLC STRM))
(COND
([NOT (COND
(ESCFLG (SETQ ESCFLG NIL))
(T (SELECTC (SETQ SNX (\SYNCODE SA CH))
(MULTIPLE-ESCAPE.RC
(* ;
 "Finished escaped sequence, resume normal processing")
(GO NEXTATOMCHAR))
(ESCAPE.RC
(* ; "Pass the next char thru verbatim")
(SETQ ESCFLG T))
NIL] (* ;
 "All others are pname chars, quoted")
(if (NOT *READ-SUPPRESS*)
then (COND
((EQ J \PNAMELIMIT)
(* ;
 "if there have been escapes, can't be a number, so ok to error now.")
(LISPERROR "ATOM TOO LONG" (\SUBREADCONCAT
EXTRASEGMENTS
PBASE J))
(GO NEWTOKEN)))
(\PNAMESTRINGPUTCHAR PBASE J CH)
(add J 1])
NIL)
GOTATOMCHAR
(* ;; "CH is a vanilla atom char to accumulate")
(* ;; "CH is a vanilla atom char to accumulate")
[COND
((AND CASEBASE (ILEQ CH \MAXTHINCHAR)) (* ; "Uppercase atom characters")
((AND CASEBASE (ILEQ CH \MAXTHINCHAR)) (* ; "Uppercase atom characters")
(SETQ CH (\GETBASEBYTE CASEBASE CH]
PUTATOMCHAR
(if (NOT *READ-SUPPRESS*)
then (COND
((EQ J \PNAMELIMIT) (* ; "Symbol is too long. However, it could just be a bignum, so keep accumulating characters until we have to do something.")
(push EXTRASEGMENTS (\SMASHSTRING (ALLOCSTRING J NIL NIL T)
0 PNSTR J))
(SETQ J 0)))
(\PNAMESTRINGPUTCHAR PBASE J CH)
(add J 1)
(SETQ LASTC CH) (* ; "Save CH for LASTC."))
((EQ J \PNAMELIMIT) (* ; "Symbol is too long. However, it could just be a bignum, so keep accumulating characters until we have to do something.")
(push EXTRASEGMENTS (\SMASHSTRING (ALLOCSTRING J NIL NIL T)
0 PNSTR J))
(SETQ J 0)))
(\PNAMESTRINGPUTCHAR PBASE J CH)
(add J 1)
(SETQ LASTC CH) (* ; "Save CH for LASTC."))
NEXTATOMCHAR
(if (AND EOF-POSSIBILITY (SETQ AT-EOF (\EOFP STRM)))
then (* ;
 "EOF terminates atoms at top level")
(GO FINISHATOM)
elseif (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE STRM]
OTHER.RC)
then (* ;
 "normal case tested first--another vanilla constituent char, so keep accumulating atom chars")
(GO GOTATOMCHAR)
then (* ; "EOF terminates atoms at top level")
(GO FINISHATOM)
elseif (EQ [SETQ SNX (\SYNCODE SA (SETQ CH (\INCCODE STRM]
OTHER.RC)
then (* ;
 "normal case tested first--another vanilla constituent char, so keep accumulating atom chars")
(GO GOTATOMCHAR)
elseif (fetch STOPATOM of SNX)
then (* ; "Terminates atom")
(GO FINISHATOM)
then (* ; "Terminates atom")
(GO FINISHATOM)
elseif (EQ SNX PACKAGEDELIM.RC)
then (GO GOTPACKAGEDELIM)
else (GO ATOMLOOP))
FINISHATOM
(* ;;
 "Come here when an atom has been terminated, either by a break/sepr char or by end of file.")
(* ;;
 "Come here when an atom has been terminated, either by a break/sepr char or by end of file.")
(if INVALIDFLG
then (freplace (STREAM LASTCCODE) of STRM with (OR LASTC CH 65535))
(\INVALID.SYMBOL PBASE J NCOLONS PACKAGE EXTRASEGMENTS))
(\INVALID.SYMBOL PBASE J NCOLONS PACKAGE EXTRASEGMENTS))
[SETQ ELT (AND (NOT *READ-SUPPRESS*)
(if EXTRASEGMENTS
then
(* ;; "More than \PNAMELIMIT chars were read. Can't be a symbol, but might be a number. Pack up all the strings we have into a single string and try to parse it as a number.")
(* ;; "More than \PNAMELIMIT chars were read. Can't be a symbol, but might be a number. Pack up all the strings we have into a single string and try to parse it as a number.")
(SETQ EXTRASEGMENTS (\SUBREADCONCAT EXTRASEGMENTS PBASE J))
(OR (AND (NULL (OR PACKAGE ESCAPEFLG NCOLONS))
(\PARSE.NUMBER (fetch (STRINGP BASE) of
EXTRASEGMENTS
)
(fetch (STRINGP OFFST) of EXTRASEGMENTS)
(fetch (STRINGP LENGTH) of EXTRASEGMENTS)
\FATPNAMESTRINGP))
(LISPERROR "ATOM TOO LONG" EXTRASEGMENTS))
(SETQ EXTRASEGMENTS (\SUBREADCONCAT EXTRASEGMENTS PBASE J))
(OR (AND (NULL (OR PACKAGE ESCAPEFLG NCOLONS))
(\PARSE.NUMBER (fetch (STRINGP BASE) of EXTRASEGMENTS)
(fetch (STRINGP OFFST) of EXTRASEGMENTS)
(fetch (STRINGP LENGTH) of EXTRASEGMENTS)
\FATPNAMESTRINGP))
(LISPERROR "ATOM TOO LONG" EXTRASEGMENTS))
else (\READ.SYMBOL PBASE 0 J \FATPNAMESTRINGP PACKAGE (EQ NCOLONS 1)
ESCAPEFLG]
(freplace (STREAM LASTCCODE) of STRM with CH)
(* ; "Save last READ char for LASTC.")
ESCAPEFLG]
(freplace (STREAM LASTCCODE) of STRM with CH) (* ; "Save last READ char for LASTC.")
(if AT-EOF
then (* ;
 "top-level read, atom terminated by EOF")
(RETURN ELT))
then (* ;
 "top-level read, atom terminated by EOF")
(RETURN ELT))
(\RDCONC ELT (PROGN (COND
((OR PRESERVE-WHITESPACE (NEQ SNX SEPRCHAR.RC))
(* ; "At top-level, put back the terminating character if preserving whitespace or terminator is significant")
(freplace (STREAM LASTCCODE) of STRM
with (OR LASTC CH 65535))
(* ;
 "And LASTC will return the last REAL char read.")
(\BACKCCODE STRM)))
(* ; "At top-level, put back the terminating character if preserving whitespace or terminator is significant")
(freplace (STREAM LASTCCODE) of STRM with (OR LASTC CH 65535))
(* ;
 "And LASTC will return the last REAL char read.")
(\BACKCCODE STRM)))
(RETURN ELT)))
(if (EQ SNX SEPRCHAR.RC)
then (* ;
 "Terminated with sepr, go on to next char")
(GO NEWTOKEN)
then (* ;
 "Terminated with sepr, go on to next char")
(GO NEWTOKEN)
elseif (EQ CH CHAR)
then (* ; "read terminates here")
(freplace (STREAM LASTCCODE) of STRM with CH)
(RETURN LST)
else (* ;
 "Terminated with break, jump into the break char code")
(GO BREAK))
then (* ; "read terminates here")
(freplace (STREAM LASTCCODE) of STRM with CH)
(RETURN LST)
else (* ;
 "Terminated with break, jump into the break char code")
(GO BREAK))
GOTPACKAGEDELIM
(* ;; "Come here if CH is a package delimiter. Note that we have already scanned at least one character of the token, so this must be an interior delim")
(* ;; "Come here if CH is a package delimiter. Note that we have already scanned at least one character of the token, so this must be an interior delim")
(COND
(*READ-SUPPRESS* (* ; "Don't care about packages"))
(*READ-SUPPRESS* (* ; "Don't care about packages"))
[(AND (EQ J 0)
(NULL EXTRASEGMENTS))
(* ;; "No chars accumulated, so must be 2 colons in a row. Note that the case where we've just started scanning a token happens up at NEWTOKEN")
(* ;; "No chars accumulated, so must be 2 colons in a row. Note that the case where we've just started scanning a token happens up at NEWTOKEN")
(SETQ LASTC CH)
(COND
((AND (EQ NCOLONS 1)
(NEQ PACKAGE *KEYWORD-PACKAGE*)) (* ;
 "Two colons in a row means internal symbol")
(NEQ PACKAGE *KEYWORD-PACKAGE*)) (* ;
 "Two colons in a row means internal symbol")
(SETQ NCOLONS 2))
(T (* ;
 "Error, e.g., `FOO:::BAZ' or `::BAR'")
(T (* ;
 "Error, e.g., `FOO:::BAZ' or `::BAR'")
(SETQ INVALIDFLG T)
(GO GOTATOMCHAR]
((NULL NCOLONS) (* ;
 "We have just scanned the package name")
((NULL NCOLONS) (* ;
 "We have just scanned the package name")
(SETQ NCOLONS 1)
(SETQ LASTC CH)
[SETQ PACKAGE (COND
@@ -876,21 +870,21 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
))
(SETQ EXTRASEGMENTS NIL))
((\FIND.PACKAGE.INTERNAL PBASE 0 J \FATPNAMESTRINGP))
(T (* ;
 "Error, but don't signal yet -- save name as string for benefit of error handlers")
(T (* ;
 "Error, but don't signal yet -- save name as string for benefit of error handlers")
(\GETBASESTRING PBASE 0 J \FATPNAMESTRINGP]
(SETQ J 0))
(T (* ;
 "Have alread seen one or more colons, and have scanned more symbol. This colon is an error.")
(T (* ;
 "Have alread seen one or more colons, and have scanned more symbol. This colon is an error.")
(SETQ LASTC CH)
(SETQ INVALIDFLG T)
(GO GOTATOMCHAR)))
(SETQ ESCAPEFLG T) (* ; "Result MUST be a symbol now")
(SETQ ESCAPEFLG T) (* ; "Result MUST be a symbol now")
(GO NEXTATOMCHAR)
SINGLECHARATOM
(* ;; "Come here to create a symbol whose single character is CH -- no package stuff to worry about. This happens mainly for RATOM. We create the single char atom in IL for backward compatibility.")
(* ;; "Come here to create a symbol whose single character is CH -- no package stuff to worry about. This happens mainly for RATOM. We create the single char atom in IL for backward compatibility.")
(\PNAMESTRINGPUTCHAR PBASE 0 CH)
(SETQ ELT (\READ.SYMBOL PBASE 0 1 \FATPNAMESTRINGP *INTERLISP-PACKAGE*))
@@ -898,45 +892,45 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(\RDCONC ELT (RETURN ELT))
(GO NEWTOKEN)
(* ;; "End of atom scanning code")
(* ;; "End of atom scanning code")
BREAK
(* ;; "At this point, we have just read a break character, stored in CH")
(* ;; "At this point, we have just read a break character, stored in CH")
(freplace (STREAM LASTCCODE) of STRM with CH)
[SELECTC SNX
(LEFTPAREN.RC
(* ;; "recursively read a list. If that list (or any of it's non-bracketed sublists) is terminated by a right bracket it terminates our read as well. PROPRB macro worries about right-bracket propagation: if the subread encounters a right bracket (sets \RBFLG), PROPRB returns true. In addition, if we were not called by a left-bracket (READTYPE = NOPROPRB.RT) it sets \RBFLG in caller, thereby propagating the bracket upward.")
(* ;; "recursively read a list. If that list (or any of it's non-bracketed sublists) is terminated by a right bracket it terminates our read as well. PROPRB macro worries about right-bracket propagation: if the subread encounters a right bracket (sets \RBFLG), PROPRB returns true. In addition, if we were not called by a left-bracket (READTYPE = NOPROPRB.RT) it sets \RBFLG in caller, thereby propagating the bracket upward.")
(COND
((PROG1 (PROPRB (SETQ ELT (\SUBREAD STRM SA PROPRB.RT PNSTR
CASEBASE)))
((PROG1 (PROPRB (SETQ ELT (\SUBREAD STRM SA PROPRB.RT PNSTR CASEBASE))
)
(\RDCONC ELT (RETURN ELT)))
(* ;; "PROG1 is true if the subread encountered a right bracket")
(* ;; "PROG1 is true if the subread encountered a right bracket")
(FIXDOT) (* ; "Fix dotted pair if necessary")
(FIXDOT) (* ; "Fix dotted pair if necessary")
(RETURN LST))))
(LEFTBRACKET.RC
(* ;; "recursively read a list, terminated by either right paren or right bracket. In this case, right bracket is not propagated upward--we continue reading elements after it.")
(* ;; "recursively read a list, terminated by either right paren or right bracket. In this case, right bracket is not propagated upward--we continue reading elements after it.")
(SETQ ELT (\SUBREAD STRM SA NOPROPRB.RT PNSTR CASEBASE))
(\RDCONC ELT (RETURN ELT)))
((LIST RIGHTPAREN.RC RIGHTBRACKET.RC)
(* ;; "Terminate one or more lists, return what we have accumulated so far. In the case of Right bracket, if caller did not have the matching left bracket, we have to allow the bracket to close more than one list.")
(* ;; "Terminate one or more lists, return what we have accumulated so far. In the case of Right bracket, if caller did not have the matching left bracket, we have to allow the bracket to close more than one list.")
(RETURN (COND
(TOPLEVELP
(* ;; "Naked right paren/bracket returns NIL. This is sort of bogus in common lisp, but changing it would be a significant change to Interlisp folks.")
(* ;; "Naked right paren/bracket returns NIL. This is sort of bogus in common lisp, but changing it would be a significant change to Interlisp folks.")
NIL)
(CHAR
(* ;; "call from READ-DELIMITED-LIST doesn't want to terminate this way. Could read as NIL and not terminate, but seems best to error.")
(* ;; "call from READ-DELIMITED-LIST doesn't want to terminate this way. Could read as NIL and not terminate, but seems best to error.")
(CL:ERROR "Unmatched ~A encountered while reading to a ~A"
(CL:CODE-CHAR CH)
@@ -948,15 +942,15 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(SETQ \RBFLG T))
LST))))
(STRINGDELIM.RC
(* ;; "Invoke string reader")
(* ;; "Invoke string reader")
(SETQ ELT (\RSTRING2 STRM SA NIL PNSTR))
(\RDCONC ELT (RETURN ELT)))
(COND
((OR (EQ SNX BREAKCHAR.RC)
(NOT (fetch READMACROFLG of *READTABLE*)))
(* ;
 "A breakchar or a disabled always macro")
(* ;
 "A breakchar or a disabled always macro")
(GO SINGLECHARATOM))
(T (GO MACRO]
(GO NEWTOKEN)
@@ -966,62 +960,62 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
((PROG1 (PROPRB [SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR
(CL:MULTIPLE-VALUE-LIST (\APPLYREADMACRO
STRM SNX]
(* ;
 "Ignore right-bracket if macro is called at top-level read")
(* ;
 "Ignore right-bracket if macro is called at top-level read")
)
[COND
((NULL ELT) (* ;
 "Macro returned zero values, read as nothing")
((NULL ELT) (* ;
 "Macro returned zero values, read as nothing")
)
(T (SETQ ELT (CAR ELT))
(\RDCONC ELT (RETURN ELT])
(FIXDOT) (* ;
 "Encountered right bracket if we get here -- return what we have")
(FIXDOT) (* ;
 "Encountered right bracket if we get here -- return what we have")
(RETURN LST))))
(INFIX
(* ;; "We give macro TCONC list of what we've accumulated so far--it gets to modify it as it pleases and return it. We continue from there.")
(* ;; "We give macro TCONC list of what we've accumulated so far--it gets to modify it as it pleases and return it. We continue from there.")
(COND
((PROG1 [PROPRB (SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR
(\APPLYREADMACRO STRM SNX
(AND LST (CONS LST END]
[COND
[TOPLEVELP (* ;
 "What does INFIX mean at top level?? See IRM")
[TOPLEVELP (* ;
 "What does INFIX mean at top level?? See IRM")
(COND
((AND (LISTP ELT)
(CDR ELT)) (* ;
 "Result is in TCONC format, so it's returnable")
(CDR ELT)) (* ;
 "Result is in TCONC format, so it's returnable")
(RETURN (COND
((EQ (CDR ELT)
(CAR ELT))
(* ; "TCONC list of one element--return the element. This is how INFIX top level macro can return a non-list. ")
(* ; "TCONC list of one element--return the element. This is how INFIX top level macro can return a non-list. ")
(CAAR ELT))
(T (CAR ELT]
(T (* ;
 "Reading sublist. Take apart TCONC list and continue.")
(T (* ;
 "Reading sublist. Take apart TCONC list and continue.")
(SETQ LST (CAR ELT))
(SETQ END (CDR ELT])
(FIXDOT) (* ;
 "Macro hit right bracket if we got to here")
(FIXDOT) (* ;
 "Macro hit right bracket if we got to here")
(RETURN LST))))
(SPLICE
(* ;; "Macro returns arbitrary number of values to be spliced inline.")
(* ;; "Macro returns arbitrary number of values to be spliced inline.")
[RBCONTEXT (SETQ ELT (RELEASERESOURCE \PNAMESTRING PNSTR (\APPLYREADMACRO
STRM SNX]
(* ;
 "Note: we don't care if there was terminating right-bracket")
(* ; "Why? -bvm")
(* ;
 "Note: we don't care if there was terminating right-bracket")
(* ; "Why? -bvm")
(COND
((OR (NULL ELT)
TOPLEVELP)
(* ;; "On the 10, it actually returns ELT if it is a list and the next token is a closing paren or bracket. Hard to see how to get that behavior--rmk")
(* ;; "On the 10, it actually returns ELT if it is a list and the next token is a closing paren or bracket. Hard to see how to get that behavior--rmk")
(GO NEWTOKEN))
((NLISTP ELT) (* ;
 "The 10 throws initial non-lists away (What if LST/END aren't set?)")
((NLISTP ELT) (* ;
 "The 10 throws initial non-lists away (What if LST/END aren't set?)")
(SETQ ELT (AND LST (LIST '%. ELT)))
(SETQ DOTLOC END)))
[COND
@@ -1031,7 +1025,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(T (SETQ LST ELT)))
(SETQ END (LAST ELT))
(COND
((CDR END) (* ; "A dotted pair")
((CDR END) (* ; "A dotted pair")
(SETQ DOTLOC END)
(RPLACD END (CONS '%. (SETQ END (CONS (CDR END])
(SHOULDNT))
@@ -1553,14 +1547,14 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
("LF" 10)))
(RPAQQ CHARACTERSETNAMES (("Meta" 1)
("Function" 2)
("Greek" 38)
("Cyrillic" 39)
("Hira" 36)
("Hiragana" 36)
("Kata" 37)
("Katakana" 37)
("Kanji" 48)))
("Function" 2)
("Greek" 38)
("Cyrillic" 39)
("Hira" 36)
("Hiragana" 36)
("Kata" 37)
("Katakana" 37)
("Kanji" 48)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(RPAQQ READTYPES (READ.RT RATOM.RT NOPROPRB.RT PROPRB.RT))
@@ -1581,52 +1575,46 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(PUTPROPS .CALL.SUBREAD. MACRO ((STREAM EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE)
(WITH-RESOURCE (\PNAMESTRING)
(\SUBREAD (\GETSTREAM STREAM 'INPUT)
(fetch (READTABLEP READSA) of
*READTABLE*
)
(COND
(CHAR -1)
(T READ.RT))
\PNAMESTRING
(AND (fetch (READTABLEP CASEINSENSITIVE)
of *READTABLE*)
(fetch (ARRAYP BASE) of
UPPERCASEARRAY
))
EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE
))))
(WITH-RESOURCE (\PNAMESTRING)
(\SUBREAD (\GETSTREAM STREAM 'INPUT)
(fetch (READTABLEP READSA) of *READTABLE*)
(COND
(CHAR -1)
(T READ.RT))
\PNAMESTRING
(AND (fetch (READTABLEP CASEINSENSITIVE) of *READTABLE*
)
(fetch (ARRAYP BASE) of UPPERCASEARRAY))
EOF-SUPPRESS EOF-VALUE CHAR PRESERVE-WHITESPACE))))
(PUTPROPS FIXDOT MACRO [NIL (PROGN (* ;
 "Fix a non-first dot followed by a singleton")
(AND DOTLOC (CDDR DOTLOC)
(NULL (CDDDR DOTLOC))
(RPLACD DOTLOC (CADDR DOTLOC])
(PUTPROPS FIXDOT MACRO [NIL (PROGN (* ;
 "Fix a non-first dot followed by a singleton")
(AND DOTLOC (CDDR DOTLOC)
(NULL (CDDDR DOTLOC))
(RPLACD DOTLOC (CADDR DOTLOC])
(PUTPROPS RBCONTEXT MACRO ((X . Y)
([LAMBDA (\RBFLG)
(DECLARE (SPECVARS \RBFLG))
(PROGN X . Y)
\RBFLG]
NIL)))
([LAMBDA (\RBFLG)
(DECLARE (SPECVARS \RBFLG))
(PROGN X . Y)
\RBFLG]
NIL)))
(PUTPROPS PROPRB MACRO [(X . Y) (* ;
 "Propagates the right-bracket flag")
(AND (RBCONTEXT X . Y)
(OR (EQ READTYPE NOPROPRB.RT)
(SETQ \RBFLG T])
(PUTPROPS PROPRB MACRO [(X . Y) (* ; "Propagates the right-bracket flag")
(AND (RBCONTEXT X . Y)
(OR (EQ READTYPE NOPROPRB.RT)
(SETQ \RBFLG T])
(PUTPROPS \RDCONC MACRO [(ELT . TOPFORMS)
(* ;; "Add ELT to the accumulating list to be returned by \SUBREAD. If at top level and no list accumulated, then run TOPFORMS")
(* ;; "Add ELT to the accumulating list to be returned by \SUBREAD. If at top level and no list accumulated, then run TOPFORMS")
(COND
[LST (RPLACD END (SETQ END (CONS ELT]
(TOPLEVELP . TOPFORMS)
((NOT *READ-SUPPRESS*) (* ;
 "Don't bother consing the result if it's going to be thrown away")
(SETQ END (SETQ LST (CONS ELT])
(COND
[LST (RPLACD END (SETQ END (CONS ELT]
(TOPLEVELP . TOPFORMS)
((NOT *READ-SUPPRESS*) (* ;
 "Don't bother consing the result if it's going to be thrown away")
(SETQ END (SETQ LST (CONS ELT])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -1654,8 +1642,8 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(* ;
"Top level val of \RefillBufferFn means act like READC--we must be doing a raw BIN (or PEEKBIN?)")
(* ; "Top level val of \RefillBufferFn means act like READC--we must be doing a raw BIN (or PEEKBIN?)"
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -1672,17 +1660,17 @@ 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 (3236 11465 (LASTC 3246 . 3552) (PEEKC 3554 . 3942) (PEEKCCODE 3944 . 4237) (RATOM 4239
. 5320) (READ 5322 . 5882) (READC 5884 . 6525) (READCCODE 6527 . 7286) (READP 7288 . 7840) (
SETREADMACROFLG 7842 . 8141) (SKIPSEPRCODES 8143 . 9126) (SKIPSEPRS 9128 . 9514) (SKREAD 9516 . 11463)
) (11511 20120 (CL:READ 11521 . 12070) (CL:READ-PRESERVING-WHITESPACE 12072 . 12794) (
CL:READ-DELIMITED-LIST 12796 . 13711) (CL:PARSE-INTEGER 13713 . 20118)) (20213 32690 (RSTRING 20223 .
20955) (READ-EXTENDED-TOKEN 20957 . 24829) (\RSTRING2 24831 . 32688)) (32726 63866 (\TOP-LEVEL-READ
32736 . 34719) (\SUBREAD 34721 . 60282) (\SUBREADCONCAT 60284 . 60907) (\ORIG-READ.SYMBOL 60909 .
61977) (\ORIG-INVALID.SYMBOL 61979 . 62878) (\APPLYREADMACRO 62880 . 63296) (INREADMACROP 63298 .
63864)) (64025 64200 (READQUOTE 64035 . 64198)) (64225 76129 (READVBAR 64235 . 65566) (READHASHMACRO
65568 . 71378) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71380 . 71600) (DIGITBASEP 71602 . 72336) (
READNUMBERINBASE 72338 . 74224) (ESTIMATE-DIMENSIONALITY 74226 . 74551) (SKIP.HASH.COMMENT 74553 .
75521) (CMLREAD.FEATURE.PARSER 75523 . 76127)) (76173 82517 (CHARACTER.READ 76183 . 77437) (
CHARCODE.DECODE 77439 . 82515)) (82518 85688 (HEXNUM? 82528 . 84871) (OCTALNUM? 84873 . 85686)))))
(FILEMAP (NIL (3265 11709 (LASTC 3275 . 3581) (PEEKC 3583 . 3971) (PEEKCCODE 3973 . 4384) (RATOM 4386
. 5467) (READ 5469 . 6029) (READC 6031 . 6672) (READCCODE 6674 . 7433) (READP 7435 . 7987) (
SETREADMACROFLG 7989 . 8288) (SKIPSEPRCODES 8290 . 9370) (SKIPSEPRS 9372 . 9758) (SKREAD 9760 . 11707)
) (11755 20364 (CL:READ 11765 . 12314) (CL:READ-PRESERVING-WHITESPACE 12316 . 13038) (
CL:READ-DELIMITED-LIST 13040 . 13955) (CL:PARSE-INTEGER 13957 . 20362)) (20457 32934 (RSTRING 20467 .
21199) (READ-EXTENDED-TOKEN 21201 . 25073) (\RSTRING2 25075 . 32932)) (32970 63584 (\TOP-LEVEL-READ
32980 . 34963) (\SUBREAD 34965 . 60000) (\SUBREADCONCAT 60002 . 60625) (\ORIG-READ.SYMBOL 60627 .
61695) (\ORIG-INVALID.SYMBOL 61697 . 62596) (\APPLYREADMACRO 62598 . 63014) (INREADMACROP 63016 .
63582)) (63743 63918 (READQUOTE 63753 . 63916)) (63943 75847 (READVBAR 63953 . 65284) (READHASHMACRO
65286 . 71096) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71098 . 71318) (DIGITBASEP 71320 . 72054) (
READNUMBERINBASE 72056 . 73942) (ESTIMATE-DIMENSIONALITY 73944 . 74269) (SKIP.HASH.COMMENT 74271 .
75239) (CMLREAD.FEATURE.PARSER 75241 . 75845)) (75891 82235 (CHARACTER.READ 75901 . 77155) (
CHARCODE.DECODE 77157 . 82233)) (82236 85406 (HEXNUM? 82246 . 84589) (OCTALNUM? 84591 . 85404)))))
STOP

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.

144
sources/PMAP
View File

@@ -1,10 +1,11 @@
(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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \PAGEDREADP)
(FILECREATED "19-Jul-2022 23:17:41" {DSK}<users>kaplan>local>medley3.5>working-medley>sources>PMAP.;8 59726
previous date%: "23-Jun-2021 12:40:35"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PMAP.;6)
:CHANGES-TO (FNS \PAGEDREADP)
:PREVIOUS-DATE " 7-Aug-2021 12:45:46"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>PMAP.;7)
(* ; "
@@ -14,8 +15,8 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT PMAPCOMS)
(RPAQQ PMAPCOMS
( (* ;
 "Page mapping primitives. This file is shared with VAX.")
( (* ;
 "Page mapping primitives. This file is shared with VAX.")
(FNS ADDMAPBUFFER \ALLOCMAPBUFFER CHECKBUFFERREFVAL CLEARMAP \WRITEOUTBUFFERS \CLEARMAP
DOPMAP FINDPTRSBUFFER FORGETPAGES \GETMAPBUFFER LOCKMAP MAPAFTERCLOSE MAPBUFFERCOUNT
MAPPAGE MAPWORD \RELEASEBUFFER RELEASINGVMEMPAGE RESTOREMAP UNLOCKMAP \MAPPAGE
@@ -26,14 +27,13 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
(SYSTEMBUFFERLIST)
(MAPEMPTYBUFFERLIST))
(GLOBALVARS SYSTEMBUFFERLIST MAPEMPTYBUFFERLIST DEFAULTMAPFILE))
[COMS (* ;
 "Functions for page-mapped devices")
[COMS (* ; "Functions for page-mapped devices")
(DECLARE%: DONTCOPY (EXPORT (MACROS \RELEASECPAGE)))
(FNS \MAKE.PMAP.DEVICE \PAGEDBACKFILEPTR \PAGEDSETFILEPTR \PAGED.INCFILEPTR
\PAGEDGETFILEPTR \PAGEDGETEOFPTR \PAGEDREADP \PAGEDEOFP \PAGED.GETNEXTBUFFER
\PAGED.FORCEOUTPUT \UPDATEOF \READPAGES \WRITEPAGES)
(FNS \SETEOF \PAGED.SETEOFPTR \NEWLENGTHIS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ; "For TEXTOFD")
(DECLARE%: DONTEVAL@LOAD DOCOPY (* ; "For TEXTOFD")
(P (PUTD '\PAGEDBIN (GETD '\BUFFERED.BIN)
T)
(PUTD '\PAGEDPEEKBIN (GETD '\BUFFERED.PEEKBIN)
@@ -546,13 +546,13 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
)
(* "FOLLOWING DEFINITIONS EXPORTED")
(PUTPROPS WORDCONTENTS BYTEMACRO ((PTR)
(\GETBASE PTR 0)))
(\GETBASE PTR 0)))
(PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N)
(\PUTBASE PTR 0 N)))
(\PUTBASE PTR 0 N)))
(PUTPROPS WORDOFFSET BYTEMACRO ((PTR N)
(\ADDBASE PTR N)))
(\ADDBASE PTR N)))
(* "END EXPORTED DEFINITIONS")
@@ -575,16 +575,14 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \RELEASECPAGE MACRO ((STREAM)
(PROGN (* ;
 "Must be under an UNINTERRUPTABLY !")
(COND
((fetch CBUFDIRTY of STREAM)
(\SETIODIRTY STREAM (fetch CPAGE
of STREAM))
(replace CBUFDIRTY of STREAM with
NIL)))
(replace CBUFSIZE of STREAM with 0)
(replace CBUFPTR of STREAM with NIL))))
(PROGN (* ;
 "Must be under an UNINTERRUPTABLY !")
(COND
((fetch CBUFDIRTY of STREAM)
(\SETIODIRTY STREAM (fetch CPAGE of STREAM))
(replace CBUFDIRTY of STREAM with NIL)))
(replace CBUFSIZE of STREAM with 0)
(replace CBUFPTR of STREAM with NIL))))
)
(* "END EXPORTED DEFINITIONS")
@@ -740,26 +738,27 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
OFFSET _ (fetch EOFFSET of STREAM])
(\PAGEDREADP
[LAMBDA (STREAM FLG) (* ; "Edited 7-Aug-2021 12:45 by rmk:")
[LAMBDA (STREAM FLG) (* ; "Edited 19-Jul-2022 23:17 by rmk")
(* ; "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.")
(* ;; "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.")
(AND (NOT (\PAGEDEOFP STREAM))
(OR (NOT (NULL FLG))
(NEQ EOL.TC (\SYNCODE \PRIMTERMSA (\PEEKCCODE STREAM)))
(NEQ EOL.TC (\SYNCODE \PRIMTERMSA (\PEEKCCODE.EOLC STREAM)))
(PROGN
(* ;; "We peeked at an EOL. Is there anything beyond that?")
(* ;; "We peeked at an EOL. Is there anything beyond that?")
(OR (ILESSP (ffetch CPAGE of STREAM)
(ffetch EPAGE of STREAM))
(PROGN
(* ;; "Yes if we aren't on the last page.")
(* ;; "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 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")
(\INCCODE.EOLC STREAM)
(PROG1 (NOT (\PAGEDEOFP STREAM))
(\BACKCCODE STREAM])
(\BACKCCODE.EOLC STREAM])
(\PAGEDEOFP
[LAMBDA (STREAM) (* ; "Edited 15-Jun-87 15:06 by jds")
@@ -1025,9 +1024,9 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(DATATYPE BUFFER (FILEPAGE# (VMEMPAGE XPOINTER)
BUFFERNEXT SYSNEXT (NOREFERENCE FLAG)
(USERMAPPED FLAG)
(IODIRTY FLAG)))
BUFFERNEXT SYSNEXT (NOREFERENCE FLAG)
(USERMAPPED FLAG)
(IODIRTY FLAG)))
)
(/DECLAREDATATYPE 'BUFFER '(POINTER XPOINTER POINTER POINTER FLAG FLAG FLAG)
@@ -1043,51 +1042,48 @@ EVAL@COMPILE
(DECLARE%: EVAL@COMPILE
(PUTPROPS GETBUFFERPTR MACRO ((BUFF)
(fetch VMEMPAGE of BUFF)))
(fetch VMEMPAGE of BUFF)))
(PUTPROPS CHECKBUFFERREF MACRO [OPENLAMBDA (BUFF)(* bvm%: "24-JUN-82 17:03")
(PUTPROPS CHECKBUFFERREF MACRO [OPENLAMBDA (BUFF) (* bvm%: "24-JUN-82 17:03")
(* ;; "checks the reference field of a buffer descriptor and if no one is referencing it, it creates a reference and changes the flag. The flag is set by the garbage collector when there are no longer any references to the buffer it describes.")
(* ;; "checks the reference field of a buffer descriptor and if no one is referencing it, it creates a reference and changes the flag. The flag is set by the garbage collector when there are no longer any references to the buffer it describes.")
(UNINTERRUPTABLY
(COND
((fetch NOREFERENCE of BUFF)
(UNINTERRUPTABLY
(COND
((fetch NOREFERENCE of BUFF)
(* ;; "this is a page the reference to which has been dropped, zero its reference count before returning it.")
(* ;; "this is a page the reference to which has been dropped, zero its reference count before returning it.")
(\DELREF (fetch VMEMPAGE of BUFF))
(replace NOREFERENCE of BUFF with NIL))))
])
(\DELREF (fetch VMEMPAGE of BUFF))
(replace NOREFERENCE of BUFF with NIL))))])
(PUTPROPS CPBUFFERP MACRO ((BUFFER STREAM)
(EQ (fetch CBUFPTR of STREAM)
(fetch VMEMPAGE of BUFFER))))
(EQ (fetch CBUFPTR of STREAM)
(fetch VMEMPAGE of BUFFER))))
(PUTPROPS BUFFERINUSEP MACRO [OPENLAMBDA (BUFFER STREAM)
(AND (NULL (fetch NOREFERENCE of BUFFER))
(OR (fetch USERMAPPED of BUFFER)
(CPBUFFERP BUFFER STREAM])
(AND (NULL (fetch NOREFERENCE of BUFFER))
(OR (fetch USERMAPPED of BUFFER)
(CPBUFFERP BUFFER STREAM])
(PUTPROPS UNDIRTY MACRO [OPENLAMBDA (BUFFER STREAM)
(replace IODIRTY of BUFFER with NIL)
(COND
((CPBUFFERP BUFFER STREAM)
(replace CBUFDIRTY of STREAM with NIL])
(replace IODIRTY of BUFFER with NIL)
(COND
((CPBUFFERP BUFFER STREAM)
(replace CBUFDIRTY of STREAM with NIL])
(PUTPROPS DIRTYP MACRO [OPENLAMBDA (BUFFER STREAM)
(* rmk%: "25-OCT-83 19:57")
(PUTPROPS DIRTYP MACRO [OPENLAMBDA (BUFFER STREAM) (* rmk%: "25-OCT-83 19:57")
(* ;; "determines if this buffer has been dirtied by the IO system. It can't determine if the user has done a putbase into the page if he got it from MAPPAGE.")
(* ;; "determines if this buffer has been dirtied by the IO system. It can't determine if the user has done a putbase into the page if he got it from MAPPAGE.")
(OR (fetch IODIRTY of BUFFER)
(AND STREAM (CPBUFFERP BUFFER STREAM)
(fetch CBUFDIRTY of STREAM])
(OR (fetch IODIRTY of BUFFER)
(AND STREAM (CPBUFFERP BUFFER STREAM)
(fetch CBUFDIRTY of STREAM])
)
(DECLARE%: EVAL@COMPILE
[I.S.OPR 'INBUFS NIL '(first (SETQ I.V. BODY) by (fetch BUFFERNEXT of I.V.)
until (NULL I.V.]
[I.S.OPR 'INBUFS NIL '(first (SETQ I.V. BODY) by (fetch BUFFERNEXT of I.V.) until (NULL I.V.]
)
)
@@ -1107,18 +1103,18 @@ EVAL@COMPILE
(PUTPROPS PMAP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1993
2002 2021))
(DECLARE%: DONTCOPY
(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)))))
(FILEMAP (NIL (2457 29111 (ADDMAPBUFFER 2467 . 2643) (\ALLOCMAPBUFFER 2645 . 3246) (CHECKBUFFERREFVAL
3248 . 3823) (CLEARMAP 3825 . 4481) (\WRITEOUTBUFFERS 4483 . 5232) (\CLEARMAP 5234 . 8460) (DOPMAP
8462 . 8925) (FINDPTRSBUFFER 8927 . 9801) (FORGETPAGES 9803 . 12088) (\GETMAPBUFFER 12090 . 15212) (
LOCKMAP 15214 . 15421) (MAPAFTERCLOSE 15423 . 15726) (MAPBUFFERCOUNT 15728 . 16218) (MAPPAGE 16220 .
17729) (MAPWORD 17731 . 18044) (\RELEASEBUFFER 18046 . 18615) (RELEASINGVMEMPAGE 18617 . 19254) (
RESTOREMAP 19256 . 22053) (UNLOCKMAP 22055 . 22264) (\MAPPAGE 22266 . 27720) (\COLLECTDIRTYBUFS 27722
. 28502) (\SETIODIRTY 28504 . 29109)) (29112 30083 (WORDCONTENTS 29122 . 29291) (SETWORDCONTENTS
29293 . 29605) (/SETWORDCONTENTS 29607 . 29912) (WORDOFFSET 29914 . 30081)) (31555 51584 (
\MAKE.PMAP.DEVICE 31565 . 32893) (\PAGEDBACKFILEPTR 32895 . 35369) (\PAGEDSETFILEPTR 35371 . 36807) (
\PAGED.INCFILEPTR 36809 . 39833) (\PAGEDGETFILEPTR 39835 . 40078) (\PAGEDGETEOFPTR 40080 . 40498) (
\PAGEDREADP 40500 . 41863) (\PAGEDEOFP 41865 . 43482) (\PAGED.GETNEXTBUFFER 43484 . 47278) (
\PAGED.FORCEOUTPUT 47280 . 49728) (\UPDATEOF 49730 . 50562) (\READPAGES 50564 . 51024) (\WRITEPAGES
51026 . 51582)) (51585 55677 (\SETEOF 51595 . 52810) (\PAGED.SETEOFPTR 52812 . 54706) (\NEWLENGTHIS
54708 . 55675)) (55819 56199 (PPBUFS 55829 . 56197)))))
STOP

BIN
sources/PMAP.LCOM
View File

Binary file not shown.

133
sources/TTYIN
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Jul-2022 00:09:00" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>TTYIN.;16 328841
(FILECREATED "19-Jul-2022 23:34:14" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TTYIN.;17 328952
:CHANGES-TO (FNS TTYINBUFFERSTREAM)
:CHANGES-TO (FNS TTYINREADP)
:PREVIOUS-DATE "27-Aug-2021 17:02:43"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>TTYIN.;14)
:PREVIOUS-DATE " 2-Jul-2022 00:09:00"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TTYIN.;16)
(* ; "
@@ -5326,16 +5326,17 @@ Copyright (c) 1982-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(T (GIVE.TTY.PROCESS WINDOW])
(TTYINREADP
[LAMBDA (FLG) (* ; "Edited 27-Aug-2021 16:49 by rmk:")
[LAMBDA (FLG) (* ; "Edited 19-Jul-2022 23:33 by rmk")
(* ; "Edited 27-Aug-2021 16:49 by rmk:")
(* ;;; "Intended to replace LISPXREADP. Does the right thing when READBUF has just a <cr> in it")
(* ;;; "Intended to replace LISPXREADP. Does the right thing when READBUF has just a <cr> in it")
(COND
(READBUF (OR (NEQ (CAR READBUF)
HISTSTR0)
FLG))
((NOT (LINEBUFFER-EOFP \LINEBUF.OFD))
(OR FLG (NEQ (\PEEKCCODE \LINEBUF.OFD)
(OR FLG (NEQ (\PEEKCCODE.EOLC \LINEBUF.OFD)
(CHARCODE EOL])
(TTYINREAD
@@ -6077,62 +6078,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 (7815 207850 (TTYIN 7825 . 21058) (TTYIN.SETUP 21060 . 24136) (TTYIN.CLEANUP 24138 .
24966) (TTYIN1 24968 . 51852) (TTYIN1RESTART 51854 . 53118) (TTYIN.FINISH 53120 . 62537) (
TTYIN.BALANCE 62539 . 63665) (ADDCHAR 63667 . 65853) (TTMAKECOMPLEXCHAR 65855 . 66329) (ADDNAKEDCHAR
66331 . 67841) (TTADDTAB 67843 . 68778) (ADJUSTLINE 68780 . 82691) (ADJUSTLINE.AND.RESTORE 82693 .
83131) (AT.END.OF.SCREEN 83133 . 83421) (AT.END.OF.TEXT 83423 . 83878) (AUTOCR? 83880 . 84354) (
BACKSKREAD 84356 . 88941) (BACKWARD.DELETE.TO 88943 . 89125) (BREAKLINE 89127 . 91394) (BUFTAILP 91396
. 91714) (CHECK.MARGIN 91716 . 92339) (CLEAR.LINE? 92341 . 92634) (CURRENT.WORD 92636 . 95036) (
DELETE.TO.END 95038 . 95757) (DELETELINE 95759 . 98716) (DELETETO 98718 . 100540) (DELETETO1 100542 .
101885) (DO.EDIT.COMMAND 101887 . 119206) (DO.EDIT.PP 119208 . 121870) (TTDOTABS 121872 . 123242) (
EDITCOLUMN 123244 . 123700) (EDITNUMBERP 123702 . 123933) (END.DELETE.MODE 123935 . 124452) (ENDREAD?
124454 . 126889) (FIND.LINE 126891 . 128427) (FIND.LINE.BREAK 128429 . 129099) (FIND.MATCHING.QUOTE
129101 . 129946) (FIND.NEXT.WORD 129948 . 131327) (FIND.NON.SPACE 131329 . 131602) (FIND.START.OF.WORD
131604 . 131967) (FORWARD.DELETE.TO 131969 . 134191) (GO.TO.ADDRESSING 134193 . 135149) (
GO.TO.FREELINE 135151 . 135732) (GO.TO.RELATIVE 135734 . 136514) (INIT.CURSOR 136516 . 137413) (
INSERT.NODE 137415 . 137937) (INSERTLINE 137939 . 139443) (KILL.LINES 139445 . 139983) (KILLSEGMENT
139985 . 141108) (L-CASECODE 141110 . 141271) (MOVE.BACK.TO 141273 . 141502) (MOVE.FORWARD.TO 141504
. 141925) (MOVE.TO.LINE 141927 . 142842) (MOVE.TO.NEXT.LINE 142844 . 143114) (MOVE.TO.START.OF.WORD
143116 . 143880) (MOVE.TO.WHEREVER 143882 . 144105) (NTH.COLUMN.OF 144107 . 144438) (
NTH.RELATIVE.COLUMN.OF 144440 . 145740) (OVERFLOW? 145742 . 146690) (OVERFLOWLINE? 146692 . 147018) (
PREVLINE 147020 . 148200) (PREVWORD 148202 . 150343) (PROPERTAILP 150345 . 150552) (READFROMBUF 150554
. 153143) (RENUMBER.LINES 153145 . 153538) (RESTORE.CURSOR 153540 . 153694) (RESTOREBUF 153696 .
155880) (RETYPE.BUFFER 155882 . 158145) (SAVE.CURSOR 158147 . 158319) (SCANBACK 158321 . 159679) (
SCANFORWARD 159681 . 160549) (SCRATCHCONS 160551 . 161153) (SEGMENT.LENGTH 161155 . 161691) (
SEGMENT.BIT.LENGTH 161693 . 162300) (SETLASTC 162302 . 162599) (SETTAIL? 162601 . 163417) (
SHOW.MATCHING.PAREN 163419 . 165919) (SKIP/ZAP 165921 . 168400) (START.NEW.LINE 168402 . 168734) (
START.OF.PARAGRAPH? 168736 . 169117) (TTADJUSTWORD 169119 . 170293) (TTBIN 170295 . 171501) (
TTBITWIDTH 171503 . 171652) (TTCRLF 171654 . 171861) (TTCRLF.ACCOUNT 171863 . 172503) (TTDELETECHAR
172505 . 173649) (TTDELETELINE 173651 . 175599) (TTDELETEWORD 175601 . 176269) (TTECHO.TO.FILE 176271
. 179830) (TTGIVEHELP 179832 . 181097) (TTGIVEHELP1 181099 . 181681) (TTGIVEHELP2 181683 . 182378) (
TTLASTLINE 182380 . 182748) (TTLOADBUF 182750 . 186244) (TTNEXTLINE 186246 . 186566) (TTNEXTNODE
186568 . 186807) (TTNLEFT 186809 . 188036) (TTNTH 188038 . 188497) (TTNTHLINE 188499 . 189031) (
TTPRIN1 189033 . 192846) (TTPRINSPACE 192848 . 193241) (TTPRIN1COMMENT 193243 . 193567) (TTPRIN2
193569 . 195888) (TTPROMPTCHAR 195890 . 196786) (TTRUBOUT 196788 . 197751) (TTUNREADBUF 197753 .
198162) (TTWAITFORINPUT 198164 . 202372) (TTYINSTRING 202374 . 203333) (TYPE.BUFFER 203335 . 205087) (
U-CASECODE 205089 . 205248) (U/L-CASE 205250 . 207848)) (208005 217364 (TTRATOM 208015 . 208459) (
TTREADLIST 208461 . 208828) (TTSKIPSEPR 208830 . 209204) (TTSKREAD 209206 . 213846) (TTYIN.READ 213848
. 217362)) (217411 237455 (FIND.MATCHING.WORD 217421 . 217949) (TTCOMPLETEWORD 217951 . 232379) (
WORD.MATCHES.BUFFER 232381 . 233941) (TTYIN.SHOW.?ALTERNATIVES 233943 . 237453)) (237489 255799 (
DO?CMD 237499 . 243401) (TTYIN.PRINTARGS 243403 . 254261) (TTYIN.READ?=ARGS 254263 . 255044) (
DO?CMD.ERRORHANDLER 255046 . 255797)) (255833 263906 (BEEP 255843 . 256018) (BITBLT.DELETE 256020 .
256667) (BITBLT.ERASE 256669 . 256854) (BITBLT.INSERT 256856 . 257167) (DO.CRLF 257169 . 257488) (
DO.DELETE.LINES 257490 . 258534) (DO.INSERT.LINE 258536 . 260470) (DO.LF 260472 . 260638) (
ERASE.TO.END.OF.LINE 260640 . 260965) (ERASE.TO.END.OF.PAGE 260967 . 261572) (INSERT.TEXT 261574 .
262078) (TTDELSECTION 262080 . 262378) (TTADJUSTWIDTH 262380 . 263244) (TTINSERTSECTION 263246 .
263585) (TTSETCURSOR 263587 . 263904)) (263941 269072 (TTYINBUFFERDEVICE 263951 . 265267) (
TTYINBUFFERSTREAM 265269 . 266185) (TTYINBUFFERBIN 266187 . 266723) (TTYINBUFFERPEEK 266725 . 267203)
(TTYINBUFFERREADP 267205 . 267460) (TTYINBUFFEREOFP 267462 . 267714) (TTYINBUFFERBACKPTR 267716 .
268268) (TTYINWORDRDTBL 268270 . 269070)) (269233 294790 (DO.MOUSE 269243 . 272000) (
DO.SHIFTED.SELECTION 272002 . 282441) (COPY.SEGMENT 282443 . 282647) (DELETE.LONG.SEGMENT 282649 .
283008) (DELETE.LONG.SEGMENT1 283010 . 285486) (INVERT.LONG.SEGMENT 285488 . 286517) (INVERT.SEGMENT
286519 . 288034) (BRACKET.CURRENT.WORD 288036 . 289570) (TTBEFOREPOS 289572 . 290302) (TTNEXTPOS
290304 . 291012) (TTRACKMOUSE 291014 . 294788)) (294934 300189 (SETREADFN 294944 . 295422) (
TTYINENTRYFN 295424 . 295849) (TTYINREADP 295851 . 296315) (TTYINREAD 296317 . 297711) (TTYINFIX
297713 . 298912) (CHARMACRO? 298914 . 299481) (TTYINMETA 299483 . 299611) (TTYIN.LASTINPUT 299613 .
300187)) (300190 308459 (TTYINEDIT 300200 . 302317) (SIMPLETEXTEDIT 302319 . 305363) (
SET.TTYINEDIT.WINDOW 305365 . 306516) (TTYIN.PPTOFILE 306518 . 308457)) (308517 308694 (
MAKE-TTSCRATCHFILE 308527 . 308692)) (308841 309974 (TTYIN.SCRATCHFILE 308851 . 309297) (\TTYIN.RPEOF
309299 . 309972)) (310186 313819 (TTYINPROMPTFORWORD 310196 . 313817)))))
(FILEMAP (NIL (7808 207843 (TTYIN 7818 . 21051) (TTYIN.SETUP 21053 . 24129) (TTYIN.CLEANUP 24131 .
24959) (TTYIN1 24961 . 51845) (TTYIN1RESTART 51847 . 53111) (TTYIN.FINISH 53113 . 62530) (
TTYIN.BALANCE 62532 . 63658) (ADDCHAR 63660 . 65846) (TTMAKECOMPLEXCHAR 65848 . 66322) (ADDNAKEDCHAR
66324 . 67834) (TTADDTAB 67836 . 68771) (ADJUSTLINE 68773 . 82684) (ADJUSTLINE.AND.RESTORE 82686 .
83124) (AT.END.OF.SCREEN 83126 . 83414) (AT.END.OF.TEXT 83416 . 83871) (AUTOCR? 83873 . 84347) (
BACKSKREAD 84349 . 88934) (BACKWARD.DELETE.TO 88936 . 89118) (BREAKLINE 89120 . 91387) (BUFTAILP 91389
. 91707) (CHECK.MARGIN 91709 . 92332) (CLEAR.LINE? 92334 . 92627) (CURRENT.WORD 92629 . 95029) (
DELETE.TO.END 95031 . 95750) (DELETELINE 95752 . 98709) (DELETETO 98711 . 100533) (DELETETO1 100535 .
101878) (DO.EDIT.COMMAND 101880 . 119199) (DO.EDIT.PP 119201 . 121863) (TTDOTABS 121865 . 123235) (
EDITCOLUMN 123237 . 123693) (EDITNUMBERP 123695 . 123926) (END.DELETE.MODE 123928 . 124445) (ENDREAD?
124447 . 126882) (FIND.LINE 126884 . 128420) (FIND.LINE.BREAK 128422 . 129092) (FIND.MATCHING.QUOTE
129094 . 129939) (FIND.NEXT.WORD 129941 . 131320) (FIND.NON.SPACE 131322 . 131595) (FIND.START.OF.WORD
131597 . 131960) (FORWARD.DELETE.TO 131962 . 134184) (GO.TO.ADDRESSING 134186 . 135142) (
GO.TO.FREELINE 135144 . 135725) (GO.TO.RELATIVE 135727 . 136507) (INIT.CURSOR 136509 . 137406) (
INSERT.NODE 137408 . 137930) (INSERTLINE 137932 . 139436) (KILL.LINES 139438 . 139976) (KILLSEGMENT
139978 . 141101) (L-CASECODE 141103 . 141264) (MOVE.BACK.TO 141266 . 141495) (MOVE.FORWARD.TO 141497
. 141918) (MOVE.TO.LINE 141920 . 142835) (MOVE.TO.NEXT.LINE 142837 . 143107) (MOVE.TO.START.OF.WORD
143109 . 143873) (MOVE.TO.WHEREVER 143875 . 144098) (NTH.COLUMN.OF 144100 . 144431) (
NTH.RELATIVE.COLUMN.OF 144433 . 145733) (OVERFLOW? 145735 . 146683) (OVERFLOWLINE? 146685 . 147011) (
PREVLINE 147013 . 148193) (PREVWORD 148195 . 150336) (PROPERTAILP 150338 . 150545) (READFROMBUF 150547
. 153136) (RENUMBER.LINES 153138 . 153531) (RESTORE.CURSOR 153533 . 153687) (RESTOREBUF 153689 .
155873) (RETYPE.BUFFER 155875 . 158138) (SAVE.CURSOR 158140 . 158312) (SCANBACK 158314 . 159672) (
SCANFORWARD 159674 . 160542) (SCRATCHCONS 160544 . 161146) (SEGMENT.LENGTH 161148 . 161684) (
SEGMENT.BIT.LENGTH 161686 . 162293) (SETLASTC 162295 . 162592) (SETTAIL? 162594 . 163410) (
SHOW.MATCHING.PAREN 163412 . 165912) (SKIP/ZAP 165914 . 168393) (START.NEW.LINE 168395 . 168727) (
START.OF.PARAGRAPH? 168729 . 169110) (TTADJUSTWORD 169112 . 170286) (TTBIN 170288 . 171494) (
TTBITWIDTH 171496 . 171645) (TTCRLF 171647 . 171854) (TTCRLF.ACCOUNT 171856 . 172496) (TTDELETECHAR
172498 . 173642) (TTDELETELINE 173644 . 175592) (TTDELETEWORD 175594 . 176262) (TTECHO.TO.FILE 176264
. 179823) (TTGIVEHELP 179825 . 181090) (TTGIVEHELP1 181092 . 181674) (TTGIVEHELP2 181676 . 182371) (
TTLASTLINE 182373 . 182741) (TTLOADBUF 182743 . 186237) (TTNEXTLINE 186239 . 186559) (TTNEXTNODE
186561 . 186800) (TTNLEFT 186802 . 188029) (TTNTH 188031 . 188490) (TTNTHLINE 188492 . 189024) (
TTPRIN1 189026 . 192839) (TTPRINSPACE 192841 . 193234) (TTPRIN1COMMENT 193236 . 193560) (TTPRIN2
193562 . 195881) (TTPROMPTCHAR 195883 . 196779) (TTRUBOUT 196781 . 197744) (TTUNREADBUF 197746 .
198155) (TTWAITFORINPUT 198157 . 202365) (TTYINSTRING 202367 . 203326) (TYPE.BUFFER 203328 . 205080) (
U-CASECODE 205082 . 205241) (U/L-CASE 205243 . 207841)) (207998 217357 (TTRATOM 208008 . 208452) (
TTREADLIST 208454 . 208821) (TTSKIPSEPR 208823 . 209197) (TTSKREAD 209199 . 213839) (TTYIN.READ 213841
. 217355)) (217404 237448 (FIND.MATCHING.WORD 217414 . 217942) (TTCOMPLETEWORD 217944 . 232372) (
WORD.MATCHES.BUFFER 232374 . 233934) (TTYIN.SHOW.?ALTERNATIVES 233936 . 237446)) (237482 255792 (
DO?CMD 237492 . 243394) (TTYIN.PRINTARGS 243396 . 254254) (TTYIN.READ?=ARGS 254256 . 255037) (
DO?CMD.ERRORHANDLER 255039 . 255790)) (255826 263899 (BEEP 255836 . 256011) (BITBLT.DELETE 256013 .
256660) (BITBLT.ERASE 256662 . 256847) (BITBLT.INSERT 256849 . 257160) (DO.CRLF 257162 . 257481) (
DO.DELETE.LINES 257483 . 258527) (DO.INSERT.LINE 258529 . 260463) (DO.LF 260465 . 260631) (
ERASE.TO.END.OF.LINE 260633 . 260958) (ERASE.TO.END.OF.PAGE 260960 . 261565) (INSERT.TEXT 261567 .
262071) (TTDELSECTION 262073 . 262371) (TTADJUSTWIDTH 262373 . 263237) (TTINSERTSECTION 263239 .
263578) (TTSETCURSOR 263580 . 263897)) (263934 269065 (TTYINBUFFERDEVICE 263944 . 265260) (
TTYINBUFFERSTREAM 265262 . 266178) (TTYINBUFFERBIN 266180 . 266716) (TTYINBUFFERPEEK 266718 . 267196)
(TTYINBUFFERREADP 267198 . 267453) (TTYINBUFFEREOFP 267455 . 267707) (TTYINBUFFERBACKPTR 267709 .
268261) (TTYINWORDRDTBL 268263 . 269063)) (269226 294783 (DO.MOUSE 269236 . 271993) (
DO.SHIFTED.SELECTION 271995 . 282434) (COPY.SEGMENT 282436 . 282640) (DELETE.LONG.SEGMENT 282642 .
283001) (DELETE.LONG.SEGMENT1 283003 . 285479) (INVERT.LONG.SEGMENT 285481 . 286510) (INVERT.SEGMENT
286512 . 288027) (BRACKET.CURRENT.WORD 288029 . 289563) (TTBEFOREPOS 289565 . 290295) (TTNEXTPOS
290297 . 291005) (TTRACKMOUSE 291007 . 294781)) (294927 300300 (SETREADFN 294937 . 295415) (
TTYINENTRYFN 295417 . 295842) (TTYINREADP 295844 . 296426) (TTYINREAD 296428 . 297822) (TTYINFIX
297824 . 299023) (CHARMACRO? 299025 . 299592) (TTYINMETA 299594 . 299722) (TTYIN.LASTINPUT 299724 .
300298)) (300301 308570 (TTYINEDIT 300311 . 302428) (SIMPLETEXTEDIT 302430 . 305474) (
SET.TTYINEDIT.WINDOW 305476 . 306627) (TTYIN.PPTOFILE 306629 . 308568)) (308628 308805 (
MAKE-TTSCRATCHFILE 308638 . 308803)) (308952 310085 (TTYIN.SCRATCHFILE 308962 . 309408) (\TTYIN.RPEOF
309410 . 310083)) (310297 313930 (TTYINPROMPTFORWORD 310307 . 313928)))))
STOP

BIN
sources/TTYIN.LCOM
View File

Binary file not shown.

47
sources/XCCS
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Jun-2022 18:08:18" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>XCCS.;51 12897
(FILECREATED "19-Jul-2022 17:13:23" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>XCCS.;54 13309
:CHANGES-TO (FNS \CREATE.XCCS.EXTERNALFORMAT)
:CHANGES-TO (FNS \XCCSBACKCCODE)
:PREVIOUS-DATE "30-Jun-2022 10:02:25"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>XCCS.;50)
:PREVIOUS-DATE "19-Jul-2022 14:56:54"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>XCCS.;53)
(PRETTYCOMPRINT XCCSCOMS)
@@ -179,24 +179,31 @@
(\BOUT STREAM (\CHAR8CODE CHARCODE])
(\XCCSBACKCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 13-Aug-2021 14:08 by rmk:")
[LAMBDA (STREAM COUNTP) (* ; "Edited 19-Jul-2022 17:12 by rmk")
(* ; "Edited 13-Aug-2021 14:08 by rmk:")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
(LET ((BYTE (AND (\BACKFILEPTR STREAM)
(\PEEKBIN STREAM)))
(CSET (ACCESS-CHARSET STREAM)))
(CL:WHEN BYTE
(* ;; "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.")
(* ;; "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.")
(* ;; "But if we are currently in a nonruncoded file, we have to go back one more to get the character set byte.")
(* ;; "But if we are currently in a nonruncoded file, we have to go back one more to get the character set byte.")
(* ;; "If we can't back up, we are already at the beginning.")
(* ;; "If we can't back up, we are already at the beginning.")
(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))
(IF (EQ \NORUNCODE CSET)
THEN (IF (\BACKFILEPTR STREAM)
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
(LOGOR (UNFOLD (\PEEKBIN STREAM)
256)
BYTE)
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
NIL)
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
T))])
ELSE (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
(LOGOR (UNFOLD CSET 256)
BYTE)))])
(\XCCSFORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 16:47 by rmk:")
@@ -275,8 +282,8 @@
(\CREATE.XCCS.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1036 1265 (ACCESS-CHARSET 1046 . 1263)) (1266 10134 (\XCCSINCCODE 1276 . 4048) (
\XCCSPEEKCCODE 4050 . 6586) (\XCCSOUTCHAR 6588 . 8808) (\XCCSBACKCCODE 8810 . 9805) (
\XCCSFORMATBYTESTREAM 9807 . 10132)) (10135 10810 (\CREATE.XCCS.EXTERNALFORMAT 10145 . 10808)) (10811
11642 (\NSIN.24BITENCODING.ERROR 10821 . 11640)))))
(FILEMAP (NIL (1023 1252 (ACCESS-CHARSET 1033 . 1250)) (1253 10546 (\XCCSINCCODE 1263 . 4035) (
\XCCSPEEKCCODE 4037 . 6573) (\XCCSOUTCHAR 6575 . 8795) (\XCCSBACKCCODE 8797 . 10217) (
\XCCSFORMATBYTESTREAM 10219 . 10544)) (10547 11222 (\CREATE.XCCS.EXTERNALFORMAT 10557 . 11220)) (11223
12054 (\NSIN.24BITENCODING.ERROR 11233 . 12052)))))
STOP

BIN
sources/XCCS.LCOM
View File

Binary file not shown.