(FILECREATED "16-Sep-86 20:00:38" {ERIS}<LISPCORE>SOURCES>AOFD.;26 38889
changes to: (FNS \RESETOFDS)
previous date: "10-Sep-86 22:48:43" {ERIS}<LISPCORE>SOURCES>AOFD.;25)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT AOFDCOMS)
(RPAQQ AOFDCOMS ((* streams (= OpenFileDescriptors))
(COMS (FNS \ADD-OPEN-STREAM \DELETE-OPEN-STREAM)
(INITVARS (*ISSUE-CLOSE-WARNINGS* NIL))
(FNS CLOSEALL CLOSEF EOFCLOSEF INPUT OPENP OUTPUT POSITION RANDACCESSP
\IOMODEP WHENCLOSE)
(FNS STREAMADDPROP)
(INITVARS (DEFAULTEOFCLOSE (QUOTE NILL))
(\OPENFILES))
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES))
(COMS (* STREAM interface to Read and Write to random memory)
(DECLARE: DONTCOPY (EXPORT (RECORDS BASEBYTESTREAM)))
(FNS \BASEBYTES.IO.INIT \MAKEBASEBYTESTREAM \MBS.OUTCHARFN
\BASEBYTES.NAME.FROM.STREAM \BASEBYTES.BOUT \BASEBYTES.SETFILEPTR
\BASEBYTES.READP \BASEBYTES.BIN \BASEBYTES.PEEKBIN \BASEBYTES.TRUNCATEFN
\BASEBYTES.OPENFN \BASEBYTES.BLOCKIO)
(GLOBALVARS \BASEBYTESDEVICE)
(DECLARE: DONTEVAL@LOAD (P (\BASEBYTES.IO.INIT)))
(FNS OPENSTRINGSTREAM))
(COMS (* STREAM interface for old-style strings)
(FNS \STRINGSTREAM.INIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT))))
(COMS (FNS GETSTREAM \ADDOFD \CLEAROFD \DELETEOFD \GETSTREAM \RESETOFDS
\SEARCHOPENFILES)
(DECLARE: DONTCOPY (EXPORT (MACROS \INSTREAMARG \OUTSTREAMARG \STREAMARG)))
(MACROS GETOFD \GETOFD))
(LOCALVARS . T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA WHENCLOSE)
))))
(* streams (= OpenFileDescriptors))
(DEFINEQ
(\ADD-OPEN-STREAM
[LAMBDA (DEVICE STREAM) (* hdj "28-May-86 11:22")
(if (NOT (STREAMP STREAM))
then (\ILLEGAL.ARG STREAM))
(pushnew (fetch (FDEV OPENFILELST) of DEVICE)
STREAM)
STREAM])
(\DELETE-OPEN-STREAM
[LAMBDA (STREAM DEVICE) (* hdj "18-Jul-86 11:14")
(DECLARE (GLOBALVARS *ISSUE-CLOSE-WARNINGS*))
(if (NOT (STREAMP STREAM))
then (\ILLEGAL.ARG STREAM))
(LET ((OPENFILELST (fetch (FDEV OPENFILELST) of DEVICE)))
(if (AND *ISSUE-CLOSE-WARNINGS* (NOT (FMEMB STREAM OPENFILELST)))
then (ERROR "Closing a stream that's not open!" STREAM))
(replace (FDEV OPENFILELST) of DEVICE with (DREMOVE STREAM OPENFILELST))
STREAM])
)
(RPAQ? *ISSUE-CLOSE-WARNINGS* NIL)
(DEFINEQ
(CLOSEALL
[LAMBDA (ALLFLG)
(DECLARE (LOCALVARS . T)) (* hdj "11-Jul-86 10:33")
(if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then (ERROR "CLOSEALL no longer supported")
else (for STREAM in (PROG1 (APPEND \OPENFILES) (* Need to APPEND because CLOSEF will
remove things from \OPENFILES)
) when [AND (fetch USERVISIBLE of STREAM)
(\IOMODEP STREAM NIL T)
(OR ALLFLG (NOT (STREAMPROP STREAM (QUOTE CLOSEALL]
collect (CLOSEF STREAM])
(CLOSEF
[LAMBDA (FILE) (* hdj "10-Jul-86 18:59")
(PROG ((STREAM (\GETSTREAM FILE)))
(COND
((OR (\OUTTERMP STREAM)
(NOT (fetch USERCLOSEABLE of STREAM)))
(RETURN NIL)))
[MAPC (STREAMPROP STREAM (QUOTE BEFORECLOSE))
(FUNCTION (LAMBDA (FN)
(APPLY* FN STREAM]
(\CLEAROFD)
(COND
((EQ STREAM \PRIMIN.OFD)
(SETQ \PRIMIN.OFD \LINEBUF.OFD)))
(COND
((EQ STREAM \PRIMOUT.OFD)
(SETQ \PRIMOUT.OFD \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))
(\CLOSEFILE STREAM)
[MAPC (STREAMPROP STREAM (QUOTE AFTERCLOSE))
(FUNCTION (LAMBDA (FN)
(APPLY* FN STREAM]
(RETURN (fetch FULLNAME of STREAM])
(EOFCLOSEF
[LAMBDA (FILE) (* bvm: "15-Jan-85 17:58")
(DECLARE (LOCALVARS . T))
(PROG ((STREAM (GETSTREAM FILE)))
(APPLY* (OR (STREAMPROP STREAM (QUOTE EOFCLOSE))
DEFAULTEOFCLOSE)
STREAM])
(INPUT
[LAMBDA (FILE) (* hdj "15-Jul-86 17:39")
(PROG1 (if (EQ \PRIMIN.OFD \LINEBUF.OFD)
then T
else (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then \PRIMIN.OFD
else (fetch FULLNAME of \PRIMIN.OFD)))
(COND
(FILE (SETQ \PRIMIN.OFD (COND
((EQ FILE T) (* Check explicitly for T to avoid
needless creations)
\LINEBUF.OFD)
(T (\GETSTREAM FILE (QUOTE INPUT])
(OPENP
[LAMBDA (FILE ACCESS) (* hdj "16-Jul-86 10:59")
(DECLARE (GLOBALVARS \OPENFILES MULTIPLE.STREAMS.PER.FILE.ALLOWED \FILEDEVICES))
(if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then (if (AND FILE (type? STREAM FILE))
then (\GETSTREAM FILE ACCESS T)
elseif FILE
then NIL
else (\MAP-OPEN-STREAMS (FUNCTION EVQ)
\FILEDEVICES NIL))
else (* "the old code")
(for STREAM in \OPENFILES first [COND
(FILE (RETURN (AND (SETQ STREAM (\GETSTREAM FILE ACCESS
T))
(fetch FULLNAME of STREAM]
when (AND (fetch USERVISIBLE of STREAM)
(\IOMODEP STREAM ACCESS T)) collect (fetch FULLNAME of STREAM])
(OUTPUT
[LAMBDA (FILE) (* hdj "15-Jul-86 17:40")
(PROG1 (if (EQ \PRIMOUT.OFD \TERM.OFD)
then T
else (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then \PRIMOUT.OFD
else (fetch FULLNAME of \PRIMOUT.OFD)))
(COND
(FILE (SETQ \PRIMOUT.OFD (COND
((EQ FILE T) (* Check for this special so we don't
create a tty window needlessly)
\TERM.OFD)
(T (\GETSTREAM FILE (QUOTE OUTPUT])
(POSITION
[LAMBDA (FILE N) (* rmk: "14-OCT-83 15:32")
(PROG [(STRM (COND
(FILE (\GETSTREAM FILE))
(T \PRIMOUT.OFD]
(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])
(RANDACCESSP
[LAMBDA (FILE) (* rmk: "14-OCT-83 15:32")
(PROG ((STREAM (\GETSTREAM FILE)))
(RETURN (AND (fetch RANDOMACCESSP of (fetch DEVICE of STREAM))
(NEQ STREAM \LINEBUF.OFD)
(fetch 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)
(COND
([COND
((NOT ACCESS)
(fetch ACCESS of STREAM))
((EQ ACCESS (fetch ACCESS of STREAM)))
[(EQ (fetch ACCESS of STREAM)
(QUOTE BOTH))
(FMEMB ACCESS (QUOTE (INPUT OUTPUT]
((EQ (fetch ACCESS of STREAM)
(QUOTE APPEND))
(EQ ACCESS (QUOTE OUTPUT]
STREAM)
(T (\FILE.NOT.OPEN STREAM NOERROR])
(WHENCLOSE
[LAMBDA NARGS (* lmm " 2-Sep-84 16:07")
(DECLARE (LOCALVARS . T))
(PROG [(STREAM (AND (IGREATERP NARGS 0)
(GETSTREAM (ARG NARGS 1]
[for I FN from 2 to NARGS by 2
do [SETQ FN (AND (IGREATERP NARGS I)
(ARG NARGS (ADD1 I]
(SELECTQ (ARG NARGS I)
(CLOSEALL [STREAMPROP STREAM (QUOTE CLOSEALL)
(SELECTQ FN
(NO T)
(YES NIL)
(ERRORX (LIST 27 FN])
(BEFORE (COND
(FN (STREAMADDPROP STREAM (QUOTE BEFORECLOSE)
FN T))))
(AFTER (COND
(FN (STREAMADDPROP STREAM (QUOTE AFTERCLOSE)
FN T))))
(STATUS (STREAMPROP STREAM (QUOTE STATUSFN)
FN))
(EOF (STREAMPROP STREAM (QUOTE EOFCLOSE)
FN))
(ERRORX (LIST 27 (ARG NARGS I]
(RETURN STREAM])
)
(DEFINEQ
(STREAMADDPROP
[LAMBDA (STREAM PROP VAL)
(STREAMPROP STREAM PROP (CONS VAL (STREAMPROP STREAM PROP])
)
(RPAQ? DEFAULTEOFCLOSE (QUOTE NILL))
(RPAQ? \OPENFILES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES)
)
(* STREAM interface to Read and Write to random memory)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM)
(ACCESSFNS ((BIASOFFST (fetch (STREAM FW6) of DATUM)
(replace (STREAM FW6) of DATUM with NEWVALUE))
(BBSNCHARS (fetch (STREAM FW7) of DATUM)
(replace (STREAM FW7) of DATUM with NEWVALUE))
(WRITEXTENSIONFN (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE)))))
]
(* END EXPORTED DEFINITIONS)
)
(DEFINEQ
(\BASEBYTES.IO.INIT
[LAMBDA NIL
(DECLARE (GLOBALVARS \BASECHARDEVICE)) (* JonL " 8-NOV-83 03:11")
(SETQ \BASEBYTESDEVICE
(create FDEV
DEVICENAME ← (QUOTE BASEBYTES)
RESETABLE ← T
RANDOMACCESSP ← T
PAGEMAPPED ← NIL
FDBINABLE ← T
FDBOUTABLE ← T
FDEXTENDABLE ← NIL
CLOSEFILE ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
GETFILEINFO ← (FUNCTION NILL)
GETFILENAME ← (FUNCTION \BASEBYTES.NAME.FROM.STREAM)
HOSTNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION \BASEBYTES.OPENFN)
READPAGES ← (FUNCTION NILL)
REOPENFILE ← [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM)
STREAM]
SETFILEINFO ← (FUNCTION NILL)
TRUNCATEFILE ← [FUNCTION (LAMBDA (STREAM I]
WRITEPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
BIN ← (FUNCTION \BASEBYTES.BIN)
BOUT ← (FUNCTION \BASEBYTES.BOUT)
PEEKBIN ← (FUNCTION \BASEBYTES.PEEKBIN)
READP ← (FUNCTION \BASEBYTES.READP)
BACKFILEPTR ← [FUNCTION (LAMBDA (STREAM)
(AND (NEQ (fetch COFFSET of STREAM)
(fetch BIASOFFST of STREAM))
(\PAGEDBACKFILEPTR STREAM]
SETFILEPTR ← (FUNCTION \BASEBYTES.SETFILEPTR)
GETFILEPTR ← [FUNCTION (LAMBDA (STREAM)
(IDIFFERENCE (fetch COFFSET of STREAM)
(fetch BIASOFFST of STREAM]
GETEOFPTR ← [FUNCTION (LAMBDA (STREAM)
(IDIFFERENCE (fetch EOFFSET of STREAM)
(fetch BIASOFFST of STREAM]
EOFP ← [FUNCTION (LAMBDA (STREAM)
(IGEQ (fetch COFFSET of STREAM)
(fetch EOFFSET of STREAM]
BLOCKIN ← [FUNCTION (LAMBDA (STREAM BASE OFFST N)
(\BASEBYTES.BLOCKIO STREAM BASE OFFST N (QUOTE INPUT]
BLOCKOUT ← [FUNCTION (LAMBDA (STREAM BASE OFFST N)
(\BASEBYTES.BLOCKIO STREAM BASE OFFST N (QUOTE OUTPUT]
RENAMEFILE ← (FUNCTION \ILLEGAL.DEVICEOP)))
(\DEFINEDEVICE NIL \BASEBYTESDEVICE])
(\MAKEBASEBYTESTREAM
[LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM) (* rmk: "26-Mar-85 22:15")
(* 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))
(OR (AND (SMALLP OFFST)
(SMALLP LEN)
(SMALLP (add LEN OFFST)))
(SHOULDNT "Currently can't support fixp-sized offsets"))
(SELECTQ ACCESS
(NIL (SETQ ACCESS (QUOTE INPUT)))
((INPUT OUTPUT BOTH))
(\ILLEGAL.ARG ACCESS))
(if (type? STREAM OSTREAM)
then (if (EQ (ffetch (STREAM DEVICE) of OSTREAM)
\BASEBYTESDEVICE)
then (replace ACCESS of OSTREAM with NIL)
else (CLOSEF OSTREAM)
(SETQ OSTREAM (create BASEBYTESTREAM
DEVICE ← \BASEBYTESDEVICE smashing OSTREAM)))
else (SETQ OSTREAM (create BASEBYTESTREAM
DEVICE ← \BASEBYTESDEVICE)))
(UNINTERRUPTABLY
(freplace USERCLOSEABLE of OSTREAM with NIL)
(freplace USERVISIBLE of OSTREAM with NIL)
(freplace BYTESIZE of OSTREAM with BITSPERBYTE)
(freplace CPAGE of OSTREAM with (freplace EPAGE of OSTREAM with 0))
(freplace CPPTR of OSTREAM with BASE)
(freplace COFFSET of OSTREAM with (freplace BIASOFFST of OSTREAM with OFFST))
(freplace CBUFSIZE of OSTREAM with (freplace EOFFSET of OSTREAM with LEN))
(replace 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)
(freplace FULLFILENAME of OSTREAM with NIL)
(freplace OUTCHARFN of OSTREAM with (FUNCTION \MBS.OUTCHARFN))
(freplace LINELENGTH of OSTREAM with 0)
(freplace CHARPOSITION of OSTREAM with 0)
(freplace WRITEXTENSIONFN of OSTREAM with (SELECTQ ACCESS
((OUTPUT BOTH)
WRITEXTENSIONFN)
NIL))
(freplace BBSNCHARS of OSTREAM with 0))
OSTREAM])
(\MBS.OUTCHARFN
[LAMBDA (STREAM CHAR) (* JonL " 7-NOV-83 21:54")
(BOUT (SETQ STREAM (\DTEST STREAM (QUOTE 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) (* JonL " 7-NOV-83 21:38")
(* 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 CPPTR of STREAM)
(fetch BIASOFFST of STREAM)
(GETEOFPTR STREAM])
(\BASEBYTES.BOUT
[LAMBDA (STREAM BYTE) (* JonL " 7-NOV-83 21:14")
(PROG (CO)
A (if (IGEQ (SETQ CO (fetch COFFSET of STREAM))
(fetch EOFFSET of STREAM))
then (if (SETQ CO (fetch (BASEBYTESTREAM WRITEXTENSIONFN) of STREAM))
then (APPLY* CO STREAM)
(GO A)
else (ERROR "Attempt to write past end of bytes block")))
(RETURN (\PUTBASEBYTE (fetch CPPTR of STREAM)
(PROG1 CO (freplace COFFSET of STREAM with (ADD1 CO)))
BYTE])
(\BASEBYTES.SETFILEPTR
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:56")
(PROG ((I' I))
(SELECTQ (SYSTEMTYPE)
(VAX (if (fetch FULLFILENAME of STREAM)
then (RETURN (replace F2 of STREAM with INDX))))
NIL)
(add I' (fetch BIASOFFST of STREAM))
(if (IGREATERP I' (fetch EOFFSET of STREAM))
then (ERROR "Beyond end of byte range" I)
else (replace COFFSET of STREAM with I'])
(\BASEBYTES.READP
[LAMBDA (STREAM FLG) (* bvm: "14-Feb-85 00:21")
(PROG ((CO (fetch COFFSET of STREAM))
(#LEFT (fetch EOFFSET of STREAM)))
(add #LEFT (IMINUS CO))
(RETURN (OR (IGEQ #LEFT 2)
(if (EQ #LEFT 0)
then NIL
elseif FLG
else (NEQ (\GETBASEBYTE (fetch CPPTR of STREAM)
(fetch COFFSET of STREAM))
(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)
(PROG1 (\BASEBYTES.PEEKBIN STREAM)
(add (fetch COFFSET of STREAM)
1])
(\BASEBYTES.PEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* JonL " 7-NOV-83 23:41")
(PROG ((CO (fetch COFFSET of STREAM)))
(SELECTQ (SYSTEMTYPE)
(VAX (if (fetch FULLNAME of STREAM)
then (* Aha, it's a string stream)
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
NIL)
(RETURN (if (IGEQ CO (fetch EOFFSET of STREAM))
then (if (NOT NOERRORFLG)
then (STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM))
else (\GETBASEBYTE (fetch CPPTR of STREAM)
CO])
(\BASEBYTES.TRUNCATEFN
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:20")
([LAMBDA (I' BO EO)
(add I' BO)
(if (ILESSP I 0)
then (add I' EO))
(if (OR (ILESSP I BO)
(IGREATERP I' EO))
then (ERROR "Beyond end of byte range" I)
else (replace EOFFSET of STREAM with I']
I
(fetch BIASOFFST of STREAM)
(fetch EOFFSET of STREAM])
(\BASEBYTES.OPENFN
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* lmm "16-Aug-84 13:17")
(if (fetch FULLFILENAME of NAME)
then (OPENSTRINGSTREAM NAME ACCESS)
else (\MAKEBASEBYTESTREAM (fetch CPPTR of NAME)
(fetch BIASOFFST of NAME)
(GETEOFPTR NAME)
ACCESS
(fetch WRITEXTENSIONFN of NAME)
NAME])
(\BASEBYTES.BLOCKIO
[LAMBDA (STREAM BASE OFFST N DIRECTION) (* JonL " 8-JUL-83 01:54")
(PROG (SBASE CO EO)
A (if (ILEQ N 0)
then (RETURN))
(SETQ SBASE (fetch CPPTR of STREAM))
(SETQ CO (fetch COFFSET of STREAM))
(SETQ EO (fetch EOFFSET of STREAM))
(if (IGREATERP N (IDIFFERENCE EO (SUB1 CO)))
then (if (EQ DIRECTION (QUOTE INPUT))
then (STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM)
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)
(GO A)))
(replace COFFSET of STREAM with (IPLUS CO N))
(if (EQ DIRECTION (QUOTE OUTPUT))
then (swap SBASE BASE)
(swap CO OFFST))
(\MOVEBYTES SBASE CO BASE OFFST N])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \BASEBYTESDEVICE)
)
(DECLARE: DONTEVAL@LOAD
(\BASEBYTES.IO.INIT)
)
(DEFINEQ
(OPENSTRINGSTREAM
[LAMBDA (STR ACCESS) (* rmk: "28-Mar-85 08:40")
(* Does not register the stream on \OPENFILES, nor does it search \OPENFILES
for a previously opened stream. Thus, this implementation does not side-effect
the string as the 10 does. However, the temporary coercion of strings to open
streams in \GETSTREAM does simulate the side-effecting.
Note that a string stream is unnamed.)
(PROG (STREAM FATP)
(OR (STRINGP STR)
(\ILLEGAL.ARG STR))
(SETQ FATP (ffetch (STRINGP FATSTRINGP) of STR))
[SETQ STREAM (\MAKEBASEBYTESTREAM (OR (ffetch (STRINGP BASE) of STR)
T)
(COND
(FATP (UNFOLD (ffetch (STRINGP OFFST) of STR)
BYTESPERWORD))
(T (ffetch (STRINGP OFFST) of STR)))
(COND
(FATP (UNFOLD (ffetch (STRINGP LENGTH) of STR)
BYTESPERWORD))
(T (ffetch (STRINGP LENGTH) of STR)))
(SELECTQ ACCESS
((INPUT OUTPUT BOTH)
ACCESS)
(NIL (QUOTE INPUT))
(\ILLEGAL.ARG ACCESS]
(PROGN (* Minor differences between a
basebytestream and a stringstream)
(if FATP
then (freplace (STREAM CHARSET) of STREAM with \NORUNCODE))
(freplace USERCLOSEABLE of STREAM with T)
(freplace USERVISIBLE of STREAM with T)
(SELECTQ (SYSTEMTYPE)
(VAX (freplace F2 of STREAM with 0)
(freplace STRMBINFN of STREAM with (FUNCTION \STRINGBIN)))
NIL))
(RETURN STREAM])
)
(* STREAM interface for old-style strings)
(DEFINEQ
(\STRINGSTREAM.INIT
[LAMBDA NIL (* bvm: "14-Feb-85 00:25")
(SETQ \STRINGSTREAM.FDEV (create FDEV
DEVICENAME ← (QUOTE STRING)
CLOSEFILE ← (FUNCTION NILL)
DELETEFILE ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
GENERATEFILES ← (FUNCTION \NULLFILEGENERATOR)
GETFILEINFO ← (FUNCTION NILL)
GETFILENAME ← (FUNCTION NILL)
HOSTNAMEP ← (FUNCTION NILL)
OPENFILE ← (FUNCTION NILL)
READPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
REOPENFILE ← [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV
STREAM)
STREAM]
SETFILEINFO ← (FUNCTION NILL)
TRUNCATEFILE ← (FUNCTION NILL)
WRITEPAGES ← (FUNCTION \ILLEGAL.DEVICEOP)
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]
PEEKBIN ← [FUNCTION (LAMBDA (STREAM NOERRORFLG)
(OR (fetch F1 of STREAM)
(CHCON1 (fetch FULLFILENAME
of STREAM))
(AND (NOT NOERRORFLG)
(\EOF.ACTION STREAM]
READP ← [FUNCTION (LAMBDA (STREAM)
(NOT (EOFP STREAM]
BACKFILEPTR ← [FUNCTION (LAMBDA (STREAM)
(replace F1 of STREAM
with (fetch F2 of STREAM]
EOFP ← (FUNCTION (LAMBDA (STREAM)
(AND (NOT (fetch F1 of STREAM))
(EQ (NCHARS (fetch FULLFILENAME
of STREAM))
0])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\STRINGSTREAM.INIT)
)
(DEFINEQ
(GETSTREAM
[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)
])
(\DELETEOFD
[LAMBDA (OFD) (* rmk: "25-OCT-79 08:20")
(SETQ \OPENFILES (DREMOVE OFD \OPENFILES])
(\GETSTREAM
[LAMBDA (X ACCESS NOERROR) (* bvm: "10-Sep-86 22:10")
(* \GETSTREAM accepts either a: file name, a file handle, stream, a string,
NIL, T, or a partial file name. -
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
((NULL X)
(SELECTQ ACCESS
(INPUT (COND
((AND (EQ \PRIMIN.OFD \DEFAULTLINEBUF)
(EQ \KEYBOARD.STREAM (fetch (LINEBUFFER KEYBOARDSTREAM) of \LINEBUF.OFD))
)
(\CREATE.TTYDISPLAYSTREAM)))
\PRIMIN.OFD)
(OUTPUT (COND
((AND \DEFAULTTTYDISPLAYSTREAM (EQ \PRIMOUT.OFD \DEFAULTTTYDISPLAYSTREAM))
(\CREATE.TTYDISPLAYSTREAM)))
\PRIMOUT.OFD)
(\IOMODEP (COND
((NOT (EQ \PRIMIN.OFD \LINEBUF.OFD))
\PRIMIN.OFD)
(T \PRIMOUT.OFD))
ACCESS NOERROR)))
((EQ X T)
(SELECTQ ACCESS
(INPUT (COND
((EQ \LINEBUF.OFD \DEFAULTLINEBUF)
(\CREATE.TTYDISPLAYSTREAM)))
\LINEBUF.OFD)
((OUTPUT NIL)
(COND
((AND \DEFAULTTTYDISPLAYSTREAM (EQ \TERM.OFD \DEFAULTTTYDISPLAYSTREAM))
(\CREATE.TTYDISPLAYSTREAM)))
\TERM.OFD)
(\FILE.NOT.OPEN X NOERROR)))
((type? STREAM X)
(\IOMODEP X ACCESS NOERROR))
[(LITATOM X)
(if MULTIPLE.STREAMS.PER.FILE.ALLOWED
then (AND (NOT NOERROR)
(ERROR "LITATOM 'streams' no longer supported" X))
else (OR (\SEARCHOPENFILES X ACCESS)
(\FILE.NOT.OPEN X NOERROR]
((STRINGP X)
(SELECTQ ACCESS
((NIL INPUT)
NIL)
(\FILE.NOT.OPEN X NOERROR))
(\SETACCESS (SETQ X (create STREAM
DEVICE ← \STRINGSTREAM.FDEV
FULLFILENAME ← X))
(QUOTE INPUT))
X)
((AND (OR (EQ ACCESS (QUOTE OUTPUT))
(NULL ACCESS))
(type? WINDOW X))
(fetch (WINDOW DSP) of X))
(T (\FILE.NOT.OPEN X NOERROR])
(\RESETOFDS
(LAMBDA NIL (* hdj "16-Sep-86 19:05")
(* ;;
"reinitialize all streams upon returning from a MAKESYS or SYSOUT")
(DECLARE (GLOBALVARS \FILEDEVICES)) (* ;;
"first reset processes' standard inputs and outputs")
(MAP.PROCESSES (FUNCTION (LAMBDA NIL
(\OPENLINEBUF)
(SETQ \PRIMOUT.OFD \TERM.OFD)
(SETQ \PRIMIN.OFD \LINEBUF.OFD)
(SETQ \DRIBBLE.OFD NIL)
(PUTSTREAMPROP \TERM.OFD (QUOTE DRIBBLESTREAM)
NIL)))) (* ;;
"then release all pages held by page-mapped streams (this is a no-op for all others)")
(\MAP-OPEN-STREAMS (FUNCTION (LAMBDA (STREAM)
(replace (STREAM CPPTR) of STREAM with NIL)
(FORGETPAGES STREAM)
(replace (STREAM ACCESS) of STREAM with NIL)))
\FILEDEVICES NIL) (* ;; "finally, delete each device's open streams - THIS WILL BREAK AS SOON AS DEVICES THAT DON'T WORK WITH \DELETE-OPEN-STREAM COME INTO EXISTENCE!")
(for DEV in \FILEDEVICES do (AND (fetch (FDEV OPENP) of DEV)
(for STREAM in (COPY (FDEVOP (QUOTE OPENP)
DEV NIL NIL DEV))
do (\DELETE-OPEN-STREAM STREAM DEV))))))
(\SEARCHOPENFILES
[LAMBDA (NAME ACCESS) (* rmk: "14-OCT-83 15:04")
(* Returns a stream whose fullname is
NAME if it has accessmode ACCESS)
(for STREAM in \OPENFILES when (EQ NAME (fetch FULLNAME of STREAM))
do (RETURN (COND
(ACCESS (\IOMODEP STREAM ACCESS T))
(T STREAM])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \INSTREAMARG MACRO ((STRM NOERRORFLG)
(\GETSTREAM STRM (QUOTE INPUT)
NOERRORFLG)))
(PUTPROPS \OUTSTREAMARG MACRO ((STRM NOERRORFLG)
(\GETSTREAM STRM (QUOTE OUTPUT)
NOERRORFLG)))
(PUTPROPS \STREAMARG MACRO (OPENLAMBDA (STRM NOERRORFLG)
(COND (NOERRORFLG (\GETSTREAM STRM NIL T))
(T (\DTEST STRM (QUOTE STREAM))))))
)
(* END EXPORTED DEFINITIONS)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS GETOFD MACRO (= . GETSTREAM))
(PUTPROPS \GETOFD MACRO (= . \GETSTREAM))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA WHENCLOSE)
)
(PUTPROPS AOFD COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2475 3357 (\ADD-OPEN-STREAM 2485 . 2770) (\DELETE-OPEN-STREAM 2772 . 3355)) (3398 11572
(CLOSEALL 3408 . 4157) (CLOSEF 4159 . 5358) (EOFCLOSEF 5360 . 5670) (INPUT 5672 . 6413) (OPENP 6415
. 7552) (OUTPUT 7554 . 8312) (POSITION 8314 . 9117) (RANDACCESSP 9119 . 9471) (\IOMODEP 9473 . 10243)
(WHENCLOSE 10245 . 11570)) (11573 11695 (STREAMADDPROP 11583 . 11693)) (12673 25460 (
\BASEBYTES.IO.INIT 12683 . 15386) (\MAKEBASEBYTESTREAM 15388 . 18232) (\MBS.OUTCHARFN 18234 . 18752) (
\BASEBYTES.NAME.FROM.STREAM 18754 . 19445) (\BASEBYTES.BOUT 19447 . 20158) (\BASEBYTES.SETFILEPTR
20160 . 20762) (\BASEBYTES.READP 20764 . 21390) (\BASEBYTES.BIN 21392 . 22395) (\BASEBYTES.PEEKBIN
22397 . 23222) (\BASEBYTES.TRUNCATEFN 23224 . 23736) (\BASEBYTES.OPENFN 23738 . 24221) (
\BASEBYTES.BLOCKIO 24223 . 25458)) (25576 27922 (OPENSTRINGSTREAM 25586 . 27920)) (27974 31624 (
\STRINGSTREAM.INIT 27984 . 31622)) (31680 37834 (GETSTREAM 31690 . 31921) (\ADDOFD 31923 . 32321) (
\CLEAROFD 32323 . 32626) (\DELETEOFD 32628 . 32786) (\GETSTREAM 32788 . 35475) (\RESETOFDS 35477 .
37296) (\SEARCHOPENFILES 37298 . 37832)))))
STOP