(FILECREATED "27-Sep-84 09:34:09" {ERIS}<LISPCORE>SOURCES>FILEIO.;20 88664
changes to: (FNS COPYCHARS)
previous date: " 7-Sep-84 14:38:47" {ERIS}<LISPCORE>SOURCES>FILEIO.;19)
(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILEIOCOMS)
(RPAQQ FILEIOCOMS [(* Device independent IO. This file is used by VAX)
(COMS (* STREAM, FDEV declarations)
(DECLARE: FIRST DOCOPY (* The microcode relies on STREAM being of a particular type,
viz. the first type declared in the initial loadup
(after VMEMPAGEP))
(INITRECORDS STREAM))
(SYSRECORDS STREAM)
(DECLARE: DONTCOPY (EXPORT (RECORDS STREAM)
(MACROS STREAMOP)
(CONSTANTS AppendBit NoBits ReadBit WriteBit
(OutputBits (LOGOR AppendBit WriteBit))
(BothBits (LOGOR ReadBit OutputBits)))
(MACROS APPENDABLE APPENDONLY DIRTYABLE OPENED OVERWRITEABLE
READABLE READONLY WRITEABLE)
(MACROS TestMasked)
(CONSTANTS * EOLCONVENTIONS)))
(FNS STREAMPROP GETSTREAMPROP PUTSTREAMPROP STREAMP)
(COMS (* Needed b/c of STREAM initialization)
(INITVARS (FILELINELENGTH 102)
(\STREAM.DEFAULT.MAXBUFFERS 3)))
(FNS \GETACCESS \SETACCESS)
(DECLARE: DONTCOPY (EXPORT (MACROS FDEVOP)
(RECORDS FDEV FILEGENOBJ)))
(INITRECORDS FDEV)
(SYSRECORDS FDEV))
(COMS (* Device operations)
(FNS \DEFINEDEVICE \GETDEVICEFROMNAME \REMOVEDEVICE \REMOVEDEVICE.NAMES)
(FNS \CLOSEFILE \DELETEFILE \DEVICEEVENT \GENERATEFILES \GENERATENEXTFILE
\GENERATEFILEINFO \GETFILENAME \GETFILENAME.OR.STREAM \OPENFILE \DO.PARAMS.AT.OPEN
\RENAMEFILE \REVALIDATEFILE \TRUNCATEFILE)
(COMS (* Generic enumerator)
(FNS \GENERATENOFILES \NULLFILEGENERATOR \NOFILESNEXTFILEFN \NOFILESINFOFN)
(DECLARE: DONTCOPY (RECORDS NOFILEGENSTATE)))
(FNS \FILE.NOT.OPEN \FILE.WONT.OPEN \ILLEGAL.DEVICEOP \IS.NOT.RANDACCESSP
\STREAM.NOT.OPEN)
(ADDVARS (\FILEDEVICES)
(\FILEDEVICENAMES)
(\DEVICENAMETODEVICE))
(COMS (* Device instances)
(FNS \FDEVINSTANCE)
(MACROS \INHERITFDEVOP.D \INHERITFDEVOP.S))
(INITVARS (LOGINHOST/DIR (QUOTE {DSK})))
(GLOBALVARS LOGINHOST/DIR \FILEDEVICES \FILEDEVICENAMES \DEVICENAMETODEVICE))
(COMS (* Directory defaulting)
(FNS CNDIR DIRECTORYNAME DIRECTORYNAMEP HOSTNAMEP \ADD.CONNECTED.DIR))
[COMS (* Binary I/O - Public functions)
(FNS \BACKFILEPTR \BACKPEEKBIN \BACKBIN BIN \BIN \BINS BOUT \BOUT \BOUTS COPYBYTES
COPYCHARS COPYFILE \COPYOPENFILE \INFER.FILE.TYPE EOFP FORCEOUTPUT
\FLUSH.OPEN.STREAMS GETEOFPTR GETFILEINFO GETFILEPTR SETFILEINFO SETFILEPTR)
(* Generic functions)
(FNS \GENERIC.BINS \GENERIC.BOUTS \GENERIC.RENAMEFILE \GENERIC.READP)
(DECLARE: DONTCOPY (EXPORT (MACROS \OUTCHAR)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (MAPC (QUOTE ((FORCEOUTPUT FLUSHOUTPUT)
(FORCEOUTPUT FLUSHMAP)
(\GENERIC.BINS \NONPAGEDBINS)
(\GENERIC.BOUTS \NONPAGEDBOUTS)))
(FUNCTION (LAMBDA (PAIR)
(PUTD (CADR PAIR)
(GETD (CAR PAIR))
T]
(COMS (* Internal functions)
(FNS \EOF.ACTION \EOSERROR \GETEOFPTR \INCFILEPTR \PEEKBIN \SETCLOSEDFILELENGTH
\SETEOFPTR \SETFILEPTR)
(FNS \FIXPOUT \FIXPIN)
(DECLARE: DONTCOPY (EXPORT (MACROS \DECFILEPTR \GETFILEPTR \SIGNEDWIN \SIGNEDWOUT \WIN
\WOUT \BINS \BOUTS \EOFP)
(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ
(SYSTEMTYPE)
(VAX 10)
9))
WordsPerPage)
(RECORDS BYTEPTR))
(CONSTANTS MaxChar)))
(COMS (* Buffered IO)
(FNS \BUFFERED.BIN \BUFFERED.PEEKBIN \BUFFERED.BOUT \BUFFERED.BINS \BUFFERED.BOUTS
\BUFFERED.COPYBYTES))
[COMS (* NULL device)
(FNS \NULLDEVICE \NULL.OPENFILE)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\NULLDEVICE]
(LOCALVARS . T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA
\IS.NOT.RANDACCESSP
\ILLEGAL.DEVICEOP
STREAMPROP])
(* Device independent IO. This file is used by VAX)
(* STREAM, FDEV declarations)
(DECLARE: FIRST DOCOPY
(/DECLAREDATATYPE (QUOTE STREAM)
(QUOTE (WORD WORD FLAG FLAG FLAG (BITS 5)
POINTER FLAG FLAG FLAG FLAG FLAG (BITS 3)
POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER
POINTER WORD WORD BYTE POINTER WORD WORD WORD WORD WORD WORD
(BITS 2)
FLAG
(BITS 5)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD
WORD POINTER)))
)
[ADDTOVAR SYSTEMRECLST
(DATATYPE STREAM ((COFFSET WORD)
(CBUFSIZE WORD)
(BINABLE FLAG)
(BOUTABLE FLAG)
(EXTENDABLE FLAG)
(NIL BITS 5)
(CBUFPTR POINTER)
(NONDEFAULTDATEFLG FLAG)
(REVALIDATEFLG FLAG)
(MULTIBUFFERHINT FLAG)
(USERCLOSEABLE FLAG)
(USERVISIBLE FLAG)
(ACCESSBITS BITS 3)
(FULLFILENAME POINTER)
(DEVICE POINTER)
(VALIDATION POINTER)
(EPAGE WORD)
(EOFFSET WORD)
(F1 POINTER)
(F2 POINTER)
(F3 POINTER)
(F4 POINTER)
(F5 POINTER)
(FW6 WORD)
(FW7 WORD)
(BYTESIZE BYTE)
(BUFFS POINTER)
(CPAGE WORD)
(FW8 WORD)
(MAXBUFFERS WORD)
(CHARPOSITION WORD)
(DIRTYBITS WORD)
(LINELENGTH WORD)
(EOLCONVENTION BITS 2)
(CBUFDIRTY FLAG)
(NIL BITS 5)
(OUTCHARFN POINTER)
(ENDOFSTREAMOP POINTER)
(OTHERPROPS POINTER)
(IMAGEOPS POINTER)
(IMAGEDATA POINTER)
(EXTRASTREAMOP POINTER)
(STRMBINFN POINTER)
(STRMBOUTFN POINTER)
(CBUFMAXSIZE WORD)
(FW9 WORD)
(F10 POINTER)))
]
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE STREAM ( (* First 4 words are fixed for BIN, BOUT opcodes.
Length of whole datatype is multiple of 4, so
quad-aligned)
(COFFSET WORD) (* Offset in CPPTR of next bin or bout)
(CBUFSIZE WORD) (* Offset past last byte in that buffer)
(BINABLE FLAG) (* BIN punts unless this bit on)
(BOUTABLE FLAG) (* BOUT punts unless this bit on)
(EXTENDABLE FLAG) (* BOUT punts when COFFSET ge CBUFFSIZE unless this bit
set and COFFSET lt 512)
(NIL BITS 5)
(CBUFPTR POINTER) (* Pointer to current buffer)
(NONDEFAULTDATEFLG FLAG)
(REVALIDATEFLG FLAG)
(MULTIBUFFERHINT FLAG) (* True if stream likes to read and write more than one
buffer at a time)
(USERCLOSEABLE FLAG) (* Can be closed by CLOSEF; NIL for terminal,
dribble...)
(USERVISIBLE FLAG) (* Listed by OPENP; NIL for terminal, dribble ...)
(ACCESSBITS BITS 3) (* What kind of access file is open for
(read, write, append))
(FULLFILENAME POINTER) (* Name by which file is known to user)
(DEVICE POINTER) (* FDEV of this guy)
(VALIDATION POINTER) (* A number somehow identifying file, used to determine
if file has changed in our absence)
(EPAGE WORD)
(EOFFSET WORD) (* Page, byte offset of eof)
(* Following are device-specific fields)
(F1 POINTER)
(F2 POINTER)
(F3 POINTER)
(F4 POINTER)
(F5 POINTER)
(FW6 WORD)
(FW7 WORD) (* Following only filled in for open streams)
(BYTESIZE BYTE)
(BUFFS POINTER)
(CPAGE WORD)
(FW8 WORD)
(MAXBUFFERS WORD)
(CHARPOSITION WORD) (* Used by POSITION etc.)
(DIRTYBITS WORD)
(LINELENGTH WORD)
(EOLCONVENTION BITS 2) (* End-of-line convention)
(CBUFDIRTY FLAG)
(NIL BITS 5)
(OUTCHARFN POINTER)
(ENDOFSTREAMOP POINTER) (* For use of applications programs, not devices)
(OTHERPROPS POINTER)
(IMAGEOPS POINTER) (* Image operations vector)
(IMAGEDATA POINTER) (* Image instance variables--format depends on IMAGEOPS
value)
(EXTRASTREAMOP POINTER)
(STRMBINFN POINTER) (* Either the BIN fn from the FDEV, or a trap)
(STRMBOUTFN POINTER) (* Either the BIN fn from the FDEV, or a trap)
(CBUFMAXSIZE WORD)
(FW9 WORD)
(F10 POINTER))
(BLOCKRECORD STREAM ((NIL 2 WORD)
(UCODEFLAGS BYTE)
(NIL POINTER)))
[ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
(FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM)
DATUM))
(NAMEDP (AND (fetch (STREAM FULLFILENAME) of DATUM)
T]
(SYNONYM CBUFPTR (CPPTR))
USERCLOSEABLE ← T USERVISIBLE ← T ACCESSBITS ← NoBits BUFFS ← NIL BYTESIZE ← 8
CBUFPTR ← NIL MAXBUFFERS ←(PROGN (DECLARE (GLOBALVARS \STREAM.DEFAULT.MAXBUFFERS))
\STREAM.DEFAULT.MAXBUFFERS)
CHARPOSITION ← 0 LINELENGTH ←(PROGN (DECLARE (GLOBALVARS FILELINELENGTH))
FILELINELENGTH)
OUTCHARFN ←(FUNCTION \FILEOUTCHARFN)
ENDOFSTREAMOP ←(FUNCTION \EOSERROR)
IMAGEOPS ← \NOIMAGEOPS EOLCONVENTION ←(SELECTQ (SYSTEMTYPE)
(D CR.EOLC)
(VAX LF.EOLC)
(JERICHO CRLF.EOLC)
CR.EOLC)
STRMBINFN ←(FUNCTION \STREAM.NOT.OPEN)
STRMBOUTFN ←(FUNCTION \STREAM.NOT.OPEN))
]
(/DECLAREDATATYPE (QUOTE STREAM)
(QUOTE (WORD WORD FLAG FLAG FLAG (BITS 5)
POINTER FLAG FLAG FLAG FLAG FLAG (BITS 3)
POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER
POINTER WORD WORD BYTE POINTER WORD WORD WORD WORD WORD WORD
(BITS 2)
FLAG
(BITS 5)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD
WORD POINTER)))
(DECLARE: EVAL@COMPILE
(PUTPROPS STREAMOP MACRO [ARGS (CONS (QUOTE SPREADAPPLY*)
(CONS (COND
((EQ (CAR (LISTP (CAR ARGS)))
(QUOTE QUOTE))
(LIST (QUOTE fetch)
(CADAR ARGS)
(QUOTE of)
(CADR ARGS)))
(T (HELP "STREAMOP - OPNAME not quoted:" ARGS)))
(CDDR ARGS])
)
(DECLARE: EVAL@COMPILE
(RPAQQ AppendBit 2)
(RPAQQ NoBits 0)
(RPAQQ ReadBit 1)
(RPAQQ WriteBit 4)
(RPAQ OutputBits (LOGOR AppendBit WriteBit))
(RPAQ BothBits (LOGOR ReadBit OutputBits))
(CONSTANTS AppendBit NoBits ReadBit WriteBit (OutputBits (LOGOR AppendBit WriteBit))
(BothBits (LOGOR ReadBit OutputBits)))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS APPENDABLE MACRO ((STREAM)
(TestMasked (fetch ACCESSBITS of STREAM)
AppendBit)))
(PUTPROPS APPENDONLY MACRO ((STREAM)
(EQ (fetch ACCESSBITS of STREAM)
AppendBit)))
(PUTPROPS DIRTYABLE MACRO [(STREAM)
(TestMasked (fetch ACCESSBITS of STREAM)
(CONSTANT (LOGOR AppendBit WriteBit])
(PUTPROPS OPENED MACRO ((STREAM)
(NEQ (fetch ACCESSBITS of STREAM)
NoBits)))
(PUTPROPS OVERWRITEABLE MACRO ((STREAM)
(TestMasked (fetch ACCESSBITS of STREAM)
WriteBit)))
(PUTPROPS READABLE MACRO ((STREAM)
(TestMasked (fetch ACCESSBITS of STREAM)
ReadBit)))
(PUTPROPS READONLY MACRO ((STREAM)
(EQ (fetch ACCESSBITS of STREAM)
ReadBit)))
(PUTPROPS WRITEABLE MACRO [(STREAM)
(OR (OVERWRITEABLE STREAM)
(AND (APPENDABLE STREAM)
(\EOFP STREAM])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS TestMasked MACRO [(BITS MASK)
(NOT (ZEROP (LOGAND BITS MASK])
)
(RPAQQ EOLCONVENTIONS ((CR.EOLC 0)
(LF.EOLC 1)
(CRLF.EOLC 2)))
(DECLARE: EVAL@COMPILE
(RPAQQ CR.EOLC 0)
(RPAQQ LF.EOLC 1)
(RPAQQ CRLF.EOLC 2)
(CONSTANTS (CR.EOLC 0)
(LF.EOLC 1)
(CRLF.EOLC 2))
)
(* END EXPORTED DEFINITIONS)
)
(DEFINEQ
(STREAMPROP
[LAMBDA X (* rda: "22-Aug-84 14:24")
(* general top level entry for both fetching and setting
stream properties.)
(COND
((IGREATERP X 2)
(PUTSTREAMPROP (ARG X 1)
(ARG X 2)
(ARG X 3)))
((EQ X 2)
(GETSTREAMPROP (ARG X 1)
(ARG X 2)))
(T (\ILLEGAL.ARG NIL])
(GETSTREAMPROP
[LAMBDA (STREAM PROP) (* rda: "22-Aug-84 16:17")
(OR (type? STREAM STREAM)
(\ILLEGAL.ARG))
(LISTGET (fetch (STREAM OTHERPROPS) of STREAM)
PROP])
(PUTSTREAMPROP
[LAMBDA (STREAM PROP VALUE) (* rda: "22-Aug-84 16:11")
(OR (type? STREAM STREAM)
(\ILLEGAL.ARG STREAM))
(PROG ((OLDDATA (fetch OTHERPROPS of STREAM))
OLDVALUE)
(RETURN (PROG1 (COND
(OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
[COND
(VALUE (LISTPUT OLDDATA PROP VALUE))
(OLDVALUE (* Remove the property)
(COND
((EQ (CAR OLDDATA)
PROP)
(replace OTHERPROPS of STREAM
with (CDDR OLDDATA)))
(T (for TAIL on (CDR OLDDATA) by (CDDR TAIL)
when (EQ (CADR TAIL)
PROP)
do (FRPLACD TAIL (CDDDR TAIL))
(RETURN]
OLDVALUE)
(VALUE (replace OTHERPROPS of STREAM with (LIST PROP VALUE))
(* know old value is NIL)
NIL])
(STREAMP
[LAMBDA (X) (* rmk: "14-OCT-83 14:35")
(AND (TYPE? STREAM X)
X])
)
(* Needed b/c of STREAM initialization)
(RPAQ? FILELINELENGTH 102)
(RPAQ? \STREAM.DEFAULT.MAXBUFFERS 3)
(DEFINEQ
(\GETACCESS
[LAMBDA (STREAM) (* bvm: "26-DEC-81 15:43")
(* Decodes the access bits. The inverse of the encoding
in \SETACCESS. Ugly but no less so than the machinery to
do it elegantly.)
(SELECTC (fetch ACCESSBITS of STREAM)
(NoBits NIL)
(ReadBit (QUOTE INPUT))
(AppendBit (QUOTE APPEND))
(OutputBits (QUOTE OUTPUT))
(BothBits (QUOTE BOTH))
(SHOULDNT])
(\SETACCESS
[LAMBDA (STREAM ACCESS) (* rmk: " 7-NOV-83 15:02")
(* The setfn for the ACCESS field.
Does not assume that streams are initialized with all
bits off and \STREAM.NOT.OPEN installed)
(UNINTERRUPTABLY
(PROG ((DEVICE (fetch DEVICE of STREAM)))
(SELECTQ ACCESS
[NIL (replace ACCESSBITS of STREAM with NoBits)
(* Was open, now closing)
(replace BINABLE of STREAM with (replace BOUTABLE of STREAM
with (replace EXTENDABLE of STREAM
with NIL)))
(replace STRMBINFN of STREAM with (replace STRMBOUTFN of STREAM
with (FUNCTION \STREAM.NOT.OPEN]
(INPUT (replace ACCESSBITS of STREAM with ReadBit)
(* Was closed, now opening)
(replace BINABLE of STREAM with (fetch FDBINABLE of DEVICE))
(replace STRMBINFN of STREAM with (fetch BIN of DEVICE))
(replace STRMBOUTFN of STREAM with (FUNCTION \STREAM.NOT.OPEN))
(replace BOUTABLE of STREAM with (replace EXTENDABLE of STREAM
with NIL)))
(APPEND (replace ACCESSBITS of STREAM with AppendBit)
(replace BOUTABLE of STREAM with (fetch FDBOUTABLE of DEVICE))
(replace EXTENDABLE of STREAM with (fetch FDEXTENDABLE of DEVICE))
(replace STRMBOUTFN of STREAM with (fetch BOUT of DEVICE))
(replace STRMBINFN of STREAM with (FUNCTION \STREAM.NOT.OPEN))
(replace BINABLE of STREAM with NIL))
(OUTPUT (replace ACCESSBITS of STREAM with OutputBits)
(replace BOUTABLE of STREAM with (fetch FDBOUTABLE of DEVICE))
(replace EXTENDABLE of STREAM with (fetch FDEXTENDABLE of DEVICE))
(replace STRMBOUTFN of STREAM with (fetch BOUT of DEVICE))
(replace STRMBINFN of STREAM with (FUNCTION \STREAM.NOT.OPEN))
(replace BINABLE of STREAM with NIL))
(BOTH (replace ACCESSBITS of STREAM with BothBits)
(replace BINABLE of STREAM with (fetch FDBINABLE of DEVICE))
(replace BOUTABLE of STREAM with (fetch FDBOUTABLE of DEVICE))
(replace EXTENDABLE of STREAM with (fetch FDEXTENDABLE of DEVICE))
(replace STRMBINFN of STREAM with (fetch BIN of DEVICE))
(replace STRMBOUTFN of STREAM with (fetch BOUT of DEVICE)))
(RAID "Illegal stream access mode"))))
ACCESS])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS FDEVOP MACRO [ARGS (CONS (QUOTE SPREADAPPLY*)
(CONS (COND
((EQ (CAR (LISTP (CAR ARGS)))
(QUOTE QUOTE))
(LIST (QUOTE fetch)
(CADAR ARGS)
(QUOTE of)
(CADR ARGS)))
(T (HELP "FDEVOP - OPNAME not quoted:" ARGS)))
(CDDR ARGS])
)
[DECLARE: EVAL@COMPILE
(DATATYPE FDEV ((DEVICENAME POINTER)
(RESETABLE FLAG)
(RANDOMACCESSP FLAG)
(NODIRECTORIES FLAG)
(PAGEMAPPED FLAG) (* True if i/o handled by pmap routines)
(FDBINABLE FLAG) (* Copied as a microcode flag for INPUT streams formed
on this device)
(FDBOUTABLE FLAG)
(FDEXTENDABLE FLAG)
(BUFFERED FLAG) (* True implies that the device supports the BIN & BOUT
uCode conventions, and implements the GETNEXTBUFFER
method)
(* Device operations:)
(CLOSEFILE POINTER) (* (stream) => closes stream, returns it)
(DELETEFILE POINTER) (* (name) => deletes file so named, returning name, or
NIL on failure. RECOG=OLDEST)
(DIRECTORYNAMEP POINTER) (* (host/dir) => true if directory exists on host)
(EVENTFN POINTER) (* (device event), called before/after logout, sysout,
makesys)
(GENERATEFILES POINTER)
(* (device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is
arbitrary state. Generator fn returns next file, or NIL when finished)
(GETFILEINFO POINTER) (* (stream/name attribute device) => value of attribute
for open stream or name of closed file)
(GETFILENAME POINTER) (* (name recog device) => full file name)
(HOSTNAMEP POINTER)
(* (hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use
existing device)
(OPENFILE POINTER) (* (name access recog otherinfo device) => new stream
open on this device, or NIL if name not found)
(READPAGES POINTER)
(* (stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers
or a single buffer (the usual case))
(REOPENFILE POINTER)
(* (name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so
optionally uses info in old stream to keep this opening like the previous)
(SETFILEINFO POINTER) (* (stream/name attribute newvalue device) sets
attribute of open stream or closed file of given name)
(TRUNCATEFILE POINTER) (* (stream page offset) make stream's eof be at
page,offset, discarding anything after it)
(WRITEPAGES POINTER) (* (stream firstpage# buflist) writes from buflist to
stream starting at firstpage# of stream)
(BIN POINTER) (* (stream) => next byte of input)
(BOUT POINTER) (* (stream byte) output byte to stream)
(PEEKBIN POINTER) (* (stream) => next byte without advancing position in
stream)
(READP POINTER) (* (stream flag) => T if there is input available from
stream)
(BACKFILEPTR POINTER) (* (stream) backs up "fileptr" by one.
Stream is only required to be able to do this once,
i.e. one-character buffer suffices)
(DEVICEINFO POINTER) (* arbitrary device-specific info stored here)
(FORCEOUTPUT POINTER) (* (stream waitForFinish) flushes out to device
anything that is buffered awaiting transmission)
(LASTC POINTER) (* Should be possible only if RANDOMACCESSP)
(SETFILEPTR POINTER)
(GETFILEPTR POINTER)
(GETEOFPTR POINTER)
(EOFP POINTER)
(BLOCKIN POINTER) (* (stream buffer byteoffset nbytes))
(BLOCKOUT POINTER) (* (stream buffer byteoffset nbytes))
(RENAMEFILE POINTER) (* oldfile newfile device)
(RELEASEBUFFER POINTER) (* (stream) => Does whatever appropriate when CBUFPTR
is released)
(GETNEXTBUFFER POINTER)
(* (stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE.
Can cause EOF error unless noerrorflg)
(SETEOFPTR POINTER) (* (stream length) => truncates or lengthens stream to
indicated length)
(FREEPAGECOUNT POINTER) (* (host/dir dev) => # of free pages on host/dir)
(MAKEDIRECTORY POINTER) (* (host/dir dev))
(NIL POINTER) (* Spare)
)
(SYNONYM FORCEOUTPUT (FLUSHOUTPUT))
DIRECTORYNAMEP ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
READP ←(FUNCTION \GENERIC.READP)
SETFILEPTR ←(FUNCTION \IS.NOT.RANDACCESSP)
GETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
GETEOFPTR ←(FUNCTION \IS.NOT.RANDACCESSP)
EOFP ←(FUNCTION \ILLEGAL.DEVICEOP)
BLOCKIN ←(FUNCTION \GENERIC.BINS)
BLOCKOUT ←(FUNCTION \GENERIC.BOUTS)
RENAMEFILE ←(FUNCTION \GENERIC.RENAMEFILE)
FORCEOUTPUT ←(FUNCTION NILL))
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
]
(/DECLAREDATATYPE (QUOTE FDEV)
(QUOTE (POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(* END EXPORTED DEFINITIONS)
)
(/DECLAREDATATYPE (QUOTE FDEV)
(QUOTE (POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE FDEV ((DEVICENAME POINTER)
(RESETABLE FLAG)
(RANDOMACCESSP FLAG)
(NODIRECTORIES FLAG)
(PAGEMAPPED FLAG)
(FDBINABLE FLAG)
(FDBOUTABLE FLAG)
(FDEXTENDABLE FLAG)
(BUFFERED FLAG)
(CLOSEFILE POINTER)
(DELETEFILE POINTER)
(DIRECTORYNAMEP POINTER)
(EVENTFN POINTER)
(GENERATEFILES POINTER)
(GETFILEINFO POINTER)
(GETFILENAME POINTER)
(HOSTNAMEP POINTER)
(OPENFILE POINTER)
(READPAGES POINTER)
(REOPENFILE POINTER)
(SETFILEINFO POINTER)
(TRUNCATEFILE POINTER)
(WRITEPAGES POINTER)
(BIN POINTER)
(BOUT POINTER)
(PEEKBIN POINTER)
(READP POINTER)
(BACKFILEPTR POINTER)
(DEVICEINFO POINTER)
(FORCEOUTPUT POINTER)
(LASTC POINTER)
(SETFILEPTR POINTER)
(GETFILEPTR POINTER)
(GETEOFPTR POINTER)
(EOFP POINTER)
(BLOCKIN POINTER)
(BLOCKOUT POINTER)
(RENAMEFILE POINTER)
(RELEASEBUFFER POINTER)
(GETNEXTBUFFER POINTER)
(SETEOFPTR POINTER)
(FREEPAGECOUNT POINTER)
(MAKEDIRECTORY POINTER)
(NIL POINTER)))
]
(* Device operations)
(DEFINEQ
(\DEFINEDEVICE
[LAMBDA (NAME DEV) (* bvm: " 5-APR-83 15:33")
(* NIL DEV removes any device associated with NAME. NIL NAME simply adds the device without associating a name
with it. This is useful for getting its EVENTFN invoked. A litatom DEV makes NAME be a synonym for the device
currently named DEV -
\FILEDEVICES contains each device only once, \FILEDEVICENAMES contains each name device/host name only once
(for spelling correction), and \DEVICENAMETODEVICE maps a name into its device.)
(DECLARE (GLOBALVARS \FILEDEVICES \FILEDEVICENAMES \DEVICENAMETODEVICE))
(PROG (TEMP)
(SETQ NAME (U-CASE NAME)) (* Use upper-case canonical device names)
RETRY
(COND
[(NULL DEV)
(COND
((SETQ TEMP (FASSOC NAME \DEVICENAMETODEVICE))
(UNINTERRUPTABLY
(SETQ \DEVICENAMETODEVICE (DREMOVE TEMP \DEVICENAMETODEVICE))
(SETQ \FILEDEVICENAMES (DREMOVE NAME \FILEDEVICENAMES)))]
[(type? FDEV DEV)
(SETQ TEMP (FASSOC NAME \DEVICENAMETODEVICE))
(UNINTERRUPTABLY
(COND
((NOT (FMEMB DEV \FILEDEVICES))
[COND
(TEMP (SETQ \FILEDEVICES (DREMOVE (CDR TEMP)
\FILEDEVICES]
(* Devices are stored in inverse order of their
definition, for proper EVENTFN ordering.)
(push \FILEDEVICES DEV)))
(COND
(NAME (pushnew \FILEDEVICENAMES NAME)
(RPLACD [OR TEMP (CAR (push \DEVICENAMETODEVICE (CONS NAME]
DEV))))]
([AND (LITATOM DEV)
(SETQ TEMP (CDR (FASSOC (U-CASE DEV)
\DEVICENAMETODEVICE]
(SETQ DEV TEMP)
(GO RETRY))
(T (SETQ DEV (ERROR "INVALID FILE DEVICE" DEV))
(GO RETRY)))
(RETURN NAME])
(\GETDEVICEFROMNAME
[LAMBDA (NAME NOERROR DONTCREATE) (* bvm: "10-Jun-84 22:08")
(* Maps a host/device name into a device.
If the name begins with {, the substring enclosed in {}
is used.)
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \FILEDEVICES))
(PROG (HOSTNAME)
(RETURN (COND
[(AND (OR (LITATOM NAME)
(STRINGP NAME))
[SETQ HOSTNAME (COND
((EQ (CHCON1 NAME)
(CHARCODE {))
(SUBATOM NAME 2 (IDIFFERENCE (OR (STRPOS (QUOTE })
NAME NIL NIL NIL T)
2)
2)))
(T (SELECTQ (SYSTEMTYPE)
(VAX (QUOTE DSK))
NAME]
(OR (CDR (FASSOC HOSTNAME \DEVICENAMETODEVICE))
(CDR (FASSOC (SETQ HOSTNAME (U-CASE HOSTNAME))
\DEVICENAMETODEVICE))
(AND (NOT DONTCREATE)
(for D TEMP in \FILEDEVICES when (SETQ TEMP (FDEVOP (QUOTE
HOSTNAMEP)
D HOSTNAME D))
do
(* HOSTNAMEP is a pure predicate if the second arg is NIL. Here we give a device, which indicates that we are not
just a predicate, but in fact would like a new device back, possibly constructed from the old one.
A device value is installed with the new hostname; a T value means install with D.)
(COND
((type? FDEV TEMP)
(SETQ D TEMP)))
(\DEFINEDEVICE HOSTNAME D)
(RETURN D]
((NOT NOERROR)
(LISPERROR "FILE NOT FOUND" NAME])
(\REMOVEDEVICE
[LAMBDA (DEV) (* bvm: " 3-NOV-83 23:17")
(* Removes device DEV and also any association between
any of its name and DEV)
(DECLARE (GLOBALVARS \FILEDEVICES \FILEDEVICENAMES \DEVICENAMETODEVICE))
(PROG (TEMP)
(UNINTERRUPTABLY
(while (SETQ TEMP (find PAIR in \DEVICENAMETODEVICE suchthat (EQ (CDR PAIR)
DEV)))
do (SETQ \FILEDEVICENAMES (DREMOVE (CAR TEMP)
\FILEDEVICENAMES))
(SETQ \DEVICENAMETODEVICE (DREMOVE TEMP \DEVICENAMETODEVICE)))
(SETQ \FILEDEVICES (DREMOVE DEV \FILEDEVICES)))
(RETURN DEV])
(\REMOVEDEVICE.NAMES
[LAMBDA (DEV) (* bvm: "17-NOV-83 15:14")
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \FILEDEVICENAMES))
(* * removes any names associated with device DEV without actually removing the device itself)
(for TAIL on \DEVICENAMETODEVICE bind CHANGED when (EQ (CDAR TAIL)
DEV)
do (SETQ \FILEDEVICENAMES (DREMOVE (CAAR TAIL)
\FILEDEVICENAMES))
(RPLACA TAIL NIL)
(SETQ CHANGED T)
finally (COND
(CHANGED (SETQ \DEVICENAMETODEVICE (DREMOVE NIL \DEVICENAMETODEVICE])
)
(DEFINEQ
(\CLOSEFILE
[LAMBDA (STREAM) (* bvm: "10-Jul-84 13:48")
(* Close the file specified by the given open file
descriptor and return the file handle.)
(COND
((NOT (READONLY STREAM))
(IMAGEOP (QUOTE IMCLOSEFN)
STREAM STREAM) (* Do image-specific operations before physically
closing the stream)
))
(FDEVOP (QUOTE CLOSEFILE)
(fetch DEVICE of STREAM)
STREAM)
(replace ACCESS of STREAM with NIL) (* This marks the STREAM as closed)
STREAM])
(\DELETEFILE
[LAMBDA (FILENAME DEV) (* bvm: "26-DEC-81 21:35")
(SETQ FILENAME (\ADD.CONNECTED.DIR FILENAME))
(AND (OR DEV (SETQ DEV (\GETDEVICEFROMNAME FILENAME T)))
(FDEVOP (QUOTE DELETEFILE)
DEV FILENAME DEV])
(\DEVICEEVENT
[LAMBDA (EVENT) (* bvm: " 7-Jun-84 14:56")
(* Executes device-dependent event code so all devices can respond to various system transition events
(LOGOUT, MAKESYS, etc.) Before an event, n Before an event, devices are considered in the inverse order of their
definition, so that older devices get processed later. The order is reversed for after-events.)
(DECLARE (GLOBALVARS \FILEDEVICES))
(for D in (SELECTQ EVENT
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM)
(* Mark output files as needing revalidation if we write
to them again)
(for F in \OPENFILES when (AND (DIRTYABLE F)
(NOT (fetch NONDEFAULTDATEFLG of F)))
do (replace REVALIDATEFLG of F with T))
\FILEDEVICES)
(REVERSE \FILEDEVICES))
do (FDEVOP (QUOTE EVENTFN)
D D EVENT])
(\GENERATEFILES
[LAMBDA (PATTERN DESIREDPROPS OPTIONS) (* bvm: "27-Apr-84 23:21")
(* Returns a file-generator object that will generate all files whose names match PATTERN.
A gen-object consists of a device dependent NEXTFILEFN and GENFILESTATE -)
(SETQ PATTERN (\ADD.CONNECTED.DIR PATTERN))
(PROG ((FDEV (\GETDEVICEFROMNAME PATTERN)))
(RETURN (FDEVOP (QUOTE GENERATEFILES)
FDEV FDEV PATTERN DESIREDPROPS OPTIONS])
(\GENERATENEXTFILE
[LAMBDA (GENOBJ NAMEONLY SCRATCHLIST) (* bvm: " 3-May-84 12:25")
(* GENOBJ is a file-generator object as created by \GENERATEFILES. The NEXTFILEFN must return the list of
character codes of the next file generated by the generator, smashing them into SCRATCHLIST.
Returns NIL if no files left. It updates GENOBJ so that it will get the following satisfactory file on the next
call to this function. -
If NAMEONLY, then filenames returned need not contain host, directory or version)
(APPLY* (fetch NEXTFILEFN of GENOBJ)
(fetch GENFILESTATE of GENOBJ)
NAMEONLY SCRATCHLIST])
(\GENERATEFILEINFO
[LAMBDA (GENOBJ ATTRIBUTE) (* bvm: "26-Apr-84 15:40")
(* GENOBJ is a file-generator object as created by \GENERATEFILES. The FILEINFOFN performs a GETFILEINFO on the
file which is the currently enumerated file, i.e., the last thing that NEXTFILEFN returned)
(APPLY* (fetch FILEINFOFN of GENOBJ)
(fetch GENFILESTATE of GENOBJ)
ATTRIBUTE])
(\GETFILENAME
[LAMBDA (NAME RECOG FDEV) (* rmk: "25-OCT-83 18:38")
(* Expands NAME according to recog, returning either the
full NAME or NIL.)
(SETQ NAME (\ADD.CONNECTED.DIR NAME))
(PROG (STREAM)
(RETURN (COND
((SETQ STREAM (\SEARCHOPENFILES NAME))
(fetch FULLNAME of STREAM))
((OR FDEV (SETQ FDEV (\GETDEVICEFROMNAME NAME T)))
(FDEVOP (QUOTE GETFILENAME)
FDEV NAME RECOG FDEV])
(\GETFILENAME.OR.STREAM
[LAMBDA (NAME RECOG FDEV) (* bvm: "15-Aug-84 13:46")
(* If NAME is or names an open stream, returns the
stream, else returns full name according to RECOG)
(COND
((type? STREAM NAME)
(AND (fetch ACCESS of NAME)
NAME))
[(if (LITATOM NAME)
then (AND NAME (NEQ NAME T))
else (STRINGP NAME))
(SETQ NAME (\ADD.CONNECTED.DIR NAME))
(COND
((\SEARCHOPENFILES NAME))
((SETQ NAME (AND (OR FDEV (SETQ FDEV (\GETDEVICEFROMNAME NAME T)))
(FDEVOP (QUOTE GETFILENAME)
FDEV NAME RECOG FDEV)))
(OR (\SEARCHOPENFILES NAME)
NAME]
(T (\GETSTREAM NAME NIL T])
(\OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS) (* rmk: " 7-NOV-83 21:43")
(* Opens the file identified by NAME possibly expanded according to RECOG. Returns an open stream for the file.
ACCESS is assumed to be one of INPUT, OUTPUT, BOTH, or APPEND.)
(PROG (FDEV CDNAME STREAM)
RETRY
[COND
[(type? STREAM NAME)
(COND
((\IOMODEP NAME ACCESS T)
(\DO.PARAMS.AT.OPEN NAME ACCESS PARAMETERS)
(RETURN NAME))
(T (SETQ CDNAME NAME)
(SETQ FDEV (fetch DEVICE of NAME]
(T (SETQ CDNAME (\ADD.CONNECTED.DIR NAME))
(SETQ FDEV (\GETDEVICEFROMNAME CDNAME] (* Keep NAME for possible error)
(* The OPENFILE operation returns NIL if the file wasn't found, so the name is right for the not-found error.
That error must not be generated from inside the device, or spellfile would be too constrained.
The won't-open error may happen inside the device, if the device itself does some interlocking
(e.g. a file-server). The generic code in OPENFILE may also generate that error, to enforce interlocks among files
already opened in this Lisp.)
(COND
((SETQ STREAM (FDEVOP (QUOTE OPENFILE)
FDEV CDNAME ACCESS RECOG PARAMETERS FDEV))
(replace ACCESS of STREAM with ACCESS)
(replace CPAGE of STREAM with (COND
((EQ ACCESS (QUOTE APPEND))
(fetch EPAGE of STREAM))
(T 0)))
(replace COFFSET of STREAM with (COND
((EQ ACCESS (QUOTE APPEND))
(fetch EOFFSET of STREAM))
(T 0)))
(\DO.PARAMS.AT.OPEN STREAM ACCESS PARAMETERS)
(RETURN STREAM))
(T (SETQ NAME (LISPERROR "FILE NOT FOUND" NAME))
(GO RETRY])
(\DO.PARAMS.AT.OPEN
[LAMBDA (STREAM ACCESS PARAMETERS) (* bvm: "17-NOV-83 15:10")
(* Does generic parameters when a file/stream is open.
Called by \OPENFILE and OPENSTREAM)
(for X ATTR VAL TYPE in PARAMETERS
do (COND
[(LISTP X)
(SETQ ATTR (CAR X))
(SETQ VAL (CAR (LISTP (CDR X]
(T (SETQ ATTR X)
(SETQ VAL T)))
(SELECTQ ATTR
(BUFFERS (SETFILEINFO STREAM (QUOTE BUFFERS)
VAL))
(ENDOFSTREAMOP (SETFILEINFO STREAM (QUOTE ENDOFSTREAMOP)
VAL))
NIL])
(\RENAMEFILE
[LAMBDA (OLDFILE NEWFILE) (* bvm: " 4-JUN-83 22:28")
(SETQ OLDFILE (\ADD.CONNECTED.DIR OLDFILE))
(SETQ NEWFILE (\ADD.CONNECTED.DIR NEWFILE))
(PROG ((DEV (\GETDEVICEFROMNAME OLDFILE T)))
(RETURN (AND DEV (COND
((EQ (\GETDEVICEFROMNAME NEWFILE T)
DEV)
(FDEVOP (QUOTE RENAMEFILE)
DEV OLDFILE NEWFILE DEV))
(T (\GENERIC.RENAMEFILE OLDFILE NEWFILE])
(\REVALIDATEFILE
[LAMBDA (STREAM) (* bvm: "30-DEC-81 17:45")
(* Check the file to determine if it corresponds to the status information for it found in the STREAM and file
handle. Return DELETED if the file no longer exists, CHANGED if the file does not correspond to the status
information, or NIL if everything is OK.)
(PROG ((NEWSTREAM (FDEVOP (QUOTE REOPENFILE)
(fetch DEVICE of STREAM)
(fetch FULLFILENAME of STREAM)
(fetch ACCESS of STREAM)
(QUOTE OLD)
NIL
(fetch DEVICE of STREAM)
STREAM)))
(RETURN (COND
((NOT NEWSTREAM)
(QUOTE DELETED))
((EQ NEWSTREAM STREAM) (* Nothing changed)
NIL)
(T (replace F1 of STREAM with (fetch F1 of NEWSTREAM))
(* Copy "device" information from the new opening to the
old)
(replace F2 of STREAM with (fetch F2 of NEWSTREAM))
(replace F3 of STREAM with (fetch F3 of NEWSTREAM))
(replace F4 of STREAM with (fetch F4 of NEWSTREAM))
(replace F5 of STREAM with (fetch F5 of NEWSTREAM))
(replace FW6 of STREAM with (fetch FW6 of NEWSTREAM))
(replace FW7 of STREAM with (fetch FW7 of NEWSTREAM))
(COND
((EQUAL (fetch VALIDATION of NEWSTREAM)
(fetch VALIDATION of STREAM))
NIL)
(T (replace VALIDATION of STREAM with (fetch VALIDATION of NEWSTREAM))
(replace EPAGE of STREAM with (fetch EPAGE of NEWSTREAM))
(replace EOFFSET of STREAM with (fetch EOFFSET of NEWSTREAM))
(QUOTE CHANGED])
(\TRUNCATEFILE
[LAMBDA (STREAM LASTPAGE LASTOFFSET) (* bvm: " 8-MAY-82 16:11")
(* Shorten an open file to have the given last page and offset. Last page = NIL means to truncate to the current
length, which some devices may interpret as a noop)
(FDEVOP (QUOTE TRUNCATEFILE)
(fetch DEVICE of STREAM)
STREAM LASTPAGE LASTOFFSET])
)
(* Generic enumerator)
(DEFINEQ
(\GENERATENOFILES
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* bvm: " 5-Jun-84 16:31")
(* A dummy function to be used by devices that don't
support directory generation.
This produces a generate that generates no files.)
(PROG ((STAR (STRPOS (QUOTE *)
PATTERN))
(ESC (STRPOS [QUOTE (CONSTANT (CHARACTER (CHARCODE ESC]
PATTERN)))
(RETURN (COND
([AND [OR (NULL STAR)
(AND (EQ (NTHCHARCODE PATTERN (SUB1 STAR))
(CHARCODE ;))
(NULL (STRPOS (QUOTE *)
PATTERN
(ADD1 STAR]
(OR (NULL ESC)
(AND (EQ (NTHCHARCODE PATTERN (SUB1 ESC))
(CHARCODE ;))
(NULL (STRPOS (CONSTANT (CHARACTER (CHARCODE ESC)))
PATTERN
(ADD1 ESC]
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \NOFILESNEXTFILEFN)
FILEINFOFN ←(FUNCTION \NOFILESINFOFN)
GENFILESTATE ←(create NOFILEGENSTATE
NOFILETYPE ←(COND
((AND (NULL STAR)
(NULL ESC))
(QUOTE NOSTAR))
(T (SETQ PATTERN (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
PATTERN))
(QUOTE STAR)))
NOFILEPATTERN ← PATTERN)))
(T (\NULLFILEGENERATOR])
(\NULLFILEGENERATOR
[LAMBDA NIL (* bvm: " 5-Jun-84 15:46")
(* A file generator that generates no files)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION NILL])
(\NOFILESNEXTFILEFN
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* bvm: " 3-May-84 12:32")
(PROG (FILE TYPE)
[SELECTQ (SETQ TYPE (fetch NOFILETYPE of GENFILESTATE))
[NOSTAR (replace NOFILETYPE of GENFILESTATE with (QUOTE DONE))
(SETQ FILE (INFILEP (fetch NOFILEPATTERN of GENFILESTATE]
(DONE (RETURN NIL))
[STAR
(* Star in version field. Start out by producing the oldest file, and note its version and the version of the
newest file for subsequent enumeration)
(SETQ FILE (FULLNAME (fetch NOFILEPATTERN of GENFILESTATE)
(QUOTE OLDEST)))
(replace NOFILETYPE of GENFILESTATE
with (CONS (FILENAMEFIELD FILE (QUOTE VERSION))
(FILENAMEFIELD (INFILEP (fetch NOFILEPATTERN of GENFILESTATE))
(QUOTE VERSION]
(PROG [(VER (ADD1 (CAR TYPE] (* TYPE is a dotted pair of versions
(old . newest) -- test INFILEP for each version number
after old until we get to newest)
LP (COND
((IGREATERP VER (CDR TYPE))
(RETURN NIL))
[[SETQ FILE (INFILEP (PACKFILENAME (QUOTE VERSION)
VER
(QUOTE BODY)
(fetch NOFILEPATTERN of GENFILESTATE]
(RPLACA TYPE (FILENAMEFIELD FILE (QUOTE VERSION]
(T (add VER 1)
(GO LP]
(RETURN (COND
(FILE (replace NOFILENAME of GENFILESTATE with FILE)
(DCHCON (COND
(NAMEONLY (NAMEFIELD FILE T))
(T FILE))
SCRATCHLIST])
(\NOFILESINFOFN
[LAMBDA (GENSTATE ATTRIBUTE) (* bvm: "27-Apr-84 22:17")
(* * Fileinfo fn for getting attributes of the file currently enumerated -- go thru the generic GETFILEINFO)
(GETFILEINFO (fetch NOFILENAME of GENSTATE)
ATTRIBUTE])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD NOFILEGENSTATE (NOFILETYPE NOFILEPATTERN . NOFILENAME))
]
)
(DEFINEQ
(\FILE.NOT.OPEN
[LAMBDA (X NOERROR) (* rmk: "21-OCT-83 11:12")
(* Returns NIL of NOERROR, otherwise causes the FILE NOT
OPEN error. Used by \GETSTREAM.
\STREAM.NOT.OPEN doesn't take NOERROR arg.)
(AND (NULL NOERROR)
(LISPERROR "FILE NOT OPEN" (COND
((type? STREAM X)
(fetch FULLNAME of X))
(T X])
(\FILE.WONT.OPEN
[LAMBDA (X) (* rmk: "21-OCT-83 12:58")
(LISPERROR "FILE WON'T OPEN" (COND
((type? STREAM X)
(fetch FULLNAME of X))
(T X])
(\ILLEGAL.DEVICEOP
[LAMBDA N (* bvm: "28-DEC-81 15:44")
(ERROR "Attempt to use undefined device operation" (for I from 1 to N collect (ARG N I])
(\IS.NOT.RANDACCESSP
[LAMBDA N (* bvm: "15-SEP-83 17:00")
(PROG ((THING (ARG N 1)))
(RETURN (ERROR "File is not RANDACCESSP" (COND
((type? STREAM THING)
(fetch FULLNAME of THING))
(T THING])
(\STREAM.NOT.OPEN
[LAMBDA (STREAM) (* rmk: "21-OCT-83 11:11")
(* Can be used as BIN/BOUT function.
\FILE.NOT.OPEN accepts more than just a stream, and also
has NOERROR control)
(LISPERROR "FILE NOT OPEN" (fetch FULLNAME of STREAM])
)
(ADDTOVAR \FILEDEVICES )
(ADDTOVAR \FILEDEVICENAMES )
(ADDTOVAR \DEVICENAMETODEVICE )
(* Device instances)
(DEFINEQ
(\FDEVINSTANCE
[LAMBDA (FDEV) (* bvm: "12-NOV-83 17:53")
(* Creates an "instance" of FDEV, a distinct device that executes all the operations of FDEV, but which can be
smashed to change those operations in order to specialize streams. -
\INHERITFDEVOP.S and .D are macros that expect the device to be found from a STREAM or FDEV argument,
respectively. Only operations that relate to streams are included, since non-stream device operations will be
obtained from the original device, whose name is registered.)
(create FDEV using FDEV DEVICEINFO ← FDEV CLOSEFILE ←(\INHERITFDEVOP.S CLOSEFILE STREAM)
GETFILEINFO ←(\INHERITFDEVOP.D GETFILEINFO STREAM ATTRIB FDEV)
OPENFILE ←(\INHERITFDEVOP.D OPENFILE CDNAME ACCESS RECOG OTHERINFO FDEV)
READPAGES ←(\INHERITFDEVOP.S READPAGES STREAM FIRSTPAGE BUFFERLIST)
SETFILEINFO ←(\INHERITFDEVOP.D SETFILEINFO STREAM ATTRIBUTE VALUE FDEV)
TRUNCATEFILE ←(\INHERITFDEVOP.S TRUNCATEFILE STREAM LASTPAGE LASTOFFSET)
WRITEPAGES ←(\INHERITFDEVOP.S WRITEPAGES STREAM FIRSTPAGE BUFFERLIST)
REOPENFILE ←(\INHERITFDEVOP.D REOPENFILE NAME ACCESS RECOG OTHERINFO FDEV
OLDSTREAM)
BIN ←(\INHERITFDEVOP.S BIN STREAM)
BOUT ←(\INHERITFDEVOP.S BOUT STREAM BYTE)
PEEKBIN ←(\INHERITFDEVOP.S PEEKBIN STREAM NOERRORFLG)
BACKFILEPTR ←(\INHERITFDEVOP.S BACKFILEPTR STREAM)
SETFILEPTR ←(\INHERITFDEVOP.S SETFILEPTR STREAM INDX)
GETFILEPTR ←(\INHERITFDEVOP.S GETFILEPTR STREAM)
GETEOFPTR ←(\INHERITFDEVOP.S GETEOFPTR STREAM)
EOFP ←(\INHERITFDEVOP.S EOFP STREAM)
BLOCKIN ←(\INHERITFDEVOP.S BLOCKIN STREAM BASE OFFSET NBYTES)
BLOCKOUT ←(\INHERITFDEVOP.S BLOCKOUT STREAM BASE OFFSET NBYTES)
FLUSHOUTPUT ←(\INHERITFDEVOP.S FLUSHOUTPUT STREAM])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \INHERITFDEVOP.D MACRO [X (SUBPAIR (QUOTE (NEWARGS OPNAME . ARGS))
(CONS (SUBST (QUOTE (fetch DEVICEINFO of FDEV))
(QUOTE FDEV)
(CDR X))
X)
(QUOTE (FUNCTION (LAMBDA ARGS
(FDEVOP (QUOTE OPNAME)
(fetch DEVICEINFO
of FDEV) . NEWARGS])
(PUTPROPS \INHERITFDEVOP.S MACRO [(OPNAME . ARGS)
(FUNCTION (LAMBDA ARGS
(FDEVOP (QUOTE OPNAME)
(fetch DEVICEINFO of (fetch DEVICE of STREAM)) . ARGS])
)
(RPAQ? LOGINHOST/DIR (QUOTE {DSK}))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LOGINHOST/DIR \FILEDEVICES \FILEDEVICENAMES \DEVICENAMETODEVICE)
)
(* Directory defaulting)
(DEFINEQ
(CNDIR
[LAMBDA (HOST/DIR) (* lmm " 7-Sep-84 13:49")
(* Connects to HOST/DIR, verifying that HOST/DIR
exists.)
(DECLARE (GLOBALVARS \CONNECTED.HOST \CONNECTED.DIR LOGINHOST/DIR DWIMWAIT USERNAME
\FILEDEVICENAMES))
(if (SETQ \CONNECTED.DIR (DIRECTORYNAME HOST/DIR T))
then [PROG1 \CONNECTED.DIR (SETQ \CONNECTED.HOST (FILENAMEFIELD \CONNECTED.DIR (QUOTE HOST)))
(COND
((AND (SETQ \CONNECTED.DIR (FILENAMEFIELD \CONNECTED.DIR (QUOTE DIRECTORY)))
(GREATERP (NCHARS \CONNECTED.DIR)
0))
(SETQ \CONNECTED.DIR (CONCAT "<" \CONNECTED.DIR ">")))
(T (SETQ \CONNECTED.DIR ""]
else (* I honestly don't know what all of this is)
(OR (LITATOM HOST/DIR)
(STRINGP HOST/DIR)
(LISPERROR "ILLEGAL ARG" HOST/DIR))
(PROG ((REST HOST/DIR)
(NEWHOST \CONNECTED.HOST)
NEWDIR NEWHOST/DIR FDEV TEMP)
[COND
((EQ (NTHCHARCODE HOST/DIR 1)
(CHARCODE {)) (* Host specified)
[SETQ NEWHOST (SUBATOM HOST/DIR 2 (SUB1 (SETQ TEMP (OR (STRPOS (QUOTE })
HOST/DIR 2)
(LISPERROR "ILLEGAL ARG"
HOST/DIR]
(SETQ REST (SUBATOM HOST/DIR (ADD1 TEMP]
(COND
((SETQ FDEV (\GETDEVICEFROMNAME NEWHOST T)))
((AND (SETQ TEMP (FIXSPELL NEWHOST NIL \FILEDEVICENAMES T))
(SETQ FDEV (\GETDEVICEFROMNAME TEMP T)))
(SETQ NEWHOST TEMP)
(SETQ HOST/DIR (PACK* (QUOTE {)
NEWHOST
(QUOTE })
REST)))
(T (ERROR "Unrecognized host" HOST/DIR)))
[SETQ NEWHOST/DIR (PACK* (QUOTE {)
NEWHOST
(QUOTE })
(COND
[(NULL REST)
(COND
((fetch NODIRECTORIES of FDEV)
(* Device does not support directories--e.g.
DSK)
"")
(T (CONCAT (QUOTE <)
USERNAME
(QUOTE >]
[(STRPOS "<" REST)
(* brackets supplied, leave them)
(COND
((EQ 1 (NCHARS REST))
(* An emptry directory specification;
enables the user to not default to any directory even
though the device normally expects a dir.)
"")
((EQ (NTHCHARCODE REST -1)
(CHARCODE >))
(COND
((EQ 2 (NCHARS REST))
(* Also empty)
"")
(T REST)))
(T (* Supply closing >)
(CONCAT REST (QUOTE >]
((EQ (NTHCHARCODE REST -1)
(CHARCODE >))
(CONCAT (QUOTE <)
REST))
(T (CONCAT (QUOTE <)
REST
(QUOTE >]
(COND
((SETQ TEMP (FDEVOP (QUOTE DIRECTORYNAMEP)
FDEV NEWHOST/DIR FDEV))
(COND
((NEQ TEMP T)
(SETQ NEWHOST/DIR TEMP)))
(SETQ TEMP (STRPOS "}" NEWHOST/DIR))
(SETQ NEWHOST (SUBATOM NEWHOST/DIR 2 (SUB1 TEMP)))
(SETQ NEWDIR (OR (SUBSTRING NEWHOST/DIR (ADD1 TEMP))
""))
(UNINTERRUPTABLY
(SETQ \CONNECTED.HOST NEWHOST) (* Don't smash globals until new setting has been
verified.)
(SETQ \CONNECTED.DIR NEWDIR))
(RETURN NEWHOST/DIR))
(T (* To reduce confusion, include host name in error
message, in case it was defaulted)
(ERROR "Non-existent directory" NEWHOST/DIR])
(DIRECTORYNAME
[LAMBDA (DIRNAME STRPTR CREATE?) (* lmm " 7-Sep-84 14:31")
(* Returns connected directory name)
(SELECTQ (SYSTEMTYPE)
(VAX (GETDIRNAME))
[D (DECLARE (GLOBALVARS \CONNECTED.DIR \CONNECTED.HOST LOGINHOST/DIR))
(PROG (DN FDEV)
[SELECTQ DIRNAME
(T (* Connected host/dir)
(SETQ DN (CONCAT (QUOTE {)
\CONNECTED.HOST
(QUOTE })
\CONNECTED.DIR)))
[NIL (SETQ DN (OR LOGINHOST/DIR (QUOTE {DSK}]
(COND
[(AND (SETQ FDEV (\GETDEVICEFROMNAME (SELCHARQ (CHCON1 DIRNAME)
(({ %[ %()
DIRNAME)
(SETQ DIRNAME
(CONCAT "{"
\CONNECTED.HOST "}"
DIRNAME)))
T))
(SETQ DN (FDEVOP (QUOTE DIRECTORYNAMEP)
FDEV DIRNAME FDEV CREATE?)))
(COND
((EQ DN T)
(SETQ DN (PACKFILENAME.STRING (QUOTE HOST)
(fetch DEVICENAME of FDEV)
(QUOTE DIRECTORY)
DIRNAME]
(T (RETURN]
(RETURN (if (NOT STRPTR)
then (MKSTRING DN)
elseif (EQ STRPTR T)
then (MKATOM DN)
else (MKSTRING DN]
(HELP])
(DIRECTORYNAMEP
[LAMBDA (DIRNAME HOSTNAME) (* lmm " 7-Sep-84 13:08")
(* T if DIRNAME is recognized as a currently existing directory, on HOSTNAME, or if not included, on the hostname
in DIRNAME, or the connected host.)
(PROG [FDEV (DN (COND
(HOSTNAME (PACKFILENAME (QUOTE HOST)
HOSTNAME
(QUOTE BODY)
DIRNAME))
(T (\ADD.CONNECTED.DIR DIRNAME]
(RETURN (AND (SETQ FDEV (\GETDEVICEFROMNAME DN T))
(FDEVOP (QUOTE DIRECTORYNAMEP)
FDEV DN FDEV)
T])
(HOSTNAMEP
[LAMBDA (NAME) (* rmk: "11-NOV-81 14:33")
(* T if NAME is the name of a recognizable host)
(DECLARE (GLOBALVARS \FILEDEVICENAMES \FILEDEVICES))
(PROG (N)
(COND
((LITATOM NAME)
(SETQ N (U-CASE NAME)))
[(STRINGP NAME)
(SETQ N (MKATOM (U-CASE NAME]
(T (RETURN NIL)))
[COND
((EQ (CHCON1 N)
(CHARCODE {))
(SETQ N (SUBATOM N 2 (SUB1 (OR (STRPOS (QUOTE })
N 2)
(RETURN NIL]
(RETURN (AND (OR (MEMB N \FILEDEVICENAMES)
(find D in \FILEDEVICES suchthat (FDEVOP (QUOTE HOSTNAMEP)
D N)))
T])
(\ADD.CONNECTED.DIR
[LAMBDA (FILENAME) (* dav: "13-JAN-83 12:59")
(* * Modifies the filename to include connected host and/or dir)
(SELECTQ (SYSTEMTYPE)
(VAX FILENAME)
(SELCHARQ (NTHCHARCODE FILENAME 1)
({ (* A host is supplied, so leave name alone)
FILENAME)
[< (* a dir is supplied, so give only host)
(PACK* (QUOTE {)
\CONNECTED.HOST
(QUOTE })
(COND
((EQ (NTHCHARCODE FILENAME 2)
(CHARCODE >))
(* An empty dir overrides the default but leaves a null directory.)
(OR (SUBATOM FILENAME 3 -1)
""))
(T FILENAME]
(PACK* (QUOTE {)
\CONNECTED.HOST
(QUOTE })
\CONNECTED.DIR FILENAME])
)
(* Binary I/O - Public functions)
(DEFINEQ
(\BACKFILEPTR
[LAMBDA (STREAM) (* bvm: "30-JAN-82 16:59")
(FDEVOP (QUOTE BACKFILEPTR)
(fetch DEVICE of STREAM)
STREAM])
(\BACKPEEKBIN
[LAMBDA (STREAM) (* bvm: " 7-Jun-84 16:45")
(* Returns previous byte on file without changing
fileptr. Returns NIL if we are positioned at the
beginning of the file. Called by LASTC)
(UNINTERRUPTABLY
(AND (\BACKFILEPTR STREAM)
(\BIN STREAM)))])
(\BACKBIN
[LAMBDA (STREAM) (* bvm: " 7-Jun-84 16:46")
(* Returns previous character on file and backs up fileptr so that next \BIN will also return it.
Returns NIL if we are positioned at the beginning of the file.)
(AND (\BACKFILEPTR STREAM)
(\PEEKBIN STREAM])
(BIN
[LAMBDA (STREAM) (* lmm "20-APR-82 22:00")
(* MERELY EXECUTE OPCODE)
(\BIN STREAM])
(\BIN
[LAMBDA (STREAM) (* rmk: " 2-NOV-83 14:32")
(* UFN FOR BIN OPCODE)
(STREAMOP (QUOTE STRMBINFN)
(SETQ STREAM (\DTEST STREAM (QUOTE STREAM)))
STREAM])
(\BINS
[LAMBDA (STREAM BASE OFF NBYTES) (* bvm: "25-MAY-83 12:48")
(* BINs NBYTES bytes from STREAM into BASE+OFF)
(FDEVOP (QUOTE BLOCKIN)
[ffetch DEVICE of (SETQ STREAM (\DTEST STREAM (QUOTE STREAM]
STREAM BASE OFF NBYTES])
(BOUT
[LAMBDA (STREAM BYTE) (* rmk: "21-OCT-83 14:40")
(* MERELY EXECUTE OPCODE)
(\BOUT STREAM BYTE])
(\BOUT
[LAMBDA (STREAM BYTE) (* rmk: " 2-NOV-83 14:32")
(STREAMOP (QUOTE STRMBOUTFN)
(SETQ STREAM (\DTEST STREAM (QUOTE STREAM)))
STREAM BYTE])
(\BOUTS
[LAMBDA (STREAM BASE OFF NBYTES) (* bvm: "25-MAY-83 12:47")
(* BOUTs NBYTES bytes from BASE+OFF into OFD.
Follows logic of BINS.)
(FDEVOP (QUOTE BLOCKOUT)
[ffetch DEVICE of (SETQ STREAM (\DTEST STREAM (QUOTE STREAM]
STREAM BASE OFF NBYTES])
(COPYBYTES
[LAMBDA (SRCFIL DSTFIL START END) (* bvm: "10-Jul-84 22:28")
(* Copies bytes from START up to but not including END
from SRCFIL into DSTFIL.)
(PROG ((SRC (\GETSTREAM SRCFIL (QUOTE INPUT)))
(DST (\GETSTREAM DSTFIL (QUOTE OUTPUT)))
NBYTES)
(SETQ NBYTES (COND
(END (* Specified a start and ending)
(\SETFILEPTR SRC (OR (FIXP START)
(\ILLEGAL.ARG START)))
(IDIFFERENCE (COND
((EQ END -1)
(\GETEOFPTR SRC))
(T END))
START))
(T START))) (* How much to copy, or NIL if to EOF)
(COND
((AND NBYTES (ILESSP NBYTES 0))
(ERROR "Negative number of bytes to copy" NBYTES)))
[COND
((fetch BUFFERED of (fetch DEVICE of SRC)) (* Can copy by the bufferfull)
(\BUFFERED.COPYBYTES SRC DST NBYTES))
[[OR NBYTES (SETQ NBYTES (AND (fetch RANDOMACCESSP of (fetch DEVICE of SRC))
(IDIFFERENCE (\GETEOFPTR SRC)
(\GETFILEPTR SRC]
(* Know how many bytes to copy)
(FRPTQ NBYTES (\BOUT DST (\BIN SRC]
(T (* Copying to EOF but can't tell when that will happen)
(until (\EOFP SRC) do (\BOUT DST (\BIN SRC]
(RETURN T) (* As specified in VM)
])
(COPYCHARS
[LAMBDA (SRCFIL DSTFIL START END) (* rmk: "27-Sep-84 09:33")
(* This is similar to COPYBYTES except that conversion is done between the EOL convention of the input and the EOL
convention of the output)
(PROG ((SRCSTRM (\GETSTREAM SRCFIL))
(DSTSTRM (\GETSTREAM DSTFIL))
(ACTUALSTART 0)
RAP ACTUALEND EOF SRCEOLC DSTEOLC CH)
[COND
((EQ (SETQ SRCEOLC (fetch EOLCONVENTION of SRCSTRM))
(SETQ DSTEOLC (fetch EOLCONVENTION of DSTSTRM)))
(RETURN (COPYBYTES SRCSTRM DSTSTRM START END]
[COND
((SETQ RAP (fetch RANDOMACCESSP of (fetch DEVICE of SRCSTRM)))
(SETQ EOF (\GETEOFPTR SRCSTRM]
(COND
[END (OR RAP (ERROR "COPYCHARS: Source file is not random access" (fetch FULLFILENAME
of SRCSTRM)))
(OR (type? BYTEPTR (SETQ ACTUALSTART (FIX START)))
(LISPERROR "ILLEGAL ARG" START))
(\SETFILEPTR SRCSTRM ACTUALSTART)
(SETQ ACTUALEND (COND
((EQ END -1)
EOF)
(T (IMIN END EOF]
[START (SETQ ACTUALEND (COND
(RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM))
(IMIN EOF (IPLUS START ACTUALSTART)))
(T START]
(RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM))
(SETQ ACTUALEND EOF))
(T (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCHAR SRCSTRM)))
(* Not RAP and START and END are both NIL.
Slow copy to the end of the file.)
(RETURN)))
(OR (IGEQ ACTUALEND ACTUALSTART)
(ERROR "Negative number of bytes to copy" (IDIFFERENCE ACTUALEND ACTUALSTART)))
(* We only have to worry about mismatched EOLCs)
(SELECTC SRCEOLC
[CR.EOLC (* DST is either CRLF or LF)
(FRPTQ (IDIFFERENCE ACTUALEND ACTUALSTART)
(SELCHARQ (SETQ CH (\BIN SRCSTRM))
(CR (AND (EQ DSTEOLC CRLF.EOLC)
(\BOUT DSTSTRM (CHARCODE CR)))
(\BOUT DSTSTRM (CHARCODE LF)))
(\BOUT DSTSTRM CH]
[LF.EOLC (* DST is either CRLF or CR)
(FRPTQ (IDIFFERENCE ACTUALEND ACTUALSTART)
(SELCHARQ (SETQ CH (\BIN SRCSTRM))
[LF (\BOUT DSTSTRM (CHARCODE CR))
(AND (EQ DSTEOLC CRLF.EOLC)
(\BOUT DSTSTRM (CHARCODE LF]
(\BOUT DSTSTRM CH]
[CRLF.EOLC (* DST is either CR or LF)
(for I from (IDIFFERENCE ACTUALEND ACTUALSTART) to 1 by -1
do (\BOUT DSTSTRM (COND
((OR (NEQ (SETQ CH (\BIN SRCSTRM))
(CHARCODE CR))
(EQ I 1))
CH)
[(PROGN (add I -1)
(* Adjust for second character)
(EQ (SETQ CH (\BIN SRCSTRM))
(CHARCODE LF)))
(COND
((EQ DSTEOLC CR.EOLC)
(CHARCODE CR))
(T (CHARCODE LF]
(T (\BOUT DSTSTRM (CHARCODE CR))
CH]
(SHOULDNT)))
T])
(COPYFILE
[LAMBDA (FROMFILE TOFILE) (* bvm: "11-Jul-84 15:24")
(RESETLST [RESETSAVE [SETQ FROMFILE (OPENSTREAM FROMFILE (QUOTE INPUT)
NIL NIL (QUOTE ((SEQUENTIAL T]
(QUOTE (PROGN (CLOSEF OLDVALUE]
(\COPYOPENFILE FROMFILE TOFILE])
(\COPYOPENFILE
[LAMBDA (INSTREAM NEWNAME) (* bvm: "28-May-84 17:07")
(PROG (X TYPE PROPS OUTSTREAM)
[COND
((SETQ X (GETFILEINFO INSTREAM (QUOTE CREATIONDATE)))
(push PROPS (LIST (QUOTE CREATIONDATE)
X]
[COND
((SETQ X (GETFILEINFO INSTREAM (QUOTE LENGTH)))
(push PROPS (LIST (QUOTE LENGTH)
X]
[COND
((OR (AND (SETQ TYPE (GETFILEINFO INSTREAM (QUOTE TYPE)))
(NEQ TYPE (QUOTE ?)))
(SETQ TYPE (\INFER.FILE.TYPE INSTREAM)))
(push PROPS (LIST (QUOTE TYPE)
TYPE))
(COND
([AND (EQ TYPE (QUOTE TEXT))
(SETQ X (GETFILEINFO INSTREAM (QUOTE EOL]
(push PROPS (LIST (QUOTE EOL)
X]
[RESETSAVE (SETQ OUTSTREAM (OPENSTREAM NEWNAME (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(CONS (QUOTE SEQUENTIAL)
PROPS)))
(QUOTE (AND RESETSTATE (DELFILE (CLOSEF OLDVALUE]
(OR (EQ (\GETFILEPTR INSTREAM)
0)
(SETFILEPTR INSTREAM 0)) (* In case it was open by someone else! Really need
multiple streams, but until then at least don't lose big
this way)
(COND
[(AND (EQ TYPE (QUOTE TEXT))
(NEQ (GETFILEINFO OUTSTREAM (QUOTE EOL))
X)) (* Incompatible EOL conventions, do slow way)
(replace ENDOFSTREAMOP of INSTREAM with (FUNCTION NILL))
(bind CH (SRCEOL ←(fetch EOLCONVENTION of INSTREAM)) until (NULL (SETQ CH (\BIN
INSTREAM)))
do (\OUTCHAR OUTSTREAM (\CHECKEOLC CH SRCEOL INSTREAM]
(T (COPYBYTES INSTREAM OUTSTREAM)))
(RETURN (CLOSEF OUTSTREAM])
(\INFER.FILE.TYPE
[LAMBDA (STREAM) (* bvm: " 8-Jun-84 11:48")
(* STREAM is open on a file whose TYPE is unknown.
If we can, decide between TEXT and BINARY by examining
bytes)
(COND
((RANDACCESSP STREAM)
(SETFILEPTR STREAM 0)
(PROG ((OLDEOF (fetch ENDOFSTREAMOP of STREAM))
TYPE)
(replace ENDOFSTREAMOP of STREAM with (FUNCTION NILL))
[SETQ TYPE (do (COND
((IGREATERP (OR (\BIN STREAM)
(RETURN (QUOTE TEXT)))
127)
(RETURN (QUOTE BINARY]
(replace ENDOFSTREAMOP of STREAM with OLDEOF)
(SETFILEPTR STREAM 0) (* Put file ptr back)
(RETURN TYPE])
(EOFP
[LAMBDA (FILE) (* bvm: "10-Jun-84 22:46")
(* User entry. T if FILE is at EOF.
I-10 only considers input files, we merely give priority
to them)
(\EOFP (OR (\GETSTREAM FILE (QUOTE INPUT)
T)
(\GETSTREAM FILE])
(FORCEOUTPUT
[LAMBDA (STREAM WAITFORFINISH) (* bvm: "27-Apr-84 22:45")
(SETQ STREAM (\GETSTREAM STREAM (QUOTE OUTPUT)))
(FDEVOP (QUOTE FORCEOUTPUT)
(fetch DEVICE of STREAM)
STREAM WAITFORFINISH])
(\FLUSH.OPEN.STREAMS
[LAMBDA (FDEV) (* bvm: "12-NOV-83 22:08")
(for STREAM in \OPENFILES when (AND (EQ (fetch DEVICE of STREAM)
FDEV)
(DIRTYABLE STREAM))
do (FDEVOP (QUOTE FLUSHOUTPUT)
(fetch DEVICE of STREAM)
STREAM])
(GETEOFPTR
[LAMBDA (FILE) (* rmk: "21-OCT-83 11:19")
(PROG ((STREAM (\GETSTREAM FILE)))
(RETURN (FDEVOP (QUOTE GETEOFPTR)
(fetch DEVICE of STREAM)
STREAM])
(GETFILEINFO
[LAMBDA (FILE ATTRIB) (* rmk: "23-Aug-84 22:36")
(PROG ((STREAM (\GETFILENAME.OR.STREAM FILE (QUOTE OLD)))
DEV VAL)
(RETURN (COND
[(type? STREAM STREAM) (* FILE is open. Ask device for info;
if it can't handle it, at least handle some generic
cases)
(COND
((EQ ATTRIB (QUOTE ACCESS))
(fetch ACCESS of STREAM))
((FDEVOP (QUOTE GETFILEINFO)
(SETQ DEV (fetch DEVICE of STREAM))
STREAM ATTRIB DEV))
(T (SELECTQ ATTRIB
((BYTESIZE OPENBYTESIZE)
(fetch BYTESIZE of STREAM))
(EOL (SELECTC (fetch EOLCONVENTION of STREAM)
(CR.EOLC (QUOTE CR))
(LF.EOLC (QUOTE LF))
(CRLF.EOLC (QUOTE CRLF))
(SHOULDNT)))
(BUFFERS (fetch MAXBUFFERS of STREAM))
(ENDOFSTREAMOP (fetch ENDOFSTREAMOP of STREAM))
(LENGTH (AND (RANDACCESSP STREAM)
(\GETEOFPTR STREAM)))
(SIZE (AND [SETQ VAL (OR (FDEVOP (QUOTE GETFILEINFO)
DEV STREAM (QUOTE LENGTH)
DEV)
(AND (RANDACCESSP STREAM)
(\GETEOFPTR STREAM]
(FOLDHI VAL BYTESPERPAGE)))
NIL]
[STREAM (* STREAM is a full filename)
(SELECTQ ATTRIB
((ACCESS OPENBYTESIZE)
(* Strip off attributes that apply only to open files)
NIL)
(OR (FDEVOP (QUOTE GETFILEINFO)
(SETQ DEV (\GETDEVICEFROMNAME STREAM))
STREAM ATTRIB DEV)
(SELECTQ ATTRIB
(SIZE (AND (SETQ VAL (FDEVOP (QUOTE GETFILEINFO)
DEV STREAM
(QUOTE LENGTH)
DEV))
(FOLDHI VAL BYTESPERPAGE)))
NIL]
(T (LISPERROR "FILE NOT FOUND" FILE])
(GETFILEPTR
[LAMBDA (FILE) (* rmk: "21-OCT-83 11:19")
(PROG ((STREAM (\GETSTREAM FILE)))
(RETURN (FDEVOP (QUOTE GETFILEPTR)
(fetch DEVICE of STREAM)
STREAM])
(SETFILEINFO
[LAMBDA (FILE ATTRIB VALUE) (* rmk: "13-Aug-84 17:15")
(PROG ((STREAM (\GETFILENAME.OR.STREAM FILE (QUOTE OLD)))
DEV)
(RETURN (COND
[(type? STREAM STREAM) (* FILE is open, so strip off attributes that can be set
from the stream..)
(SELECTQ ATTRIB
((ACCESS BYTESIZE OPENBYTESIZE)
(* These cant be changed for an open file)
NIL)
(EOL (replace EOLCONVENTION of STREAM with (SELECTQ VALUE
(CR CR.EOLC)
(CRLF CRLF.EOLC)
(LF LF.EOLC)
(\ILLEGAL.ARG
VALUE)))
VALUE)
(ENDOFSTREAMOP (replace ENDOFSTREAMOP of STREAM with VALUE))
[BUFFERS (replace MAXBUFFERS of STREAM with (IMAX 1 (FIX VALUE]
(OR (FDEVOP (QUOTE SETFILEINFO)
(SETQ DEV (fetch DEVICE of STREAM))
STREAM ATTRIB VALUE DEV)
(SELECTQ ATTRIB
[LENGTH
(* Let device at this attribute first. Probably should not have this generic op, since we don't know how to do
this for all devices)
(\SETEOFPTR STREAM (COND
((type? BYTEPTR VALUE)
VALUE)
(T (\ILLEGAL.ARG VALUE]
(SIZE (\SETEOFPTR STREAM (UNFOLD VALUE BYTESPERPAGE)))
NIL]
[STREAM (* STREAM is a full filename)
(SELECTQ ATTRIB
((ACCESS OPENBYTESIZE EOLCONVENTION)
NIL)
(OR (FDEVOP (QUOTE SETFILEINFO)
(SETQ DEV (\GETDEVICEFROMNAME STREAM))
STREAM ATTRIB VALUE DEV)
(COND
((EQ ATTRIB (QUOTE LENGTH))
(\SETCLOSEDFILELENGTH STREAM (COND
((type? BYTEPTR VALUE)
VALUE)
(T (\ILLEGAL.ARG VALUE]
(T (LISPERROR "FILE NOT FOUND" FILE])
(SETFILEPTR
[LAMBDA (FILE ADR) (* rmk: "21-OCT-83 11:19")
(PROG ((STREAM (\GETSTREAM FILE)))
[FDEVOP (QUOTE SETFILEPTR)
(fetch DEVICE of STREAM)
STREAM
(COND
((EQ ADR -1)
(\GETEOFPTR STREAM))
((type? BYTEPTR ADR)
ADR)
(T (LISPERROR "ILLEGAL ARG" ADR]
(replace (STREAM CHARPOSITION) of STREAM with 0)
(RETURN ADR) (* Not coerced!)
])
)
(* Generic functions)
(DEFINEQ
(\GENERIC.BINS
[LAMBDA (STREAM BASE OFF NBYTES) (* bvm: "25-MAY-83 11:41")
(* BINs NBYTES bytes from STREAM to memory starting at
BASE+OFF.)
(FRPTQ NBYTES (\PUTBASEBYTE BASE OFF (\BIN STREAM))
(add OFF 1])
(\GENERIC.BOUTS
[LAMBDA (STREAM BASE OFF NBYTES) (* bvm: "25-MAY-83 11:40")
(* BOUTs NBYTES bytes from BASE+OFF into STREAM)
(FRPTQ NBYTES (\BOUT STREAM (\GETBASEBYTE BASE OFF))
(add OFF 1])
(\GENERIC.RENAMEFILE
[LAMBDA (OLDFILE NEWFILE) (* bvm: "21-NOV-83 15:25")
(RESETLST [RESETSAVE (SETQ OLDFILE (OPENSTREAM OLDFILE (QUOTE INPUT)))
(QUOTE (AND RESETSTATE (CLOSEF? OLDVALUE]
(COND
((SETQ NEWFILE (\COPYOPENFILE OLDFILE NEWFILE))
(\DELETEFILE (CLOSEF OLDFILE))
NEWFILE])
(\GENERIC.READP
[LAMBDA (STREAM FLG) (* rrb "22-JUL-83 08:58")
(* The 10 does not do the EOL check on the peeked
character.)
(* If FLG is NIL, a single EOL doesn't count.)
(AND (NOT (\EOFP STREAM))
(OR (NOT (NULL FLG))
(NEQ EOL.TC (\SYNCODE \PRIMTERMSA (\PEEKBIN STREAM)))
(UNINTERRUPTABLY
(\BIN STREAM) (* To find out if the EOL is the last character, we BIN
the stream, check for EOF, then back it up again.)
(PROG1 (NOT (\EOFP STREAM))
(\BACKFILEPTR STREAM)))])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \OUTCHAR DMACRO (OPENLAMBDA (STREAM CHARCODE)
(STREAMOP (QUOTE OUTCHARFN)
STREAM STREAM CHARCODE)))
)
(* END EXPORTED DEFINITIONS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
[MAPC (QUOTE ((FORCEOUTPUT FLUSHOUTPUT)
(FORCEOUTPUT FLUSHMAP)
(\GENERIC.BINS \NONPAGEDBINS)
(\GENERIC.BOUTS \NONPAGEDBOUTS)))
(FUNCTION (LAMBDA (PAIR)
(PUTD (CADR PAIR)
(GETD (CAR PAIR))
T]
)
(* Internal functions)
(DEFINEQ
(\EOF.ACTION
[LAMBDA (STREAM) (* bvm: "24-Aug-84 18:06")
(* Standard thing to do at end of stream)
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
STREAM])
(\EOSERROR
[LAMBDA (STREAM) (* rmk: "30-JUN-82 17:30")
(LISPERROR "END OF FILE" (fetch FULLNAME of STREAM)
T])
(\GETEOFPTR
[LAMBDA (STREAM) (* lmm "25-MAY-83 23:17")
(FDEVOP (QUOTE GETEOFPTR)
(fetch DEVICE of STREAM)
STREAM])
(\INCFILEPTR
[LAMBDA (STREAM AMOUNT) (* bvm: " 7-Jun-84 16:47")
(COND
((NOT (fetch PAGEMAPPED of (fetch DEVICE of STREAM)))
(\SETFILEPTR STREAM (IPLUS (\GETFILEPTR STREAM)
AMOUNT)))
(T (\PAGED.INCFILEPTR STREAM AMOUNT])
(\PEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* bvm: "26-DEC-81 15:59")
(FDEVOP (QUOTE PEEKBIN)
(fetch DEVICE of STREAM)
STREAM NOERRORFLG])
(\SETCLOSEDFILELENGTH
[LAMBDA (FILENAME NBYTES) (* bvm: "13-JUL-83 15:15")
(* Reset the length of a closed file to nBytes.)
(PROG [(STREAM (\OPENFILE FILENAME (QUOTE BOTH)
(QUOTE OLD]
(\SETEOFPTR STREAM NBYTES)
(\CLOSEFILE STREAM)
(RETURN T])
(\SETEOFPTR
[LAMBDA (STREAM LEN) (* bvm: " 9-Jul-84 17:37")
(FDEVOP (QUOTE SETEOFPTR)
(fetch DEVICE of STREAM)
STREAM LEN])
(\SETFILEPTR
[LAMBDA (STREAM INDX) (* rmk: "22-AUG-83 13:37")
(* Fast case of SETFILEPTR, assumes STREAM is a stream and INDX is an already coerced fileptr
(not -1) Does not reset CHARPOSITION and value is uninteresting)
(FDEVOP (QUOTE SETFILEPTR)
(fetch DEVICE of STREAM)
STREAM INDX])
)
(DEFINEQ
(\FIXPOUT
[LAMBDA (STRM N) (* rmk: "25-Jun-84 14:47")
(\BOUT STRM (LOADBYTE N 24 BITSPERBYTE))
(\BOUT STRM (LOADBYTE N 16 BITSPERBYTE))
(\BOUT STRM (LOADBYTE N 8 BITSPERBYTE))
(\BOUT STRM (LOADBYTE N 0 BITSPERBYTE])
(\FIXPIN
[LAMBDA (STRM) (* rmk: "14-Jun-84 19:36")
(* Read in a full 32 bit integer)
(LOGOR (LLSH (\WIN STRM)
16)
(\WIN STRM])
)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DECFILEPTR MACRO ((STREAM X)
(\INCFILEPTR STREAM (IMINUS X))))
(PUTPROPS \GETFILEPTR MACRO (OPENLAMBDA (STRM)
(FDEVOP (QUOTE GETFILEPTR)
(fetch DEVICE of STRM)
STRM)))
(PUTPROPS \SIGNEDWIN MACRO ((STREAM)
(SIGNED (\WIN STREAM)
BITSPERWORD)))
(PUTPROPS \SIGNEDWOUT MACRO ((STREAM N)
(\WOUT STREAM (UNSIGNED N BITSPERWORD))))
(PUTPROPS \WIN MACRO (OPENLAMBDA (STREAM)
(create WORD
HIBYTE ←(\BIN STREAM)
LOBYTE ←(\BIN STREAM))))
(PUTPROPS \WOUT MACRO (OPENLAMBDA (STREAM W)
(\BOUT STREAM (fetch HIBYTE of W))
(\BOUT STREAM (fetch LOBYTE of W))))
(PUTPROPS \BINS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES)
(FDEVOP (QUOTE BLOCKIN)
(fetch (STREAM DEVICE)
of STRM)
STRM BASE OFF NBYTES)))
(PUTPROPS \BOUTS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES)
(FDEVOP (QUOTE BLOCKOUT)
(fetch (STREAM DEVICE)
of STRM)
STRM BASE OFF NBYTES)))
(PUTPROPS \EOFP BYTEMACRO (OPENLAMBDA (STRM)
(FDEVOP (QUOTE EOFP)
(fetch (STREAM DEVICE)
of STRM)
STRM)))
)
(DECLARE: EVAL@COMPILE
(RPAQQ BitsPerByte 8)
(RPAQ ByteOffsetSize (SELECTQ (SYSTEMTYPE)
(VAX 10)
9))
(RPAQQ WordsPerPage 256)
(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE)
(VAX 10)
9))
WordsPerPage)
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE))
(OFFSET (MOD DATUM BYTESPERPAGE)))
(TYPE? (AND (FIXP DATUM)
(IGEQ DATUM 0)))
(CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE)
OFFSET)))
]
(* END EXPORTED DEFINITIONS)
(DECLARE: EVAL@COMPILE
(RPAQQ MaxChar 255)
(CONSTANTS MaxChar)
)
)
(* Buffered IO)
(DEFINEQ
(\BUFFERED.BIN
[LAMBDA (STREAM) (* bvm: "10-Jul-84 13:25")
(PROG (OFF X)
RETRY
[RETURN (\GETBASEBYTE (OR (fetch CBUFPTR of STREAM)
(GO REFILL))
(PROG1 (SETQ OFF (fetch COFFSET of STREAM))
(COND
((IGEQ OFF (fetch CBUFSIZE of STREAM))
(GO REFILL)))
(replace COFFSET of STREAM with (ADD1 OFF]
REFILL
(COND
((EQ (SETQ X (FDEVOP (QUOTE GETNEXTBUFFER)
(fetch DEVICE of STREAM)
STREAM
(QUOTE READ)))
T)
(GO RETRY))
(T (RETURN X])
(\BUFFERED.PEEKBIN
[LAMBDA (STREAM NOERRORFLG) (* bvm: "24-Aug-84 17:43")
(PROG (OFF X)
RETRY
[RETURN (\GETBASEBYTE (OR (fetch CBUFPTR of STREAM)
(GO REFILL))
(PROG1 (SETQ OFF (fetch COFFSET of STREAM))
(COND
((IGEQ OFF (fetch CBUFSIZE of STREAM))
(GO REFILL]
REFILL
(COND
((EQ (SETQ X (FDEVOP (QUOTE GETNEXTBUFFER)
(fetch DEVICE of STREAM)
STREAM
(QUOTE READ)
NOERRORFLG))
T)
(GO RETRY))
(T (RETURN X])
(\BUFFERED.BOUT
[LAMBDA (STREAM BYTE) (* bvm: "10-Jul-84 13:30")
(CHECK (type? STREAM STREAM)
(WRITEABLE STREAM))
(PROG (OFF)
RETRY
(\PUTBASEBYTE (OR (fetch CBUFPTR of STREAM)
(GO REFILL))
[PROG1 (SETQ OFF (fetch COFFSET of STREAM))
(COND
((ILESSP OFF (fetch CBUFMAXSIZE of STREAM))
(replace COFFSET of STREAM with (ADD1 OFF)))
(T (GO REFILL]
BYTE)
(replace CBUFDIRTY of STREAM with T)
(RETURN 1)
REFILL
(FDEVOP (QUOTE GETNEXTBUFFER)
(fetch DEVICE of STREAM)
STREAM
(QUOTE WRITE))
(GO RETRY])
(\BUFFERED.BINS
[LAMBDA (STREAM DBASE OFFSET NBYTES NOERRORFLG) (* bvm: "11-Jul-84 19:15")
(* * For buffered streams, BINs NBYTES bytes from STREAM to memory starting at DBASE+OFFSET -
If NOERRORFLG then stops without error at eof. Returns number of bytes actually read)
(bind (BYTESLEFT ← NBYTES)
CNT END IBASE START X
do [COND
((SETQ IBASE (fetch CBUFPTR of STREAM)) (* Current buffer)
(SETQ START (fetch COFFSET of STREAM)) (* Offset of first byte to transfer)
[COND
((IGREATERP (SETQ CNT (IDIFFERENCE (SETQ END (fetch CBUFSIZE of STREAM))
START))
BYTESLEFT) (* Not a whole buffer full)
(SETQ END (IPLUS START (SETQ CNT BYTESLEFT]
(* First byte BEYOND whats to be read from this page)
(\MOVEBYTES IBASE START DBASE OFFSET CNT)
(replace COFFSET of STREAM with END)
(COND
((EQ CNT BYTESLEFT) (* Finished)
(RETURN NBYTES))
(T (add OFFSET CNT)
(SETQ BYTESLEFT (IDIFFERENCE BYTESLEFT CNT]
(COND
((NULL (SETQ X (FDEVOP (QUOTE GETNEXTBUFFER)
(fetch DEVICE of STREAM)
STREAM
(QUOTE READ)
NOERRORFLG))) (* No error at eof)
(RETURN (IDIFFERENCE NBYTES BYTESLEFT)))
((NEQ X T) (* At eof, but EOF op returned a value to fake more data
at eof)
(RETURN (do (\PUTBASEBYTE DBASE OFFSET X)
(add OFFSET 1)
(COND
((EQ (add BYTESLEFT -1)
0)
(RETURN NBYTES)))
(SETQ X (\BIN STREAM])
(\BUFFERED.BOUTS
[LAMBDA (STREAM SBASE OFFSET NBYTES) (* bvm: "10-Jul-84 13:39")
(* * For buffered streams, bouts NBYTES bytes to STREAM from SBASE+OFFSET)
(bind (DEV ←(fetch DEVICE of STREAM))
CNT END DBASE START
do [COND
((SETQ DBASE (fetch CBUFPTR of STREAM))
(SETQ START (fetch COFFSET of STREAM))
[COND
((IGREATERP (SETQ CNT (IDIFFERENCE (SETQ END (fetch CBUFMAXSIZE of STREAM))
START))
NBYTES)
(SETQ END (IPLUS START (SETQ CNT NBYTES]
(\MOVEBYTES SBASE OFFSET DBASE START CNT)
(replace COFFSET of STREAM with END)
(replace CBUFDIRTY of STREAM with T)
(COND
((ILEQ (SETQ NBYTES (IDIFFERENCE NBYTES CNT))
0)
(RETURN))
(T (add OFFSET CNT]
(FDEVOP (QUOTE GETNEXTBUFFER)
DEV STREAM (QUOTE WRITE])
(\BUFFERED.COPYBYTES
[LAMBDA (SRC DST NBYTES) (* bvm: "10-Jul-84 21:48")
(* * Copies NBYTES bytes from buffered stream SRC to arbitrary stream DST, or copies to eof if NBYTES is NIL)
(bind (NOERRORFLG ←(NULL NBYTES))
(DEV ←(fetch DEVICE of SRC))
BUF NB STARTOFFSET END do [COND
((SETQ BUF (fetch CBUFPTR of SRC))
(* Copy a buffer full)
[SETQ NB (IDIFFERENCE (SETQ END (fetch CBUFSIZE of SRC))
(SETQ STARTOFFSET
(fetch COFFSET of SRC]
[COND
((AND NBYTES (IGREATERP NB NBYTES))
(* Don't copy too much)
(SETQ END (IPLUS STARTOFFSET (SETQ NB NBYTES]
(\BOUTS DST BUF STARTOFFSET NB)
(replace COFFSET of SRC with END)
(COND
(NBYTES (COND
((EQ NB NBYTES)
(RETURN))
(T (SETQ NBYTES (IDIFFERENCE NBYTES NB]
repeatwhile (FDEVOP (QUOTE GETNEXTBUFFER)
DEV SRC (QUOTE READ)
NOERRORFLG])
)
(* NULL device)
(DEFINEQ
(\NULLDEVICE
[LAMBDA NIL (* bvm: "24-Aug-84 18:06")
(* Defines the NULL device, an infinite source or sink)
(\DEFINEDEVICE (QUOTE NULL)
(create FDEV
DEVICENAME ←(QUOTE NULL)
RANDOMACCESSP ← T
NODIRECTORIES ← T
CLOSEFILE ←(FUNCTION NILL)
DELETEFILE ←(FUNCTION NILL)
OPENFILE ←(FUNCTION \NULL.OPENFILE)
REOPENFILE ←(FUNCTION \NULL.OPENFILE)
BIN ←(FUNCTION \EOF.ACTION)
BOUT ←(FUNCTION NILL)
PEEKBIN ←[FUNCTION (LAMBDA (STREAM NOERRORFLG)
(AND (NULL NOERRORFLG)
(BIN STREAM]
READP ←(FUNCTION NILL)
BACKFILEPTR ←(FUNCTION NILL)
EOFP ←(FUNCTION TRUE)
RENAMEFILE ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION [LAMBDA (NAME RECOG)
(QUOTE {NULL}])
EVENTFN ←(FUNCTION NILL)
BLOCKIN ←(FUNCTION \EOF.ACTION)
BLOCKOUT ←(FUNCTION NILL)
GENERATEFILES ←(FUNCTION \NULLFILEGENERATOR)
GETFILEPTR ←(FUNCTION ZERO)
GETEOFPTR ←(FUNCTION ZERO)
SETFILEPTR ←(FUNCTION NILL)
GETFILEINFO ←(FUNCTION NILL)
SETFILEINFO ←(FUNCTION NILL)
SETEOFPTR ←(FUNCTION NILL])
(\NULL.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM) (* bvm: "24-Aug-84 17:57")
(OR OLDSTREAM (create STREAM
USERCLOSEABLE ← T
ACCESS ← ACCESS
FULLFILENAME ←(QUOTE {NULL})
DEVICE ← DEVICE])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\NULLDEVICE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
)
(PUTPROPS FILEIO COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (12599 14419 (STREAMPROP 12609 . 13073) (GETSTREAMPROP 13075 . 13308) (PUTSTREAMPROP
13310 . 14275) (STREAMP 14277 . 14417)) (14542 18143 (\GETACCESS 14552 . 15102) (\SETACCESS 15104 .
18141)) (26243 31133 (\DEFINEDEVICE 26253 . 28164) (\GETDEVICEFROMNAME 28166 . 29750) (\REMOVEDEVICE
29752 . 30508) (\REMOVEDEVICE.NAMES 30510 . 31131)) (31134 41525 (\CLOSEFILE 31144 . 31842) (
\DELETEFILE 31844 . 32122) (\DEVICEEVENT 32124 . 33159) (\GENERATEFILES 33161 . 33660) (
\GENERATENEXTFILE 33662 . 34362) (\GENERATEFILEINFO 34364 . 34817) (\GETFILENAME 34819 . 35392) (
\GETFILENAME.OR.STREAM 35394 . 36175) (\OPENFILE 36177 . 38016) (\DO.PARAMS.AT.OPEN 38018 . 38675) (
\RENAMEFILE 38677 . 39149) (\REVALIDATEFILE 39151 . 41116) (\TRUNCATEFILE 41118 . 41523)) (41557 45155
(\GENERATENOFILES 41567 . 42926) (\NULLFILEGENERATOR 42928 . 43214) (\NOFILESNEXTFILEFN 43216 . 44839
) (\NOFILESINFOFN 44841 . 45153)) (45273 46903 (\FILE.NOT.OPEN 45283 . 45762) (\FILE.WONT.OPEN 45764
. 45986) (\ILLEGAL.DEVICEOP 45988 . 46210) (\IS.NOT.RANDACCESSP 46212 . 46507) (\STREAM.NOT.OPEN
46509 . 46901)) (47034 48984 (\FDEVINSTANCE 47044 . 48982)) (49778 57098 (CNDIR 49788 . 53593) (
DIRECTORYNAME 53595 . 54918) (DIRECTORYNAMEP 54920 . 55527) (HOSTNAMEP 55529 . 56282) (
\ADD.CONNECTED.DIR 56284 . 57096)) (57141 73833 (\BACKFILEPTR 57151 . 57344) (\BACKPEEKBIN 57346 .
57781) (\BACKBIN 57783 . 58134) (BIN 58136 . 58297) (\BIN 58299 . 58588) (\BINS 58590 . 58937) (BOUT
58939 . 59160) (\BOUT 59162 . 59370) (\BOUTS 59372 . 59759) (COPYBYTES 59761 . 61405) (COPYCHARS 61407
. 64917) (COPYFILE 64919 . 65220) (\COPYOPENFILE 65222 . 67012) (\INFER.FILE.TYPE 67014 . 67871) (
EOFP 67873 . 68255) (FORCEOUTPUT 68257 . 68516) (\FLUSH.OPEN.STREAMS 68518 . 68855) (GETEOFPTR 68857
. 69098) (GETFILEINFO 69100 . 71043) (GETFILEPTR 71045 . 71288) (SETFILEINFO 71290 . 73291) (
SETFILEPTR 73293 . 73831)) (73864 75648 (\GENERIC.BINS 73874 . 74213) (\GENERIC.BOUTS 74215 . 74522) (
\GENERIC.RENAMEFILE 74524 . 74881) (\GENERIC.READP 74883 . 75646)) (76201 78340 (\EOF.ACTION 76211 .
76501) (\EOSERROR 76503 . 76684) (\GETEOFPTR 76686 . 76848) (\INCFILEPTR 76850 . 77158) (\PEEKBIN
77160 . 77356) (\SETCLOSEDFILELENGTH 77358 . 77761) (\SETEOFPTR 77763 . 77956) (\SETFILEPTR 77958 .
78338)) (78341 78910 (\FIXPOUT 78351 . 78650) (\FIXPIN 78652 . 78908)) (80918 86756 (\BUFFERED.BIN
80928 . 81565) (\BUFFERED.PEEKBIN 81567 . 82156) (\BUFFERED.BOUT 82158 . 82883) (\BUFFERED.BINS 82885
. 84665) (\BUFFERED.BOUTS 84667 . 85588) (\BUFFERED.COPYBYTES 85590 . 86754)) (86781 88295 (
\NULLDEVICE 86791 . 88042) (\NULL.OPENFILE 88044 . 88293)))))
STOP