(FILECREATED "19-Oct-85 17:06:49" {ERIS}<LISPCORE>SOURCES>FILEIO.;57 99556
changes to: (FNS CNDIR DIRECTORYNAMEP COPYFILE \COPYOPENFILE)
previous date: "16-Sep-85 18:11:00" {ERIS}<LISPCORE>SOURCES>FILEIO.;56)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985 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))
\NORUNCODE)
(MACROS APPENDABLE APPENDONLY DIRTYABLE OPENED OVERWRITEABLE
READABLE READONLY WRITEABLE)
(MACROS TestMasked)
(MACROS \RUNCODED)
(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 \GETDEVICEFROMHOSTNAME \REMOVEDEVICE
\REMOVEDEVICE.NAMES)
(FNS \CLOSEFILE \DELETEFILE \DEVICEEVENT \GENERATEFILES \GENERATENEXTFILE
\GENERATEFILEINFO \GETFILENAME \GETFILENAME.OR.STREAM \GENERIC.OUTFILEP \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}))
(\CONNECTED.DIRECTORY (QUOTE {DSK})))
(GLOBALVARS LOGINHOST/DIR \CONNECTED.DIRECTORY \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 CHARSET GETEOFPTR GETFILEINFO \TYPE.FROM.FILETYPE
\FILETYPE.FROM.TYPE GETFILEPTR SETFILEINFO SETFILEPTR BOUT16 BIN16)
(* Generic functions)
(FNS \GENERIC.BINS \GENERIC.BOUTS \GENERIC.RENAMEFILE \GENERIC.READP)
(VARS FILING.TYPES)
(GLOBALVARS FILING.TYPES)
(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)
[CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 24]
(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 BYTE))
[QUOTE ((STREAM 0 (BITS . 15))
(STREAM 1 (BITS . 15))
(STREAM 2 (FLAGBITS . 0))
(STREAM 2 (FLAGBITS . 16))
(STREAM 2 (FLAGBITS . 32))
(STREAM 2 (BITS . 52))
(STREAM 2 POINTER)
(STREAM 4 (FLAGBITS . 0))
(STREAM 4 (FLAGBITS . 16))
(STREAM 4 (FLAGBITS . 32))
(STREAM 4 (FLAGBITS . 48))
(STREAM 4 (FLAGBITS . 64))
(STREAM 4 (BITS . 82))
(STREAM 4 POINTER)
(STREAM 6 POINTER)
(STREAM 8 POINTER)
(STREAM 10 (BITS . 15))
(STREAM 11 (BITS . 15))
(STREAM 12 POINTER)
(STREAM 14 POINTER)
(STREAM 16 POINTER)
(STREAM 18 POINTER)
(STREAM 20 POINTER)
(STREAM 22 (BITS . 15))
(STREAM 23 (BITS . 15))
(STREAM 20 (BITS . 7))
(STREAM 24 POINTER)
(STREAM 26 (BITS . 15))
(STREAM 27 (BITS . 15))
(STREAM 28 (BITS . 15))
(STREAM 29 (BITS . 15))
(STREAM 30 (BITS . 15))
(STREAM 31 (BITS . 15))
(STREAM 24 (BITS . 1))
(STREAM 24 (FLAGBITS . 32))
(STREAM 24 (BITS . 52))
(STREAM 32 POINTER)
(STREAM 34 POINTER)
(STREAM 36 POINTER)
(STREAM 38 POINTER)
(STREAM 40 POINTER)
(STREAM 42 POINTER)
(STREAM 44 POINTER)
(STREAM 46 POINTER)
(STREAM 48 (BITS . 15))
(STREAM 49 (BITS . 15))
(STREAM 50 POINTER)
(STREAM 50 (BITS . 7]
(QUOTE 52))
)
[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)
(CHARSET BYTE)))
]
(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) (* the current character set for this stream.
gbn 4-2-85)
(CHARSET BYTE))
(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 BYTE))
[QUOTE ((STREAM 0 (BITS . 15))
(STREAM 1 (BITS . 15))
(STREAM 2 (FLAGBITS . 0))
(STREAM 2 (FLAGBITS . 16))
(STREAM 2 (FLAGBITS . 32))
(STREAM 2 (BITS . 52))
(STREAM 2 POINTER)
(STREAM 4 (FLAGBITS . 0))
(STREAM 4 (FLAGBITS . 16))
(STREAM 4 (FLAGBITS . 32))
(STREAM 4 (FLAGBITS . 48))
(STREAM 4 (FLAGBITS . 64))
(STREAM 4 (BITS . 82))
(STREAM 4 POINTER)
(STREAM 6 POINTER)
(STREAM 8 POINTER)
(STREAM 10 (BITS . 15))
(STREAM 11 (BITS . 15))
(STREAM 12 POINTER)
(STREAM 14 POINTER)
(STREAM 16 POINTER)
(STREAM 18 POINTER)
(STREAM 20 POINTER)
(STREAM 22 (BITS . 15))
(STREAM 23 (BITS . 15))
(STREAM 20 (BITS . 7))
(STREAM 24 POINTER)
(STREAM 26 (BITS . 15))
(STREAM 27 (BITS . 15))
(STREAM 28 (BITS . 15))
(STREAM 29 (BITS . 15))
(STREAM 30 (BITS . 15))
(STREAM 31 (BITS . 15))
(STREAM 24 (BITS . 1))
(STREAM 24 (FLAGBITS . 32))
(STREAM 24 (BITS . 52))
(STREAM 32 POINTER)
(STREAM 34 POINTER)
(STREAM 36 POINTER)
(STREAM 38 POINTER)
(STREAM 40 POINTER)
(STREAM 42 POINTER)
(STREAM 44 POINTER)
(STREAM 46 POINTER)
(STREAM 48 (BITS . 15))
(STREAM 49 (BITS . 15))
(STREAM 50 POINTER)
(STREAM 50 (BITS . 7]
(QUOTE 52))
(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))
(RPAQQ \NORUNCODE 255)
(CONSTANTS AppendBit NoBits ReadBit WriteBit (OutputBits (LOGOR AppendBit WriteBit))
(BothBits (LOGOR ReadBit OutputBits))
\NORUNCODE)
)
(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)
(NEQ (LOGAND BITS MASK)
0)))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \RUNCODED MACRO (OPENLAMBDA (STREAM)
(* returns NIL is the stream is not runcoded, that is, if the
stream has 16 bit bytes explicitly represented)
(* note that neq is ok since charsets are known to be SMALLP's)
(NEQ (fetch CHARSET of STREAM)
\NORUNCODE)))
)
(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:)
(REMOTEP FLAG) (* true if device not local to machine)
(SUBDIRECTORIES FLAG) (* true if device has real subdirectories)
(NIL 6 FLAG)
(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))
(WINDOWOPS POINTER) (* window system operations -
type WSOPS)
(WINDOWDATA POINTER) (* data for window systems)
(CHECKFILENAME POINTER) (* (name dev) => name if it is well-formed file name
for dev)
(HOSTALIVEP POINTER) (* (host dev) => true if host is alive, i.e.,
responsive; only defined if REMOTEP is true)
(OPENP POINTER) (* (name access dev) => stream if name is open for
access, or all open streams if name = NIL)
(OPENFILELST POINTER) (* Default place to keep list of streams open on this
device)
(NIL POINTER) (* Spare)
)
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 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 POINTER POINTER POINTER
POINTER POINTER POINTER))
(QUOTE ((FDEV 0 POINTER)
(FDEV 0 (FLAGBITS . 0))
(FDEV 0 (FLAGBITS . 16))
(FDEV 0 (FLAGBITS . 32))
(FDEV 0 (FLAGBITS . 48))
(FDEV 0 (FLAGBITS . 64))
(FDEV 0 (FLAGBITS . 80))
(FDEV 0 (FLAGBITS . 96))
(FDEV 0 (FLAGBITS . 112))
(FDEV 2 (FLAGBITS . 0))
(FDEV 2 (FLAGBITS . 16))
(FDEV 2 (FLAGBITS . 32))
(FDEV 2 (FLAGBITS . 48))
(FDEV 2 (FLAGBITS . 64))
(FDEV 2 (FLAGBITS . 80))
(FDEV 2 (FLAGBITS . 96))
(FDEV 2 (FLAGBITS . 112))
(FDEV 2 POINTER)
(FDEV 4 POINTER)
(FDEV 6 POINTER)
(FDEV 8 POINTER)
(FDEV 10 POINTER)
(FDEV 12 POINTER)
(FDEV 14 POINTER)
(FDEV 16 POINTER)
(FDEV 18 POINTER)
(FDEV 20 POINTER)
(FDEV 22 POINTER)
(FDEV 24 POINTER)
(FDEV 26 POINTER)
(FDEV 28 POINTER)
(FDEV 30 POINTER)
(FDEV 32 POINTER)
(FDEV 34 POINTER)
(FDEV 36 POINTER)
(FDEV 38 POINTER)
(FDEV 40 POINTER)
(FDEV 42 POINTER)
(FDEV 44 POINTER)
(FDEV 46 POINTER)
(FDEV 48 POINTER)
(FDEV 50 POINTER)
(FDEV 52 POINTER)
(FDEV 54 POINTER)
(FDEV 56 POINTER)
(FDEV 58 POINTER)
(FDEV 60 POINTER)
(FDEV 62 POINTER)
(FDEV 64 POINTER)
(FDEV 66 POINTER)
(FDEV 68 POINTER)
(FDEV 70 POINTER)
(FDEV 72 POINTER)
(FDEV 74 POINTER)
(FDEV 76 POINTER)
(FDEV 78 POINTER)
(FDEV 80 POINTER)
(FDEV 82 POINTER)))
(QUOTE 84))
(* END EXPORTED DEFINITIONS)
)
(/DECLAREDATATYPE (QUOTE FDEV)
(QUOTE (POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG 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 POINTER POINTER POINTER
POINTER POINTER POINTER))
(QUOTE ((FDEV 0 POINTER)
(FDEV 0 (FLAGBITS . 0))
(FDEV 0 (FLAGBITS . 16))
(FDEV 0 (FLAGBITS . 32))
(FDEV 0 (FLAGBITS . 48))
(FDEV 0 (FLAGBITS . 64))
(FDEV 0 (FLAGBITS . 80))
(FDEV 0 (FLAGBITS . 96))
(FDEV 0 (FLAGBITS . 112))
(FDEV 2 (FLAGBITS . 0))
(FDEV 2 (FLAGBITS . 16))
(FDEV 2 (FLAGBITS . 32))
(FDEV 2 (FLAGBITS . 48))
(FDEV 2 (FLAGBITS . 64))
(FDEV 2 (FLAGBITS . 80))
(FDEV 2 (FLAGBITS . 96))
(FDEV 2 (FLAGBITS . 112))
(FDEV 2 POINTER)
(FDEV 4 POINTER)
(FDEV 6 POINTER)
(FDEV 8 POINTER)
(FDEV 10 POINTER)
(FDEV 12 POINTER)
(FDEV 14 POINTER)
(FDEV 16 POINTER)
(FDEV 18 POINTER)
(FDEV 20 POINTER)
(FDEV 22 POINTER)
(FDEV 24 POINTER)
(FDEV 26 POINTER)
(FDEV 28 POINTER)
(FDEV 30 POINTER)
(FDEV 32 POINTER)
(FDEV 34 POINTER)
(FDEV 36 POINTER)
(FDEV 38 POINTER)
(FDEV 40 POINTER)
(FDEV 42 POINTER)
(FDEV 44 POINTER)
(FDEV 46 POINTER)
(FDEV 48 POINTER)
(FDEV 50 POINTER)
(FDEV 52 POINTER)
(FDEV 54 POINTER)
(FDEV 56 POINTER)
(FDEV 58 POINTER)
(FDEV 60 POINTER)
(FDEV 62 POINTER)
(FDEV 64 POINTER)
(FDEV 66 POINTER)
(FDEV 68 POINTER)
(FDEV 70 POINTER)
(FDEV 72 POINTER)
(FDEV 74 POINTER)
(FDEV 76 POINTER)
(FDEV 78 POINTER)
(FDEV 80 POINTER)
(FDEV 82 POINTER)))
(QUOTE 84))
[ADDTOVAR SYSTEMRECLST
(DATATYPE FDEV ((DEVICENAME POINTER)
(RESETABLE FLAG)
(RANDOMACCESSP FLAG)
(NODIRECTORIES FLAG)
(PAGEMAPPED FLAG)
(FDBINABLE FLAG)
(FDBOUTABLE FLAG)
(FDEXTENDABLE FLAG)
(BUFFERED FLAG)
(REMOTEP FLAG)
(SUBDIRECTORIES FLAG)
(NIL 6 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)
(WINDOWOPS POINTER)
(WINDOWDATA POINTER)
(CHECKFILENAME POINTER)
(HOSTALIVEP POINTER)
(OPENP POINTER)
(OPENFILELST 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) (* lmm " 5-Oct-84 18:06")
(* maps a filename (with host added) into a device)
(OR (AND (OR (LITATOM NAME)
(STRINGP NAME))
(LET [(HOST (FILENAMEFIELD NAME (QUOTE HOST]
(\GETDEVICEFROMHOSTNAME (OR HOST NAME)
DONTCREATE)))
(AND (NOT NOERROR)
(LISPERROR "FILE NOT FOUND" NAME])
(\GETDEVICEFROMHOSTNAME
[LAMBDA (HOSTN DONTCREATE)
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \FILEDEVICES))
(* lmm " 5-Oct-84 14:36")
(OR (CDR (FASSOC HOSTN \DEVICENAMETODEVICE))
(CDR (FASSOC (SETQ HOSTN (U-CASE HOSTN))
\DEVICENAMETODEVICE))
(AND (NOT DONTCREATE)
(for D TEMP in \FILEDEVICES when (SETQ TEMP (FDEVOP (QUOTE HOSTNAMEP)
D HOSTN 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 HOSTN D)
(RETURN D])
(\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 NAMES) (* bvm: "30-Jan-85 21:53")
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \FILEDEVICENAMES))
(* * removes any names associated with device DEV without actually removing the device itself.
If NAMES is non-NIL, removes only the names inside it)
(for TAIL on \DEVICENAMETODEVICE bind CHANGED when (AND (EQ (CDAR TAIL)
DEV)
(OR (NULL NAMES)
(EQMEMB (CAAR TAIL)
NAMES)))
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) (* bvm: " 8-Jul-85 19:30")
(* GENOBJ is a file-generator object as created by \GENERATEFILES. The NEXTFILEFN must return the name of the next
file generated by the generator, as a string or symbol. 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])
(\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: "31-Oct-84 16:12")
(* If NAME is or names an open stream, returns the
stream, else returns full name according to RECOG)
(COND
((type? STREAM NAME)
(COND
((OPENED NAME) (* Stream is open, return it)
NAME)
((fetch FULLFILENAME of NAME) (* See if full name open in another stream;
otherwise, just return the full name)
(OR (\SEARCHOPENFILES (SETQ NAME (fetch FULLFILENAME of NAME)))
NAME))
(T (* Nameless stream is its own 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])
(\GENERIC.OUTFILEP
[LAMBDA (NAME DEV) (* lmm " 6-Jan-85 17:41")
(PROG ((V (FDEVOP (QUOTE GETFILENAME)
DEV NAME (QUOTE OLD)
DEV)))
(RETURN (if V
then (PACKFILENAME (QUOTE VERSION)
(ADD1 (OR (FILENAMEFIELD V (QUOTE VERSION))
1))
(QUOTE BODY)
V)
else (PACKFILENAME (QUOTE VERSION)
1
(QUOTE BODY)
NAME])
(\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) (* rmk: "27-Mar-85 18:02")
(* Does generic parameters when a file/stream is open.
Called by \OPENFILE and OPENSTREAM)
(for X ATTR VAL 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))
(CHARSET (CHARSET STREAM 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) (* bvm: " 8-Jul-85 19:28")
(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.STRING (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)
FILE])
(\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) (* gbn "16-Sep-85 18:09")
(* 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)
FORCEOUTPUT ←(\INHERITFDEVOP.S FORCEOUTPUT 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}))
(RPAQ? \CONNECTED.DIRECTORY (QUOTE {DSK}))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS LOGINHOST/DIR \CONNECTED.DIRECTORY \FILEDEVICES \FILEDEVICENAMES \DEVICENAMETODEVICE)
)
(* Directory defaulting)
(DEFINEQ
(CNDIR
[LAMBDA (HOST/DIR) (* bvm: "18-Oct-85 14:33")
(* Connects to HOST/DIR, verifying that HOST/DIR
exists.)
(SETQ \CONNECTED.DIRECTORY (OR (DIRECTORYNAME HOST/DIR T (QUOTE ASK))
(ERROR "Non-existent directory" HOST/DIR])
(DIRECTORYNAME
[LAMBDA (DIRNAME STRPTR CREATE?) (* lmm " 5-Oct-84 17:43")
(* Returns connected directory name)
(SELECTQ (SYSTEMTYPE)
(VAX (GETDIRNAME))
[D (DECLARE (GLOBALVARS LOGINHOST/DIR))
(PROG (DN FDEV)
[SELECTQ DIRNAME
(T (* Connected host/dir)
(SETQ DN \CONNECTED.DIRECTORY))
[NIL (SETQ DN (OR LOGINHOST/DIR (QUOTE {DSK}]
(COND
[(AND [SETQ FDEV (LET [(HOST (FILENAMEFIELD DIRNAME (QUOTE HOST]
(\GETDEVICEFROMHOSTNAME
(OR HOST (FILENAMEFIELD (SETQ DIRNAME
(PACKFILENAME.STRING
(QUOTE DIRECTORY)
DIRNAME
(QUOTE DIRECTORY)
\CONNECTED.DIRECTORY))
(QUOTE HOST]
(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) (* bvm: "18-Oct-85 14:38")
(* 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.)
(LET ([DN (COND
(HOSTNAME (PACKFILENAME.STRING (QUOTE DIRECTORY)
DIRNAME
(QUOTE HOST)
HOSTNAME))
(T (PACKFILENAME.STRING (QUOTE DIRECTORY)
DIRNAME
(QUOTE DIRECTORY)
\CONNECTED.DIRECTORY]
FDEV)
(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) (* lmm " 9-Oct-84 13:36")
(* * Modifies the filename to include connected host and/or dir)
(if [AND (OR (LITATOM FILENAME)
(STRINGP FILENAME))
(NOT (FILENAMEFIELD FILENAME (QUOTE HOST]
then (PACKFILENAME (QUOTE BODY)
FILENAME
(QUOTE DIRECTORY)
\CONNECTED.DIRECTORY)
else 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) (* rmk: "11-Mar-85 12:13")
(* 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)
(if (EQUAL START END)
then (* special case: no bytes to copy)
(RETURN))
[\SETFILEPTR SRC (COND
((type? BYTEPTR START)
START)
(T (\ILLEGAL.ARG START]
(IDIFFERENCE (COND
((EQ END -1)
(\GETEOFPTR SRC))
((type? BYTEPTR END)
END)
(T (\ILLEGAL.ARG 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: "11-Mar-85 12:12")
(* 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)
((type? BYTEPTR END)
END)
(T (\ILLEGAL.ARG END]
[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 DESTPARAMETERS) (* bvm: "18-Oct-85 15:50")
(* * DESTPARAMETERS is like PARAMETERS arg to OPENSTREAM -- overrides default parameters)
(RESETLST [RESETSAVE [SETQ FROMFILE (OPENSTREAM FROMFILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE ((SEQUENTIAL T)
(DON'TCACHE T]
(QUOTE (PROGN (CLOSEF OLDVALUE]
(\COPYOPENFILE FROMFILE TOFILE DESTPARAMETERS])
(\COPYOPENFILE
[LAMBDA (INSTREAM NEWNAME DESTPARAMETERS) (* bvm: "18-Oct-85 15:54")
(PROG ((PROPS DESTPARAMETERS)
TYPE X OUTSTREAM)
[COND
([AND (NOT (ASSOC (QUOTE CREATIONDATE)
DESTPARAMETERS))
(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
[(SETQ TYPE (CADR (ASSOC (QUOTE TYPE)
DESTPARAMETERS]
((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)))
(NOT (ASSOC (QUOTE EOL)
DESTPARAMETERS)))
(push PROPS (LIST (QUOTE EOL)
X]
[RESETSAVE [SETQ OUTSTREAM (OPENSTREAM NEWNAME (QUOTE OUTPUT)
(QUOTE NEW)
(BQUOTE ((SEQUENTIAL T)
(DON'TCACHE T)
(\,@ PROPS]
(QUOTE (AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE))
(DELFILE 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) (* gbn "16-Sep-85 18:09")
(for STREAM in \OPENFILES when (AND (EQ (fetch DEVICE of STREAM)
FDEV)
(DIRTYABLE STREAM))
do (FDEVOP (QUOTE FORCEOUTPUT)
(fetch DEVICE of STREAM)
STREAM])
(CHARSET
[LAMBDA (STREAM CHARACTERSET) (* rmk: "24-Apr-85 11:06")
(* * sets or returns the current character set for this stream)
(SETQ STREAM (\GETSTREAM STREAM))
(OR (EQ CHARACTERSET NIL)
(EQ CHARACTERSET T)
(AND (IGEQ CHARACTERSET 0)
(ILEQ CHARACTERSET \MAXCHARSET)
(NEQ CHARACTERSET NSCHARSETSHIFT))
(\ILLEGAL.ARG CHARACTERSET))
(PROG1 (if (\RUNCODED STREAM)
then (* it makes sense, so return the current character
set.)
(ffetch CHARSET of STREAM)
else (* just return T since there is no notion of current
charset for streams which are currently not runcoded)
T)
(AND CHARACTERSET (COND
((EQ T CHARACTERSET) (* this means to make the stream not be runcoded)
(if (\RUNCODED STREAM)
then (IMAGEOP (QUOTE IMCHARSET)
STREAM STREAM CHARACTERSET)
(freplace CHARSET of STREAM with \NORUNCODE)))
((NEQ CHARACTERSET (ffetch CHARSET of STREAM))
(IMAGEOP (QUOTE IMCHARSET)
STREAM STREAM CHARACTERSET)
(freplace CHARSET of STREAM with CHARACTERSET])
(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: "27-Mar-85 18:05")
(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))
((OPENED STREAM) (* Could be false for a closed nameless stream)
(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))
(CHARSET (CHARSET 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))
((EQ ATTRIB (QUOTE SIZE))
(AND (SETQ VAL (FDEVOP (QUOTE GETFILEINFO)
DEV STREAM (QUOTE LENGTH)
DEV))
(FOLDHI VAL BYTESPERPAGE]
[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])
(\TYPE.FROM.FILETYPE
[LAMBDA (FILETYPE) (* bvm: "15-Jan-85 16:22")
(* * Coerces a numeric FILETYPE to a symbolic TYPE or returns FILETYPE itself if it is not registered on the list
FILING.TYPES)
(AND FILETYPE (OR (CAR (find PAIR in FILING.TYPES suchthat (EQ (CADR PAIR)
FILETYPE)))
FILETYPE])
(\FILETYPE.FROM.TYPE
[LAMBDA (TYPE) (* bvm: "15-Jan-85 17:08")
(OR (CADR (ASSOC TYPE FILING.TYPES))
(FIXP TYPE])
(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: "27-Mar-85 18:04")
(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]
(CHARSET (CHARSET STREAM 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: "24-Apr-85 14:37")
(LET ((STREAM (\GETSTREAM FILE)))
[FDEVOP (QUOTE SETFILEPTR)
(ffetch DEVICE of STREAM)
STREAM
(COND
((EQ ADR -1)
(\GETEOFPTR STREAM))
((type? BYTEPTR ADR)
ADR)
(T (LISPERROR "ILLEGAL ARG" ADR]
(if (AND (\RUNCODED STREAM)
(EQ ADR 0))
then
(* A stream always begins in character set 0, so it is safe and proper to always reset the charset to 0 when we go
back there. Don't do it for 16-bit files though, on the assumption that if you are in a 16-bit mode, the file
probably is always in 16-bit mode (although it might have the 16-bit shift byte at the beginning, which are
harmless). Open question is whether we should always set runcoded files to 0, and then fix GETFILEPTR so that it
always puts out the shift to charset 0 before it returns the fileptr)
(CHARSET STREAM 0))
(freplace (STREAM CHARPOSITION) of STREAM with 0) (* Value is not coerced!)
ADR])
(BOUT16
[LAMBDA (STREAM N) (* edited: " 2-Apr-85 17:11")
(BOUT STREAM (LRSH N 8))
(BOUT STREAM (LOGAND N 255))
N])
(BIN16
[LAMBDA (STREAM) (* edited: " 2-Apr-85 17:11")
(LOGOR (LLSH (BIN STREAM)
8)
(BIN STREAM])
)
(* 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) (* lmm "11-Aug-85 15:21")
(RESETLST [RESETSAVE [SETQ OLDFILE (OPENSTREAM OLDFILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE ((SEQUENTIAL T)
DON'TCACHE]
(QUOTE (AND RESETSTATE (CLOSEF? OLDVALUE]
(COND
((SETQ NEWFILE (\COPYOPENFILE OLDFILE NEWFILE))
(\DELETEFILE (CLOSEF OLDFILE))
NEWFILE])
(\GENERIC.READP
[LAMBDA (STREAM FLG) (* rmk: "27-Mar-85 18:07")
(* The 10 does not do the EOL check on the peeked
character.)
(* If FLG is NIL, a single EOL doesn't count.)
(PROG ((SHIFTEDCHARSET (UNFOLD (ffetch CHARSET of STREAM)
256)))
(RETURN (AND (NOT (\EOFP STREAM))
(OR (NOT (NULL FLG))
[NEQ EOL.TC (\SYNCODE \PRIMTERMSA (OR (\NSPEEK STREAM SHIFTEDCHARSET
SHIFTEDCHARSET T)
(RETURN]
(UNINTERRUPTABLY
(\NSIN STREAM SHIFTEDCHARSET SHIFTEDCHARSET)
(* 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))
(\BACKNSCHAR STREAM SHIFTEDCHARSET)))])
)
(RPAQQ FILING.TYPES ((BINARY 0)
(DIRECTORY 1)
(TEXT 2)
(SERIALIZED 3)
(INTERPRESS 4361)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FILING.TYPES)
)
(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
(RPAQ \MAXFILEPTR (SUB1 (LLSH 1 24)))
[CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 24]
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE))
(OFFSET (MOD DATUM BYTESPERPAGE)))
(TYPE? (AND (FIXP DATUM)
(IGEQ DATUM 0)
(ILEQ DATUM \MAXFILEPTR)))
(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: "30-Jan-85 22: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 NILL)
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: "30-Jan-85 22:05")
(OR OLDSTREAM (create STREAM
USERCLOSEABLE ← T
ACCESS ← ACCESS
FULLFILENAME ← NIL
DEVICE ← DEVICE])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\NULLDEVICE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(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 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (16135 17955 (STREAMPROP 16145 . 16609) (GETSTREAMPROP 16611 . 16844) (PUTSTREAMPROP
16846 . 17811) (STREAMP 17813 . 17953)) (18078 21679 (\GETACCESS 18088 . 18638) (\SETACCESS 18640 .
21677)) (34021 39024 (\DEFINEDEVICE 34031 . 35942) (\GETDEVICEFROMNAME 35944 . 36458) (
\GETDEVICEFROMHOSTNAME 36460 . 37438) (\REMOVEDEVICE 37440 . 38196) (\REMOVEDEVICE.NAMES 38198 . 39022
)) (39025 50481 (\CLOSEFILE 39035 . 39733) (\DELETEFILE 39735 . 40013) (\DEVICEEVENT 40015 . 41050) (
\GENERATEFILES 41052 . 41551) (\GENERATENEXTFILE 41553 . 42210) (\GENERATEFILEINFO 42212 . 42665) (
\GETFILENAME 42667 . 43240) (\GETFILENAME.OR.STREAM 43242 . 44517) (\GENERIC.OUTFILEP 44519 . 45040) (
\OPENFILE 45042 . 46881) (\DO.PARAMS.AT.OPEN 46883 . 47631) (\RENAMEFILE 47633 . 48105) (
\REVALIDATEFILE 48107 . 50072) (\TRUNCATEFILE 50074 . 50479)) (50513 54179 (\GENERATENOFILES 50523 .
51882) (\NULLFILEGENERATOR 51884 . 52170) (\NOFILESNEXTFILEFN 52172 . 53863) (\NOFILESINFOFN 53865 .
54177)) (54297 55927 (\FILE.NOT.OPEN 54307 . 54786) (\FILE.WONT.OPEN 54788 . 55010) (\ILLEGAL.DEVICEOP
55012 . 55234) (\IS.NOT.RANDACCESSP 55236 . 55531) (\STREAM.NOT.OPEN 55533 . 55925)) (56058 58006 (
\FDEVINSTANCE 56068 . 58004)) (58785 62577 (CNDIR 58795 . 59185) (DIRECTORYNAME 59187 . 60645) (
DIRECTORYNAMEP 60647 . 61341) (HOSTNAMEP 61343 . 62096) (\ADD.CONNECTED.DIR 62098 . 62575)) (62620
84024 (\BACKFILEPTR 62630 . 62823) (\BACKPEEKBIN 62825 . 63260) (\BACKBIN 63262 . 63613) (BIN 63615 .
63776) (\BIN 63778 . 64067) (\BINS 64069 . 64416) (BOUT 64418 . 64639) (\BOUT 64641 . 64849) (\BOUTS
64851 . 65238) (COPYBYTES 65240 . 67224) (COPYCHARS 67226 . 70786) (COPYFILE 70788 . 71296) (
\COPYOPENFILE 71298 . 73578) (\INFER.FILE.TYPE 73580 . 74437) (EOFP 74439 . 74821) (FORCEOUTPUT 74823
. 75082) (\FLUSH.OPEN.STREAMS 75084 . 75432) (CHARSET 75434 . 76821) (GETEOFPTR 76823 . 77064) (
GETFILEINFO 77066 . 79452) (\TYPE.FROM.FILETYPE 79454 . 79876) (\FILETYPE.FROM.TYPE 79878 . 80065) (
GETFILEPTR 80067 . 80310) (SETFILEINFO 80312 . 82473) (SETFILEPTR 82475 . 83651) (BOUT16 83653 . 83845
) (BIN16 83847 . 84022)) (84055 86272 (\GENERIC.BINS 84065 . 84404) (\GENERIC.BOUTS 84406 . 84713) (
\GENERIC.RENAMEFILE 84715 . 85197) (\GENERIC.READP 85199 . 86270)) (87014 89153 (\EOF.ACTION 87024 .
87314) (\EOSERROR 87316 . 87497) (\GETEOFPTR 87499 . 87661) (\INCFILEPTR 87663 . 87971) (\PEEKBIN
87973 . 88169) (\SETCLOSEDFILELENGTH 88171 . 88574) (\SETEOFPTR 88576 . 88769) (\SETFILEPTR 88771 .
89151)) (89154 89723 (\FIXPOUT 89164 . 89463) (\FIXPIN 89465 . 89721)) (91744 97582 (\BUFFERED.BIN
91754 . 92391) (\BUFFERED.PEEKBIN 92393 . 92982) (\BUFFERED.BOUT 92984 . 93709) (\BUFFERED.BINS 93711
. 95491) (\BUFFERED.BOUTS 95493 . 96414) (\BUFFERED.COPYBYTES 96416 . 97580)) (97607 99178 (
\NULLDEVICE 97617 . 98931) (\NULL.OPENFILE 98933 . 99176)))))
STOP