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

Another pass on CLOSEALL simplify by calling (OPENP) (#1182)

Browse Source 
* Another pass on CLOSEALL simplify by calling (OPENP)

* Put back in checks for CLOSEALL IOMODE USERVISIBLE

* \TERM.OFD and \LINEBUF.OFD are bound, no global

* getting rid of \OPENFILES everywhere

* one more \OPENFILES
This commit is contained in:
Larry Masinter
2023-05-16 19:02:43 -07:00
committed by GitHub
parent f8a5d0fbe5
commit 81b74be043
12 changed files with 1271 additions and 1380 deletions
Download Patch File Download Diff File Expand all files Collapse all files

331
sources/AOFD
View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Apr-2023 08:05:54" {DSK}<home>larry>il>medley>sources>AOFD.;2 37842
(FILECREATED "11-May-2023 21:39:26" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;2 36068
:EDIT-BY "lmm"
:CHANGES-TO (FNS CLOSEALL)
:CHANGES-TO (VARS AOFDCOMS)
(FNS CLOSEF)
:PREVIOUS-DATE " 9-Aug-2021 23:30:19" {DSK}<home>larry>il>medley>sources>AOFD.;1)
:PREVIOUS-DATE "29-Apr-2023 05:38:34"
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;1)
(PRETTYCOMPRINT AOFDCOMS)
@@ -21,9 +23,8 @@
(FNS CLOSEALL CLOSEF EOFCLOSEF INPUT OPENP OUTPUT POSITION RANDACCESSP \IOMODEP
WHENCLOSE)
(FNS STREAMADDPROP)
(INITVARS (DEFAULTEOFCLOSE 'NILL)
(\OPENFILES))
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES))
(INITVARS (DEFAULTEOFCLOSE 'NILL))
(GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV))
(COMS
(* ;; "STREAM interface to Read and Write to random memory")
@@ -42,7 +43,7 @@
(* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))")
)
(COMS (FNS GETSTREAM \ADDOFD \CLEAROFD \DELETEOFD \GETSTREAM \SEARCHOPENFILES)
(COMS (FNS GETSTREAM \CLEAROFD \GETSTREAM)
(DECLARE%: DONTCOPY (EXPORT (MACROS \INSTREAMARG \OUTSTREAMARG \STREAMARG)))
(MACROS GETOFD \GETOFD))
(LOCALVARS . T)
@@ -57,7 +58,7 @@
(DEFINEQ
(\ADD-OPEN-STREAM
[LAMBDA (DEVICE STREAM) (* hdj "28-May-86 11:22")
[LAMBDA (DEVICE STREAM) (* hdj "28-May-86 11:22")
(if (NOT (STREAMP STREAM))
then (\ILLEGAL.ARG STREAM))
(pushnew (fetch (FDEV OPENFILELST) of DEVICE)
@@ -65,9 +66,9 @@
STREAM])
(\GENERIC-UNREGISTER-STREAM
[LAMBDA (DEVICE STREAM) (* hdj "22-Sep-86 18:30")
[LAMBDA (DEVICE STREAM) (* hdj "22-Sep-86 18:30")
(* ;;; "Remove an open stream from the list of streams kept by DEVICE. Assumes the use of the FDEV's OPENFILELSTto store the streams. Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")
(* ;;; "Remove an open stream from the list of streams kept by DEVICE. Assumes the use of the FDEV's OPENFILELSTto store the streams. Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")
(DECLARE (GLOBALVARS *ISSUE-CLOSE-WARNINGS*))
(if (NOT (STREAMP STREAM))
@@ -83,21 +84,16 @@
(DEFINEQ
(CLOSEALL
[LAMBDA (ALLFLG)
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-2023 08:05 by lmm")
(* hdj "11-Jul-86 10:33")
(* ;; "(if MULTIPLE.STREAMS.PER.FILE.ALLOWED then (ERROR 'CLOSEALL no longer supported'))")
(* ;; "Need to APPEND because CLOSEF will remove things from \OPENFILES")
(for STREAM in (APPEND \OPENFILES) when [AND (fetch USERVISIBLE of STREAM)
(\IOMODEP STREAM NIL T)
(OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
[LAMBDA (ALLFLG) (* ; "Edited 28-Apr-2023 20:51 by lmm")
(for STREAM in (OPENP) when [AND (fetch USERVISIBLE of STREAM)
(fetch USERCLOSEABLE of STREAM)
(\IOMODEP STREAM NIL T)
(OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
collect (CLOSEF STREAM])
(CLOSEF
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:26 by rmk:")
[LAMBDA (FILE) (* ; "Edited 11-May-2023 21:18 by lmm")
(* ; "Edited 13-Jun-2021 11:26 by rmk:")
(PROG ((STREAM (\GETSTREAM FILE)))
(COND
((OR (\OUTTERMP STREAM)
@@ -113,10 +109,8 @@
(COND
((EQ STREAM *STANDARD-OUTPUT*)
(SETQ *STANDARD-OUTPUT* \TERM.OFD)))
(AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
(\DELETEOFD STREAM))
(* ;; "Logical close before physical close; otherwise, we might have a logically open file with no physically open file behind it. (Device LPT depends on this)")
(* ;; "Logical close before physical close; otherwise, we might have a logically open file with no physically open file behind it. (Device LPT depends on this)")
(\CLOSEFILE STREAM)
[MAPC (STREAMPROP STREAM 'AFTERCLOSE)
@@ -125,7 +119,7 @@
(RETURN (fetch (STREAM FULLNAME) of STREAM])
(EOFCLOSEF
[LAMBDA (FILE) (* bvm%: "15-Jan-85 17:58")
[LAMBDA (FILE) (* bvm%: "15-Jan-85 17:58")
(DECLARE (LOCALVARS . T))
(PROG ((STREAM (GETSTREAM FILE)))
(APPLY* (OR (STREAMPROP STREAM 'EOFCLOSE)
@@ -133,21 +127,21 @@
STREAM])
(INPUT
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
(PROG1 (if (EQ *STANDARD-INPUT* \LINEBUF.OFD)
then T
else (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then *STANDARD-INPUT*
else (fetch (STREAM FULLNAME) of *STANDARD-INPUT*)))
then *STANDARD-INPUT*
else (fetch (STREAM FULLNAME) of *STANDARD-INPUT*)))
[COND
(FILE (SETQ *STANDARD-INPUT* (COND
((EQ FILE T) (* ;
 "Check explicitly for T to avoid needless creations")
((EQ FILE T) (* ;
 "Check explicitly for T to avoid needless creations")
\LINEBUF.OFD)
(T (\GETSTREAM FILE 'INPUT])])
(OPENP
[LAMBDA (FILE ACCESS) (* hdj "29-Sep-86 17:41")
[LAMBDA (FILE ACCESS) (* hdj "29-Sep-86 17:41")
(DECLARE (GLOBALVARS MULTIPLE.STREAMS.PER.FILE.ALLOWED \FILEDEVICES))
(if (AND FILE (type? STREAM FILE))
then (\GETSTREAM FILE ACCESS T)
@@ -157,45 +151,44 @@
\FILEDEVICES NIL])
(OUTPUT
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
(PROG1 (if (EQ *STANDARD-OUTPUT* \TERM.OFD)
then T
else (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then *STANDARD-OUTPUT*
else (fetch (STREAM FULLNAME) of *STANDARD-OUTPUT*)))
then *STANDARD-OUTPUT*
else (fetch (STREAM FULLNAME) of *STANDARD-OUTPUT*)))
[COND
(FILE (SETQ *STANDARD-OUTPUT* (COND
((EQ FILE T) (* ;
 "Check for this special so we don't create a tty window needlessly")
((EQ FILE T) (* ;
 "Check for this special so we don't create a tty window needlessly")
\TERM.OFD)
(T (\GETSTREAM FILE 'OUTPUT])])
(POSITION
[LAMBDA (FILE N) (* ; "Edited 17-Jan-87 16:08 by bvm:")
[LAMBDA (FILE N) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(PROG [(STRM (COND
(FILE (\GETSTREAM FILE))
(T *STANDARD-OUTPUT*]
(RETURN (PROG1 (fetch CHARPOSITION of STRM)
(COND
(N (replace CHARPOSITION of STRM with (COND
((IGREATERP N 0)
N)
(T
(* ; "compatible with PDP-10 version")
0])
[COND
(N (replace CHARPOSITION of STRM with (COND
((IGREATERP N 0)
N)
(T
(* ; "compatible with PDP-10 version")
0])])
(RANDACCESSP
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:28 by rmk:")
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:28 by rmk:")
(PROG ((STREAM (\GETSTREAM FILE)))
(RETURN (AND (fetch (FDEV RANDOMACCESSP) of (fetch (STREAM DEVICE) of
STREAM))
(RETURN (AND (fetch (FDEV RANDOMACCESSP) of (fetch (STREAM DEVICE) of STREAM))
(NEQ STREAM \LINEBUF.OFD)
(fetch (STREAM FULLNAME) of STREAM])
(\IOMODEP
[LAMBDA (STREAM ACCESS NOERROR) (* rmk%: "21-OCT-83 11:10")
(* ;; "Returns STREAM if it represents a File open with access mode ACCESS")
[LAMBDA (STREAM ACCESS NOERROR) (* rmk%: "21-OCT-83 11:10")
(* ;; "Returns STREAM if it represents a File open with access mode ACCESS")
(COND
([COND
@@ -212,7 +205,8 @@
(T (\FILE.NOT.OPEN STREAM NOERROR])
(WHENCLOSE
[LAMBDA NARGS (* lmm " 2-Sep-84 16:07")
[LAMBDA NARGS (* ; "Edited 28-Apr-2023 21:19 by lmm")
(* lmm " 2-Sep-84 16:07")
(DECLARE (LOCALVARS . T))
(PROG [(STREAM (AND (IGREATERP NARGS 0)
(GETSTREAM (ARG NARGS 1]
@@ -225,9 +219,9 @@
(YES NIL)
(ERRORX (LIST 27 FN])
(BEFORE (COND
(FN (STREAMADDPROP STREAM 'BEFORECLOSE FN T))))
(FN (STREAMADDPROP STREAM 'BEFORECLOSE FN))))
(AFTER (COND
(FN (STREAMADDPROP STREAM 'AFTERCLOSE FN T))))
(FN (STREAMADDPROP STREAM 'AFTERCLOSE FN))))
(STATUS (STREAMPROP STREAM 'STATUSFN FN))
(EOF (STREAMPROP STREAM 'EOFCLOSE FN))
(ERRORX (LIST 27 (ARG NARGS I]
@@ -241,11 +235,9 @@
)
(RPAQ? DEFAULTEOFCLOSE 'NILL)
(RPAQ? \OPENFILES )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES)
(GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV)
)
@@ -271,7 +263,7 @@
(\BASEBYTES.IO.INIT
[LAMBDA NIL
(DECLARE (GLOBALVARS \BASECHARDEVICE)) (* ; "Edited 13-Sep-90 16:27 by jds")
(DECLARE (GLOBALVARS \BASECHARDEVICE)) (* ; "Edited 13-Sep-90 16:27 by jds")
(* ;; "Initialize the FDEV for base-bytes type devices (e.g. string streams).")
@@ -315,7 +307,7 @@
(replace BBSNCHARS of STREAM
with (IDIFFERENCE (fetch COFFSET of STREAM)
(fetch BIASOFFST of STREAM]
(fetch BIASOFFST of STREAM]
SETFILEPTR _ (FUNCTION \BASEBYTES.SETFILEPTR)
GETFILEPTR _ [FUNCTION (LAMBDA (STREAM)
(IDIFFERENCE (fetch COFFSET of STREAM)
@@ -334,10 +326,9 @@
(\DEFINEDEVICE NIL \BASEBYTESDEVICE])
(\MAKEBASEBYTESTREAM
[LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM)
(* ; "Edited 13-Jun-2021 11:33 by rmk:")
[LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM) (* ; "Edited 13-Jun-2021 11:33 by rmk:")
(* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")
(* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")
(OR BASE (EQ LEN 0)
(SHOULDNT))
@@ -351,53 +342,50 @@
(\ILLEGAL.ARG ACCESS))
(if (type? STREAM OSTREAM)
then (if (EQ (ffetch (STREAM DEVICE) of OSTREAM)
\BASEBYTESDEVICE)
then (replace (STREAM ACCESS) of OSTREAM with NIL)
else (CLOSEF OSTREAM)
(SETQ OSTREAM (create BASEBYTESTREAM
DEVICE _ \BASEBYTESDEVICE smashing OSTREAM)))
\BASEBYTESDEVICE)
then (replace (STREAM ACCESS) of OSTREAM with NIL)
else (CLOSEF OSTREAM)
(SETQ OSTREAM (create BASEBYTESTREAM
DEVICE _ \BASEBYTESDEVICE smashing OSTREAM)))
else (SETQ OSTREAM (create BASEBYTESTREAM
DEVICE _ \BASEBYTESDEVICE)))
DEVICE _ \BASEBYTESDEVICE)))
(UNINTERRUPTABLY
(freplace (STREAM USERCLOSEABLE) of OSTREAM with NIL)
(freplace (STREAM USERVISIBLE) of OSTREAM with NIL)
(freplace (STREAM BYTESIZE) of OSTREAM with BITSPERBYTE)
(freplace (STREAM CPAGE) of OSTREAM with (freplace (STREAM EPAGE)
of OSTREAM with 0))
(freplace (STREAM CPAGE) of OSTREAM with (freplace (STREAM EPAGE) of OSTREAM with 0))
(freplace (STREAM CBUFPTR) of OSTREAM with BASE)
(freplace (STREAM COFFSET) of OSTREAM with (freplace (BASEBYTESTREAM
BIASOFFST)
of OSTREAM with OFFST))
(freplace (STREAM CBUFSIZE) of OSTREAM with (freplace (STREAM EOFFSET)
of OSTREAM with LEN))
(freplace (STREAM COFFSET) of OSTREAM with (freplace (BASEBYTESTREAM BIASOFFST) of OSTREAM
with OFFST))
(freplace (STREAM CBUFSIZE) of OSTREAM with (freplace (STREAM EOFFSET) of OSTREAM
with LEN))
(replace (STREAM ACCESS) of OSTREAM with ACCESS)
(* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")
(* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")
(freplace (STREAM FULLFILENAME) of OSTREAM with NIL)
(freplace (STREAM OUTCHARFN) of OSTREAM with (FUNCTION \MBS.OUTCHARFN))
(freplace (STREAM LINELENGTH) of OSTREAM with 0)
(freplace (STREAM CHARPOSITION) of OSTREAM with 0)
(freplace (BASEBYTESTREAM WRITEXTENSIONFN) of OSTREAM with (SELECTQ ACCESS
((OUTPUT BOTH)
WRITEXTENSIONFN)
NIL))
((OUTPUT BOTH)
WRITEXTENSIONFN)
NIL))
(freplace (BASEBYTESTREAM BBSNCHARS) of OSTREAM with 0))
OSTREAM])
(\MBS.OUTCHARFN
[LAMBDA (STREAM CHAR) (* JonL " 7-NOV-83 21:54")
[LAMBDA (STREAM CHAR) (* JonL " 7-NOV-83 21:54")
(BOUT (SETQ STREAM (\DTEST STREAM 'STREAM))
CHAR) (* ;
"The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")
CHAR) (* ;
 "The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")
(add (ffetch BBSNCHARS of STREAM)
1])
(\BASEBYTES.NAME.FROM.STREAM
[LAMBDA (STREAM) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(* ;; "STRING streams have a FULLFILENAME which is just the string itself; other random basebytes streams have this field null")
[LAMBDA (STREAM) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(* ;; "STRING streams have a FULLFILENAME which is just the string itself; other random basebytes streams have this field null")
(OR (fetch FULLFILENAME of STREAM)
(LIST (fetch CBUFPTR of STREAM)
@@ -405,7 +393,7 @@
(GETEOFPTR STREAM])
(\BASEBYTES.BOUT
[LAMBDA (STREAM BYTE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
[LAMBDA (STREAM BYTE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(PROG (CO)
A (if (IGEQ (SETQ CO (fetch COFFSET of STREAM))
(fetch EOFFSET of STREAM))
@@ -414,11 +402,12 @@
(GO A)
else (ERROR "Attempt to write past end of bytes block")))
(RETURN (\PUTBASEBYTE (fetch CBUFPTR of STREAM)
(PROG1 CO (freplace COFFSET of STREAM with (ADD1 CO)))
(PROG1 CO
(freplace COFFSET of STREAM with (ADD1 CO)))
BYTE])
(\BASEBYTES.SETFILEPTR
[LAMBDA (STREAM I) (* ; "Edited 13-Sep-90 16:30 by jds")
[LAMBDA (STREAM I) (* ; "Edited 13-Sep-90 16:30 by jds")
(* ;; "SETFILEPTR for string streams &c.")
@@ -427,14 +416,13 @@
(if (IGREATERP I' (fetch EOFFSET of STREAM))
then (ERROR "Beyond end of byte range" I)
else
(* ;; "Fix both FILEPTR and CHARPOSITION to match.")
(* ;; "Fix both FILEPTR and CHARPOSITION to match.")
(replace COFFSET of STREAM with I')
(replace BBSNCHARS of STREAM with I'])
(replace COFFSET of STREAM with I')
(replace BBSNCHARS of STREAM with I'])
(\BASEBYTES.READP
[LAMBDA (STREAM FLG) (* ; "Edited 17-Jan-87 16:08 by bvm:")
[LAMBDA (STREAM FLG) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(PROG ((CO (fetch COFFSET of STREAM))
(%#LEFT (fetch EOFFSET of STREAM)))
(add %#LEFT (IMINUS CO))
@@ -447,33 +435,33 @@
(CHARCODE CR])
(\BASEBYTES.BIN
[LAMBDA (STREAM) (* JonL " 7-NOV-83 22:49")
(* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")
(* ;;
"Remember also that the VAX version installs a different STRMBINFN for the stringstream case")
[LAMBDA (STREAM) (* JonL " 7-NOV-83 22:49")
(* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")
(* ;;
 "Remember also that the VAX version installs a different STRMBINFN for the stringstream case")
(PROG1 (\BASEBYTES.PEEKBIN STREAM)
(add (fetch COFFSET of STREAM)
1])
(add (fetch COFFSET of STREAM)
1))])
(\BASEBYTES.PEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 13-Jun-2021 11:34 by rmk:")
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 13-Jun-2021 11:34 by rmk:")
(PROG ((CO (fetch (STREAM COFFSET) of STREAM)))
(SELECTQ (SYSTEMTYPE)
(VAX (if (fetch (STREAM FULLNAME) of STREAM)
then (* ; "Aha, it's a string stream")
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
then (* ; "Aha, it's a string stream")
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
NIL)
(RETURN (if (IGEQ CO (fetch (STREAM EOFFSET) of STREAM))
then (if (NOT NOERRORFLG)
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
else (\GETBASEBYTE (fetch (STREAM CBUFPTR) of STREAM)
CO])
CO])
(\BASEBYTES.TRUNCATEFN
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:20")
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:20")
([LAMBDA (I' BO EO)
(add I' BO)
(if (ILESSP I 0)
@@ -487,7 +475,7 @@
(fetch EOFFSET of STREAM])
(\BASEBYTES.OPENFN
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 17-Jan-87 16:08 by bvm:")
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(if (fetch FULLFILENAME of NAME)
then (OPENSTRINGSTREAM NAME ACCESS)
else (\MAKEBASEBYTESTREAM (fetch CBUFPTR of NAME)
@@ -498,7 +486,7 @@
NAME])
(\BASEBYTES.BLOCKIO
[LAMBDA (STREAM BASE OFFST N DIRECTION) (* ; "Edited 17-Jan-87 16:08 by bvm:")
[LAMBDA (STREAM BASE OFFST N DIRECTION) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(PROG (SBASE CO EO)
A (if (ILEQ N 0)
then (RETURN))
@@ -508,8 +496,8 @@
(if (IGREATERP N (IDIFFERENCE EO (SUB1 CO)))
then (if (EQ DIRECTION 'INPUT)
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM)
else (* ;
"Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")
else (* ;
 "Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")
(BOUT STREAM (\GETBASEBYTE BASE OFFST))
(add OFFST 1)
(add N -1)
@@ -531,12 +519,12 @@
(DEFINEQ
(OPENSTRINGSTREAM
[LAMBDA (STR ACCESS) (* ; "Edited 8-Aug-2021 00:02 by rmk:")
(* rmk%: "28-Mar-85 08:40")
[LAMBDA (STR ACCESS) (* ; "Edited 8-Aug-2021 00:02 by rmk:")
(* rmk%: "28-Mar-85 08:40")
(* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")
(* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")
(* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")
(* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")
(SELECTQ ACCESS
((INPUT OUTPUT BOTH))
@@ -546,21 +534,21 @@
(\ILLEGAL.ARG STR))
(LET (STREAM)
(IF (AND (EQ ACCESS 'INPUT)
(NOT (ffetch (STRINGP FATSTRINGP) of STR)))
(NOT (ffetch (STRINGP FATSTRINGP) of STR)))
THEN (\FATTENSTRING STR)
ELSE (\SMASHABLESTRING STR T))
(* ;; "String storage is now fat")
(* ;; "String storage is now fat")
(SETQ STREAM (\MAKEBASEBYTESTREAM (OR (ffetch (STRINGP BASE) of STR)
T)
T)
(UNFOLD (ffetch (STRINGP OFFST) of STR)
BYTESPERWORD)
(UNFOLD (ffetch (STRINGP LENGTH) of STR)
BYTESPERWORD)
ACCESS))
(* ;; "Differences between a basebytestream and a stringstream")
(* ;; "Differences between a basebytestream and a stringstream")
(\EXTERNALFORMAT STREAM :STRING)
(freplace USERCLOSEABLE of STREAM with T)
@@ -568,9 +556,9 @@
STREAM])
(MAKE-STRING-FORMAT
[LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:")
[LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:")
(* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")
(* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")
(MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
(DECLARE (USEDFREE *BYTECOUNTER*))
@@ -579,7 +567,7 @@
[FUNCTION (LAMBDA (STRM NOERROR)
(CL:WHEN (\PEEKBIN STRM NOERROR)
(* ;; "This guards against the EOF error")
(* ;; "This guards against the EOF error")
(PROG1 (LOGOR (LLSH (\BIN STRM)
8)
@@ -590,7 +578,7 @@
(CL:WHEN (\BACKFILEPTR STRM)
(IF (\BACKFILEPTR STRM)
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2))
T
T
ELSEIF COUNTP
THEN (SETQ *BYTECOUNTER* 1)))]
[FUNCTION (LAMBDA (STRM CODE)
@@ -611,17 +599,17 @@
(DEFINEQ
(\STRINGSTREAM.INIT
[LAMBDA NIL (* ; "Edited 9-Aug-2021 23:30 by rmk:")
[LAMBDA NIL (* ; "Edited 9-Aug-2021 23:30 by rmk:")
(* ;; "RMK: This is described as creating a file device for %"old style%" strings. But the variable that it sets is never referenced. The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")
(* ;; "RMK: This is described as creating a file device for %"old style%" strings. But the variable that it sets is never referenced. The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")
(* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions. ")
(* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions. ")
(* ;; "Finally, this appears to be read only. No BOUT is provided.")
(* ;; "Finally, this appears to be read only. No BOUT is provided.")
(* ;; "")
(* ;; "")
(* ;; " In sum: this is a candidate for removal.")
(* ;; " In sum: this is a candidate for removal.")
(SETQ \STRINGSTREAM.FDEV (create FDEV
DEVICENAME _ 'STRING
@@ -644,16 +632,13 @@
BIN _ [FUNCTION (LAMBDA (STREAM)
(replace F2 of STREAM
with (COND
((fetch F1 of STREAM)
(PROG1 (fetch F1
of STREAM)
(replace F1
of STREAM
with NIL)))
((GNCCODE (fetch
FULLFILENAME
of STREAM)))
(T (\EOF.ACTION STREAM]
((fetch F1 of STREAM)
(PROG1 (fetch F1 of STREAM)
(replace F1 of STREAM
with NIL)))
((GNCCODE (fetch FULLFILENAME
of STREAM)))
(T (\EOF.ACTION STREAM]
PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
(OR (fetch F1 of STREAM)
(CHCON1 (fetch FULLFILENAME
@@ -664,8 +649,7 @@
(NOT (EOFP STREAM]
BACKFILEPTR _ [FUNCTION (LAMBDA (STREAM)
(replace F1 of STREAM
with (fetch F2 of STREAM
]
with (fetch F2 of STREAM]
EOFP _ (FUNCTION (LAMBDA (STREAM)
(AND (NOT (fetch F1 of STREAM))
(EQ (NCHARS (fetch FULLFILENAME
@@ -680,34 +664,20 @@
(DEFINEQ
(GETSTREAM
[LAMBDA (FILE ACCESS NOERROR) (* rrb "31-Oct-85 09:36")
(* ; "USER ENTRY")
[LAMBDA (FILE ACCESS NOERROR) (* rrb "31-Oct-85 09:36")
(* ; "USER ENTRY")
(\GETSTREAM FILE ACCESS NOERROR])
(\ADDOFD
[LAMBDA (STREAM) (* rmk%: "21-OCT-83 16:32")
(* ;; "Returns the STREAM it adds to \OPENFILES")
(\CLEAROFD)
(AND (fetch NAMEDP of STREAM)
(push \OPENFILES STREAM))
STREAM])
(\CLEAROFD
[LAMBDA NIL (* lmm "30-SEP-80 20:08")
(* ;
"If GETOFD caches its args, this can clear the cache")
[LAMBDA NIL (* lmm "30-SEP-80 20:08")
(* ;
 "If GETOFD caches its args, this can clear the cache")
NIL])
(\DELETEOFD
[LAMBDA (OFD) (* rmk%: "25-OCT-79 08:20")
(SETQ \OPENFILES (DREMOVE OFD \OPENFILES])
(\GETSTREAM
[LAMBDA (X ACCESS NOERROR) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream. ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL. NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")
[LAMBDA (X ACCESS NOERROR) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream. ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL. NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")
(DECLARE (GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
(COND
@@ -751,16 +721,6 @@
(type? WINDOW X))
(fetch (WINDOW DSP) of X))
(T (\FILE.NOT.OPEN X NOERROR])
(\SEARCHOPENFILES
[LAMBDA (NAME ACCESS) (* ; "Edited 13-Jun-2021 11:35 by rmk:")
(* ;; "Returns a stream whose fullname is NAME if it has accessmode ACCESS")
(for STREAM in \OPENFILES when (EQ NAME (fetch (STREAM FULLNAME) of STREAM))
do (RETURN (COND
(ACCESS (\IOMODEP STREAM ACCESS T))
(T STREAM])
)
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -799,16 +759,15 @@
(ADDTOVAR LAMA WHENCLOSE)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2459 3566 (\ADD-OPEN-STREAM 2469 . 2746) (\GENERIC-UNREGISTER-STREAM 2748 . 3564)) (
3607 10891 (CLOSEALL 3617 . 4349) (CLOSEF 4351 . 5547) (EOFCLOSEF 5549 . 5845) (INPUT 5847 . 6619) (
OPENP 6621 . 7020) (OUTPUT 7022 . 7796) (POSITION 7798 . 8610) (RANDACCESSP 8612 . 9087) (\IOMODEP
9089 . 9726) (WHENCLOSE 9728 . 10889)) (10892 11014 (STREAMADDPROP 10902 . 11012)) (11989 24870 (
\BASEBYTES.IO.INIT 11999 . 15195) (\MAKEBASEBYTESTREAM 15197 . 18509) (\MBS.OUTCHARFN 18511 . 18899) (
\BASEBYTES.NAME.FROM.STREAM 18901 . 19364) (\BASEBYTES.BOUT 19366 . 20083) (\BASEBYTES.SETFILEPTR
20085 . 20706) (\BASEBYTES.READP 20708 . 21344) (\BASEBYTES.BIN 21346 . 21877) (\BASEBYTES.PEEKBIN
21879 . 22710) (\BASEBYTES.TRUNCATEFN 22712 . 23216) (\BASEBYTES.OPENFN 23218 . 23708) (
\BASEBYTES.BLOCKIO 23710 . 24868)) (24993 28302 (OPENSTRINGSTREAM 25003 . 26720) (MAKE-STRING-FORMAT
26722 . 28300)) (28574 33235 (\STRINGSTREAM.INIT 28584 . 33233)) (33312 36884 (GETSTREAM 33322 . 33545
) (\ADDOFD 33547 . 33834) (\CLEAROFD 33836 . 34117) (\DELETEOFD 34119 . 34270) (\GETSTREAM 34272 .
36436) (\SEARCHOPENFILES 36438 . 36882)))))
(FILEMAP (NIL (2464 3583 (\ADD-OPEN-STREAM 2474 . 2755) (\GENERIC-UNREGISTER-STREAM 2757 . 3581)) (
3624 10688 (CLOSEALL 3634 . 4112) (CLOSEF 4114 . 5328) (EOFCLOSEF 5330 . 5630) (INPUT 5632 . 6402) (
OPENP 6404 . 6807) (OUTPUT 6809 . 7581) (POSITION 7583 . 8391) (RANDACCESSP 8393 . 8783) (\IOMODEP
8785 . 9414) (WHENCLOSE 9416 . 10686)) (10689 10811 (STREAMADDPROP 10699 . 10809)) (11769 24326 (
\BASEBYTES.IO.INIT 11779 . 14979) (\MAKEBASEBYTESTREAM 14981 . 17909) (\MBS.OUTCHARFN 17911 . 18311) (
\BASEBYTES.NAME.FROM.STREAM 18313 . 18772) (\BASEBYTES.BOUT 18774 . 19528) (\BASEBYTES.SETFILEPTR
19530 . 20151) (\BASEBYTES.READP 20153 . 20797) (\BASEBYTES.BIN 20799 . 21306) (\BASEBYTES.PEEKBIN
21308 . 22138) (\BASEBYTES.TRUNCATEFN 22140 . 22648) (\BASEBYTES.OPENFN 22650 . 23148) (
\BASEBYTES.BLOCKIO 23150 . 24324)) (24449 27753 (OPENSTRINGSTREAM 24459 . 26168) (MAKE-STRING-FORMAT
26170 . 27751)) (28025 32333 (\STRINGSTREAM.INIT 28035 . 32331)) (32410 35110 (GETSTREAM 32420 . 32651
) (\CLEAROFD 32653 . 32946) (\GETSTREAM 32948 . 35108)))))
STOP