(FILECREATED " 9-Jan-84 19:10:33" {PHYLUM}<LISPCORE>SOURCES>FILEIO.;103
 221364Q

      changes to:  (FNS \SETEOF)

      previous date: "21-NOV-83 15:38:05" {PHYLUM}<LISPCORE>SOURCES>FILEIO.;102)


(* Copyright (c) 1981, 1982, 1983, 1984 by Xerox Corporation)

(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 STREAMP)
	      (COMS (* Needed b/c of STREAM initialization)
		    (INITVARS (FILELINELENGTH 146Q)))
	      (FNS \GETACCESS \SETACCESS)
	      (DECLARE: DONTCOPY (EXPORT (MACROS FDEVOP)
					 (RECORDS FDEV FILEGENOBJ)))
	      (INITRECORDS FDEV)
	      (SYSRECORDS FDEV))
	[COMS (* Device operations)
	      (FNS \CLOSEFILE \DEFINEDEVICE \DELETEFILE \DEVICEEVENT \DO.PARAMS.AT.OPEN 
		   \GENERATEFILES \GENERATENEXTFILE \GENERATENOFILES \GETDEVICEFROMNAME \GETFILENAME 
		   \GETFILENAME.OR.STREAM \NOFILESNEXTFILEFN \OPENFILE \READPAGES \REMOVEDEVICE 
		   \REMOVEDEVICE.NAMES \RENAMEFILE \REVALIDATEFILE \TRUNCATEFILE \WRITEPAGES)
	      (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}]
	(COMS (* Directory defaulting)
	      (FNS CNDIR DIRECTORYNAME DIRECTORYNAMEP HOSTNAMEP \ADD.CONNECTED.DIR))
	[COMS (* Binary I/O - Public functions)
	      (FNS \BACKFILEPTR BIN \BACKPEEKBIN \BACKBIN \BIN \BINS BOUT \BOUT \BOUTS COPYBYTES 
		   \SLOWCOPYBYTES COPYFILE \COPYOPENFILE EOFP FLUSHOUTPUT \FLUSH.OPEN.STREAMS 
		   GETEOFPTR GETFILEINFO GETFILEPTR SETFILEINFO SETFILEPTR)
	      (* Generic functions)
	      (FNS \NONPAGEDBINS \NONPAGEDBOUTS \GENERIC.RENAMEFILE \GENERIC.READP)
	      (P (MOVD? (QUOTE FLUSHOUTPUT)
			(QUOTE FLUSHMAP]
	(COMS (* Internal functions)
	      (FNS \EOSERROR \GETEOFPTR \INCFILEPTR \NEWLENGTHIS \PEEKBIN \SETCLOSEDFILELENGTH 
		   \SETEOF \SETEOFPTR \SETFILEPTR \UPDATEOF)
	      (DECLARE: DONTCOPY (EXPORT (MACROS \DECFILEPTR \GETFILEPTR \WIN \WOUT \BINS \BOUTS 
						 \EOFP)
					 (CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ
										  (SYSTEMTYPE)
										  (VAX 12Q)
										  11Q))
						    WordsPerPage)
					 (RECORDS BYTEPTR))
			(CONSTANTS MaxChar)))
	(LOCALVARS . T)
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA 
									      \IS.NOT.RANDACCESSP 
										\ILLEGAL.DEVICEOP])



(* Device independent IO. This file is used by VAX)





(* 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))



(/DECLAREDATATYPE (QUOTE STREAM)
		  (QUOTE (WORD WORD FLAG FLAG FLAG (BITS 5)
			       POINTER
			       (BITS 3)
			       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)
			       (BITS 6)
			       POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
)
[ADDTOVAR SYSTEMRECLST

(DATATYPE STREAM
 ((COFFSET WORD)
		  (CBUFSIZE WORD)
		  (BINABLE FLAG)
		  (BOUTABLE FLAG)
		  (EXTENDABLE FLAG)
		  (NIL BITS 5)
		  (CPPTR POINTER)
		  (NIL BITS 3)
		  (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)
		  (NIL BITS 6)
		  (OUTCHARFN POINTER)
		  (ENDOFSTREAMOP POINTER)
		  (OTHERPROPS POINTER)
		  (IMAGEOPS POINTER)
		  (IMAGEDATA POINTER)
		  (EXTRASTREAMOP POINTER)
		  (STRMBINFN POINTER)
		  (STRMBOUTFN 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 1000Q)

		  (NIL BITS 5)
		  (CPPTR POINTER)                            (* Pointer to current buffer)

		  (NIL BITS 3)
		  (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)

		  (NIL BITS 6)
		  (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)

                                                             (* NOTE: The next quad-word addition to this record 

							     means that 11Q instead of 12Q streams will fit on each 

							     2-page quantum)

		  )
		 (BLOCKRECORD STREAM ((NIL 2 WORD)
			       (UCODEFLAGS BYTE)
			       (NIL POINTER)))
		 [ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
			     (CPDIRTY (ZEROP (fetch
 (STREAM DIRTYBITS) of
 DATUM))
				      (replace
 (STREAM DIRTYBITS) of
 DATUM
					 with
 (if
 NEWVALUE
						  then
 0
						else
 1)))
			     (FULLNAME (OR (fetch
 (STREAM FULLFILENAME) of
 DATUM)
					   DATUM))
			     (NAMEDP (AND (fetch
 (STREAM FULLFILENAME) of
 DATUM)
					  T]
		 USERCLOSEABLE ← T USERVISIBLE ← T ACCESSBITS ← NoBits BUFFS ← NIL BYTESIZE ← 10Q 
		 CPPTR ← NIL DIRTYBITS ← 1 MAXBUFFERS ← 3 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
			       (BITS 3)
			       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)
			       (BITS 6)
			       POINTER POINTER POINTER POINTER POINTER POINTER POINTER 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

(STREAMP

  [LAMBDA (X)                                                (* rmk: "14-OCT-83 14:35")

    (AND (TYPE?
 STREAM X)
	 X])
)



(* Needed b/c of STREAM initialization)



(RPAQ? FILELINELENGTH
 146Q)
(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)                          (* 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)

		(FLUSHOUTPUT POINTER)                        (* (stream) 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)

		)
	       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 \NONPAGEDBINS)
	       BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
	       RENAMEFILE ←(FUNCTION \GENERIC.RENAMEFILE)
	       FLUSHOUTPUT ←(FUNCTION NILL))

(RECORD FILEGENOBJ
 (NEXTFILEFN . GENFILESTATE))
]
(/DECLAREDATATYPE (QUOTE FDEV)
		  (QUOTE (POINTER 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)))


(* END EXPORTED DEFINITIONS)

)
(/DECLAREDATATYPE (QUOTE FDEV)
		  (QUOTE (POINTER 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)))
[ADDTOVAR SYSTEMRECLST

(DATATYPE FDEV
 ((DEVICENAME POINTER)
		(RESETABLE FLAG)
		(RANDOMACCESSP FLAG)
		(NODIRECTORIES FLAG)
		(PAGEMAPPED FLAG)
		(FDBINABLE FLAG)
		(FDBOUTABLE FLAG)
		(FDEXTENDABLE 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)
		(FLUSHOUTPUT POINTER)
		(LASTC POINTER)
		(SETFILEPTR POINTER)
		(GETFILEPTR POINTER)
		(GETEOFPTR POINTER)
		(EOFP POINTER)
		(BLOCKIN POINTER)
		(BLOCKOUT POINTER)
		(RENAMEFILE POINTER)))
]



(* Device operations)


(DEFINEQ

(\CLOSEFILE

  [LAMBDA (STREAM)                                           (* bvm: "12-NOV-83 16:22")

                                                             (* 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)

	(\UPDATEOF
 STREAM)                                   (* If the end of file could have changed, update it)

	))
    (FDEVOP (QUOTE CLOSEFILE)
	    (fetch
 DEVICE of
 STREAM)
	    STREAM)
    (replace
 ACCESS of
 STREAM with
 NIL)                      (* This marks the STREAM as closed)

    STREAM])

(\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])

(\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)                                           (* rmk: "26-MAY-81 22:33")


          (* 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)
			 \FILEDEVICES)
		       (REVERSE \FILEDEVICES))
       do
 (FDEVOP (QUOTE EVENTFN)
		  D D EVENT])

(\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])

(\GENERATEFILES

  [LAMBDA (PATTERN)                                         (* rmk: "18-MAY-81 13:22")


          (* 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])

(\GENERATENEXTFILE

  [LAMBDA (GENOBJ SCRATCHLIST NOVERSION HOST/DIR)           (* rmk: "19-JUL-81 21:35")


          (* 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 NOVERSION, returns the filenames without the semi-colon and version number -

	  Does not pack on the host and directory unless HOST/DIR)



    (APPLY* (fetch
 NEXTFILEFN of
 GENOBJ)
	    (fetch
 GENFILESTATE of
 GENOBJ)
	    SCRATCHLIST NOVERSION HOST/DIR])

(\GENERATENOFILES

  [LAMBDA (FDEV PATTERN)           (* lmm "25-MAY-83 23:05")

                                   (* 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]
          (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)
			      GENFILESTATE ←(COND
				((AND (NULL STAR)
				      (NULL ESC))
				  (CONS (QUOTE NOSTAR)
					PATTERN))
				(T (CONS (QUOTE STAR)
					 (PACKFILENAME (QUOTE VERSION)
						       NIL
						       (QUOTE BODY)
						       PATTERN]
		    (T (create
 FILEGENOBJ
			       NEXTFILEFN ←(FUNCTION NILL])

(\GETDEVICEFROMNAME

  [LAMBDA (NAME NOERROR DONTCREATE)                          (* bvm: "12-SEP-83 14:40")

                                                             (* 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 (LITATOM NAME)
			  [SETQ HOSTNAME (COND
			      ((EQ (NTHCHARCODE NAME 1)
				   (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])

(\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)                                  (* rmk: "21-OCT-83 14:36")

                                                             (* 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))
      [(AND NAME (LITATOM NAME)
	    (NEQ NAME T))
	(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])

(\NOFILESNEXTFILEFN

  [LAMBDA (GENFILESTATE SCRATCHLIST NOVERSION HOST/DIR)     (* rmk: "16-JUL-81 17:53")

    (PROG (FILE)
          [SELECTQ (CAR GENFILESTATE)
		   [NOSTAR (RPLACA GENFILESTATE (QUOTE DONE))
			   (SETQ FILE (INFILEP (CDR GENFILESTATE]
		   (DONE (RETURN NIL))
		   [STAR (SETQ FILE (FULLNAME (CDR GENFILESTATE)
					      (QUOTE OLDEST)))
			 (RPLACA GENFILESTATE (CONS (FILENAMEFIELD FILE (QUOTE VERSION))
						    (FILENAMEFIELD (INFILEP (CDR GENFILESTATE))
								   (QUOTE VERSION]
		   (PROG [(VER (ADD1 (CAAR GENFILESTATE]
		     LP  (COND
			   ((IGREATERP VER (CDAR GENFILESTATE))
			     (RETURN NIL))
			   [[SETQ FILE (INFILEP (PACKFILENAME (QUOTE VERSION)
							      VER
							      (QUOTE BODY)
							      (CDR GENFILESTATE]
			     (RPLACA (CAR GENFILESTATE)
				     (FILENAMEFIELD FILE (QUOTE VERSION]
			   (T (add
 VER 1)
			      (GO LP]
          (RETURN (AND FILE (DCHCON (COND
				      [(NULL HOST/DIR)
					(COND
					  (NOVERSION (NAMEFIELD FILE T))
					  (T (PACKFILENAME (QUOTE NAME)
							   (FILENAMEFIELD FILE (QUOTE NAME))
							   (QUOTE EXTENSION)
							   (FILENAMEFIELD FILE (QUOTE EXTENSION))
							   (QUOTE VERSION)
							   (FILENAMEFIELD FILE (QUOTE VERSION]
				      (NOVERSION (PACKFILENAME (QUOTE VERSION)
							       NIL
							       (QUOTE BODY)
							       FILE))
				      (T FILE)
				      SCRATCHLIST])

(\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])

(\READPAGES

  [LAMBDA (STREAM FIRSTPAGE BUFFERLIST)                      (* bvm: "26-DEC-81 15:44")


          (* Read data from the file specified by open file descriptor OFD, starting with FIRSTPAGE into the buffers given 

	  in BUFFERLIST. If BUFFERLIST is not a list, then it is assumed to be a pointer to a buffer into which a single 

	  page is read.)



    (FDEVOP (QUOTE READPAGES)
	    (fetch
 DEVICE of
 STREAM)
	    STREAM FIRSTPAGE BUFFERLIST])

(\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])

(\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])

(\WRITEPAGES

  [LAMBDA (STREAM FIRSTPAGE BUFFERLIST)                      (* bvm: "26-DEC-81 15:44")


          (* Write data into the file specified by open file descriptor OFD, starting with FIRSTPAGE from the buffers given 

	  in BUFFERLIST. If BUFFERLIST is not a list, then it is assumed to be a pointer to a buffer from which a single 

	  page is written.)



    (\UPDATEOF
 STREAM)                                       (* Make EOF current)

    (FDEVOP (QUOTE WRITEPAGES)
	    (fetch
 DEVICE of
 STREAM)
	    STREAM FIRSTPAGE BUFFERLIST])
)
(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}))



(* Directory defaulting)


(DEFINEQ

(CNDIR

  [LAMBDA (HOST/DIR)                                         (* bvm: "15-SEP-83 15:27")

                                                             (* Connects to HOST/DIR, verifying that HOST/DIR 

							     exists.)

    (DECLARE
 (GLOBALVARS \CONNECTED.HOST \CONNECTED.DIR LOGINHOST/DIR DWIMWAIT USERNAME 
			 \FILEDEVICENAMES))
    [OR HOST/DIR (SETQ HOST/DIR (OR LOGINHOST/DIR (QUOTE {DSK}]
    (SETQ HOST/DIR (U-CASE HOST/DIR))
    (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 (\NATOMCHARS 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 (\NATOMCHARS 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)         (* lmm " 5-MAR-83 16:52")

                                   (* Returns connected directory name)

    (SELECTQ (SYSTEMTYPE)
	     (VAX (GETDIRNAME))
	     [D (DECLARE
 (GLOBALVARS \CONNECTED.DIR \CONNECTED.HOST LOGINHOST/DIR))
		(PROG [(DN (SELECTQ DIRNAME
				    (T 
                                   (* Connected host/dir)

				       (PACK* (QUOTE {)
					      \CONNECTED.HOST
					      (QUOTE })
					      \CONNECTED.DIR))
				    (NIL LOGINHOST/DIR)
				    (PROGN 
                                   (* Should call a device-dependent function to ask if DIRNAME is a valid 

				   host/directory)

					   NIL]
		      (RETURN (COND
				((NULL DN)
				  NIL)
				((STRINGP STRPTR)
				  (SUBSTRING DN 1 -1 STRPTR))
				(STRPTR DN)
				(T (MKSTRING DN]
	     (HELP])

(DIRECTORYNAMEP

  [LAMBDA (DIRNAME HOSTNAME)                                 (* bvm: "12-SEP-83 14:13")


          (* 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])

(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])

(BIN

  [LAMBDA (STREAM)                 (* lmm "20-APR-82 22:00")

                                   (* MERELY EXECUTE OPCODE)

    (\BIN
 STREAM])

(\BACKPEEKBIN

  [LAMBDA (STREAM)                                           (* bvm: "26-DEC-81 16:07")

                                                             (* Returns previous byte on file without changing 

							     fileptr. Returns NIL if we are positioned at the 

							     beginning of the file. Called by LASTC)

    (\UPDATEOF
 STREAM)
    (UNINTERRUPTABLY
        (AND (\BACKFILEPTR
 STREAM)
	     (\BIN
 STREAM)))])

(\BACKBIN

  [LAMBDA (STREAM)                                           (* bvm: "26-DEC-81 15: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.)



    (\UPDATEOF
 STREAM)                                       (* EOF must be updated for \PEEKBIN to work correctly --

							     bas & rrb)

    (AND (\BACKFILEPTR
 STREAM)
	 (\PEEKBIN
 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: "21-OCT-83 14:26")

                                                             (* 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)))
	   EOF ACTUALSTART ACTUALEND)
          [COND
	    ((NOT (fetch
 RANDOMACCESSP of
 (fetch
 DEVICE of
 SRC)))
	      (RETURN (COND
			((NOT END)
			  (\SLOWCOPYBYTES
 SRC DST START))
			(T (ERROR "COPYBYTES: Source file is not random access"
				  (fetch
 FULLFILENAME of
 SRC]
          (SETQ EOF (\GETEOFPTR
 SRC))
          [COND
	    [END (OR (type?
 BYTEPTR (SETQ ACTUALSTART (FIX START)))
		     (LISPERROR "ILLEGAL ARG" START))
		 (\SETFILEPTR
 SRC ACTUALSTART)
		 (SETQ ACTUALEND (COND
		     ((EQ END -1)
		       EOF)
		     (T (IMIN END EOF]
	    (T (SETQ ACTUALSTART (\GETFILEPTR SRC))
	       (SETQ ACTUALEND (COND
		   (START (IMIN (IPLUS START ACTUALSTART)
				EOF))
		   (T EOF]
          (OR (IGEQ ACTUALEND ACTUALSTART)
	      (ERROR "Negative number of bytes to copy" (IDIFFERENCE ACTUALEND ACTUALSTART)))
          (COND
	    [(NOT (fetch
 PAGEMAPPED of
 (fetch
 DEVICE of
 SRC)))
	      (FRPTQ (IDIFFERENCE ACTUALEND ACTUALSTART)
		     (\BOUT
 DST (\BIN
 SRC]
	    (T (\PAGEDCOPYBYTES SRC DST ACTUALSTART ACTUALEND)))
          (RETURN T)                                         (* As specified in VM)

      ])

(\SLOWCOPYBYTES

  [LAMBDA (SSTREAM DSTREAM NBYTES)                           (* bvm: " 3-JUN-83 23:31")


          (* COPYBYTES case where source is not randaccessp. NBYTES is number of bytes to copy, or NIL to copy to EOF.

	  We could be smart if DSTREAM is pagemapped. EOF is awkward to detect; need to rethink this)



    [COND
      [NBYTES (FRPTQ NBYTES (\BOUT
 DSTREAM (\BIN
 SSTREAM]
      (T (until
 (\EOFP SSTREAM) do
 (\BOUT
 DSTREAM (\BIN
 SSTREAM]
    (fetch
 FULLFILENAME of
 DSTREAM])

(COPYFILE

  [LAMBDA (FROMFILE TOFILE)                                  (* bvm: "21-NOV-83 15:23")

    (RESETLST [RESETSAVE (SETQ FROMFILE (OPENSTREAM FROMFILE (QUOTE INPUT)))
			 (QUOTE (PROGN (CLOSEF OLDVALUE]
	      (\COPYOPENFILE
 FROMFILE TOFILE])

(\COPYOPENFILE

  [LAMBDA (INSTREAM NEWNAME)                                 (* bvm: "21-NOV-83 15:27")

    (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
	    ((AND (SETQ TYPE (GETFILEINFO
 INSTREAM (QUOTE TYPE)))
		  (NEQ TYPE (QUOTE ?)))
	      (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]
          (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])

(EOFP

  [LAMBDA (FILE)                                             (* rmk: " 8-NOV-83 18:01")

                                                             (* User entry. T if FILE is at EOF.

							     10 only considers input files, we merely give priority 

							     to them)

    (\EOFP (\GETSTREAM FILE (QUOTE INPUT)
		       T)
	   (\GETSTREAM FILE])

(FLUSHOUTPUT

  [LAMBDA (STREAM)                                           (* bvm: "12-NOV-83 17:00")

    (SETQ STREAM (\GETSTREAM STREAM (QUOTE OUTPUT)))
    (FDEVOP (QUOTE FLUSHOUTPUT)
	    (fetch
 DEVICE of
 STREAM)
	    STREAM])

(\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: "21-OCT-83 13:59")

    (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))
				    (LENGTH (\GETEOFPTR
 STREAM))
				    (SIZE (FOLDHI (\GETEOFPTR
 STREAM)
						  BYTESPERPAGE))
				    (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))
				    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: " 9-NOV-83 21:20")

    (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)
			       [LENGTH (\SETEOFPTR
 STREAM (COND
						     ((type?
 BYTEPTR VALUE)
						       VALUE)
						     (T (\ILLEGAL.ARG VALUE]
			       (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]
			       (FDEVOP (QUOTE SETFILEINFO)
				       (SETQ DEV (fetch
 DEVICE of
 STREAM))
				       STREAM ATTRIB VALUE DEV)))
		    (STREAM                                  (* STREAM is a full filename)

			    (SELECTQ ATTRIB
				     ((ACCESS OPENBYTESIZE EOLCONVENTION)
				       NIL)
				     [LENGTH (\SETCLOSEDFILELENGTH
 STREAM (COND
								     ((type?
 BYTEPTR VALUE)
								       VALUE)
								     (T (\ILLEGAL.ARG VALUE]
				     (FDEVOP (QUOTE SETFILEINFO)
					     (SETQ DEV (\GETDEVICEFROMNAME
 STREAM))
					     STREAM ATTRIB VALUE DEV)))
		    (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

(\NONPAGEDBINS

  [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])

(\NONPAGEDBOUTS

  [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)))])
)
(MOVD? (QUOTE FLUSHOUTPUT)
       (QUOTE FLUSHMAP))



(* Internal functions)


(DEFINEQ

(\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)                                    (* rmk: "22-AUG-83 13:35")

    (COND
      ((NOT (fetch
 PAGEMAPPED of
 (fetch
 DEVICE of
 STREAM)))
	(\ILLEGAL.ARG STREAM))
      (T (UNINTERRUPTABLY
             (PROG ((NEWOFF (IPLUS (fetch
 COFFSET of
 STREAM)
				   AMOUNT))
		    NEWPAGE)                                 (* SETFILEPTR sets CHARPOSITION to zero, but callers of 

							     \INCFILEPTR don't care, by fiat)

	           (COND
		     ((IGEQ NEWOFF BYTESPERPAGE)             (* New page)

		       (SETQ NEWPAGE (IPLUS (fetch
 CPAGE of
 STREAM)
					    (fetch
 (BYTEPTR PAGE) of
 NEWOFF)))
		       (SETQ NEWOFF (fetch
 (BYTEPTR OFFSET) of
 NEWOFF)))
		     [(ILESSP NEWOFF 0)                      (* New page going backward)

		       [SETQ NEWPAGE (IDIFFERENCE (fetch
 CPAGE of
 STREAM)
						  (fetch
 (BYTEPTR PAGE)
						     of
 (SETQ NEWOFF (SUB1 (IDIFFERENCE BYTESPERPAGE 
											NEWOFF]
		       (COND
			 ((ILESSP NEWPAGE 0)                 (* Probably shouldn't happen;

							     should it be an error?)

			   (SETQ NEWPAGE 0)))
		       (SETQ NEWOFF (SUB1 (IDIFFERENCE BYTESPERPAGE (fetch
 (BYTEPTR OFFSET)
								       of
 NEWOFF]
		     (T                                      (* easy case, no page turn)

			(COND
			  ((ILESSP AMOUNT 0)                 (* Backing up, may have to set the eof if we have been 

							     writing)

			    (\UPDATEOF
 STREAM)))
			(replace
 COFFSET of
 STREAM with
 NEWOFF)
			(RETURN)))
	           (\UPDATEOF
 STREAM)
	           (RELEASECPAGE STREAM)
	           (replace
 CBUFSIZE of
 STREAM with
 0)       (* Disable microcode)

	           (replace
 CPAGE of
 STREAM with
 NEWPAGE)
	           (replace
 COFFSET of
 STREAM with
 NEWOFF)))])

(\NEWLENGTHIS

  [LAMBDA (STREAM PGE OFF)                                   (* bvm: "26-DEC-81 15:49")

                                                             (* Computes whether PGE OFF pair is longer or shorter 

							     than the current end of file)

    (\UPDATEOF
 STREAM)                                       (* Before comparing, make it current)

    (PROG ((TMP (IDIFFERENCE (fetch
 EPAGE of
 STREAM)
			     PGE)))
          (RETURN (if
 (ILESSP TMP 0)
		      then
 (QUOTE LONGER)
		    elseif
 (ZEROP TMP)
		      then
 (SETQ TMP (IDIFFERENCE (fetch
 EOFFSET of
 STREAM)
						  OFF))
			   (if
 (ILESSP TMP 0)
			       then
 (QUOTE LONGER)
			     elseif
 (ZEROP TMP)
			       then
 (QUOTE SAME)
			     else
 (QUOTE SHORTER))
		    else
 (QUOTE SHORTER])

(\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])

(\SETEOF

  [LAMBDA (STREAM EP EO)                                     (* bvm: " 9-Jan-84 19:09")

                                                             (* Sets the end of file. If new end of file is on the 

							     current page, resets the character count if necessary.)

    [COND
      ((IGEQ EO BYTESPERPAGE)
	(add
 EP (fetch
 (BYTEPTR PAGE) of
 EO))
	(SETQ EO (fetch
 (BYTEPTR OFFSET) of
 EO]
    (UNINTERRUPTABLY
        (replace
 EPAGE of
 STREAM with
 EP)
	(replace
 EOFFSET of
 STREAM with
 EO)
	(COND
	  ((EQ EP (fetch
 CPAGE of
 STREAM))
	    (replace
 CBUFSIZE of
 STREAM with
 EO))
	  ((ILESSP EP (fetch
 CPAGE of
 STREAM))
	    (RELEASECPAGE STREAM)
	    (replace
 CBUFSIZE of
 STREAM with
 0)              (* Disable microcode)

	    )
	  ((fetch
 CPPTR of
 STREAM)

          (* If there's a page mapped in, it must not be the last page now, so make sure its CBUFSIZE is maximal.

	  Otherwise we lose when EO was 1000Q)



	    (replace
 CBUFSIZE of
 STREAM with
 BYTESPERPAGE)))
	NIL)])

(\SETEOFPTR

  [LAMBDA (STREAM LEN)             (* lmm " 5-MAR-83 16:44")

    (PROG ((NEWEP (fetch
 (BYTEPTR PAGE) of
 LEN))
	   (NEWEO (fetch
 (BYTEPTR OFFSET) of
 LEN)))
          (RETURN (SELECTQ (\NEWLENGTHIS
 STREAM NEWEP NEWEO)
			   (SHORTER (COND
				      ((OVERWRITEABLE STREAM)
					(FORGETPAGES STREAM (ADD1 NEWEP)
						     (PROG1 (fetch
 EPAGE of
 STREAM)
                                   (* Remember the old last page)

							    (\SETEOF
 STREAM NEWEP NEWEO)
                                   (* Shorten the OFD's view of the file)

							    ))

          (* FORGETPAGES tells PMAP to throw away the extra pages. The \SETEOF is done first so that an interrupt will not 

	  leave STREAM pointing to old and possibly partially overwritten pages.)



					(\ZEROBYTES (\MAPPAGE NEWEP STREAM)
						    NEWEO
						    (CONSTANT (SUB1 BYTESPERPAGE)))
                                   (* Zero out the trailing fragment of the last page)

					(\SETIODIRTY STREAM NEWEP)
                                   (* Note that its dirty)

					(\TRUNCATEFILE
 STREAM NEWEP NEWEO)
                                   (* Shorten the real file)

					T)))
			   (SAME 
                                   (* Nothing to do)

				 T)
			   (LONGER (if
 (APPENDABLE STREAM)
				       then
 (\SETEOF
 STREAM NEWEP NEWEO)
					    T))
			   (SHOULDNT])

(\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])

(\UPDATEOF

  [LAMBDA (STREAM)                                           (* bvm: "31-DEC-81 16:55")


          (* The EOF needs updating if we have written past the EOF. We check CPPTR to detect phony file positions from 

	  SETFILEPTR and TURNPAGE that were never actually written thru)



    (AND (fetch
 CPPTR of
 STREAM)
	 (PROGN 

          (* Determines if the current file ptr is BEYOND the end of file. Since page is loaded, we can test against the 

	  CBUFSIZE. As we are ignoring the equal case, we dont need the test for page numbers used by FASTEOF.)



		(IGREATERP (fetch
 COFFSET of
 STREAM)
			   (fetch
 CBUFSIZE of
 STREAM)))
	 (\SETEOF
 STREAM (fetch
 CPAGE of
 STREAM)
		  (fetch
 COFFSET of
 STREAM])
)
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

(PUTPROPS \DECFILEPTR MACRO
 ((STREAM X)
			     (\INCFILEPTR STREAM (IMINUS X))))

(PUTPROPS \GETFILEPTR MACRO
 [OPENLAMBDA (STRM)
					(COND
					  ((fetch
 (FDEV PAGEMAPPED) of
 (fetch
 (STREAM DEVICE)
									  of
 STRM))
					    (create
 BYTEPTR
						    PAGE ←(fetch
 CPAGE of
 STRM)
						    OFFSET ←(fetch
 COFFSET of
 STRM)))
					  (T (FDEVOP (QUOTE GETFILEPTR)
						     (fetch
 DEVICE of
 STRM)
						     STRM])

(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
 10Q)

(RPAQ ByteOffsetSize
 (SELECTQ (SYSTEMTYPE)
			      (VAX 12Q)
			      11Q))

(RPAQQ WordsPerPage
 400Q)

(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE)
						(VAX 12Q)
						11Q))
	   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
 377Q)

(CONSTANTS MaxChar)
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP)
)
(PUTPROPS FILEIO COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q 3700Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (26277Q 26527Q (STREAMP 26311Q . 26525Q)) (26651Q 35672Q (\GETACCESS 26663Q . 27731Q) (
\SETACCESS 27733Q . 35670Q)) (52560Q 116206Q (\CLOSEFILE 52572Q . 54247Q) (\DEFINEDEVICE 54251Q . 
60040Q) (\DELETEFILE 60042Q . 60470Q) (\DEVICEEVENT 60472Q . 61755Q) (\DO.PARAMS.AT.OPEN 61757Q . 
63200Q) (\GENERATEFILES 63202Q . 64140Q) (\GENERATENEXTFILE 64142Q . 65544Q) (\GENERATENOFILES 65546Q
 . 67753Q) (\GETDEVICEFROMNAME 67755Q . 73007Q) (\GETFILENAME 73011Q . 74106Q) (\GETFILENAME.OR.STREAM
 74110Q . 75452Q) (\NOFILESNEXTFILEFN 75454Q . 100246Q) (\OPENFILE 100250Q . 103727Q) (\READPAGES 
103731Q . 104673Q) (\REMOVEDEVICE 104675Q . 106261Q) (\REMOVEDEVICE.NAMES 106263Q . 107440Q) (
\RENAMEFILE 107442Q . 110372Q) (\REVALIDATEFILE 110374Q . 114251Q) (\TRUNCATEFILE 114253Q . 115100Q) (
\WRITEPAGES 115102Q . 116204Q)) (116207Q 121345Q (\FILE.NOT.OPEN 116221Q . 117160Q) (\FILE.WONT.OPEN 
117162Q . 117520Q) (\ILLEGAL.DEVICEOP 117522Q . 120060Q) (\IS.NOT.RANDACCESSP 120062Q . 120531Q) (
\STREAM.NOT.OPEN 120533Q . 121343Q)) (121550Q 125406Q (\FDEVINSTANCE 121562Q . 125404Q)) (126576Q 
143102Q (CNDIR 126610Q . 135165Q) (DIRECTORYNAME 135167Q . 136711Q) (DIRECTORYNAMEP 136713Q . 140037Q)
 (HOSTNAMEP 140041Q . 141422Q) (\ADD.CONNECTED.DIR 141424Q . 143100Q)) (143155Q 172625Q (\BACKFILEPTR 
143167Q . 143470Q) (BIN 143472Q . 143733Q) (\BACKPEEKBIN 143735Q . 144653Q) (\BACKBIN 144655Q . 
145645Q) (\BIN 145647Q . 146310Q) (\BINS 146312Q . 147045Q) (BOUT 147047Q . 147404Q) (\BOUT 147406Q . 
147726Q) (\BOUTS 147730Q . 150533Q) (COPYBYTES 150535Q . 153553Q) (\SLOWCOPYBYTES 153555Q . 154607Q) (
COPYFILE 154611Q . 155217Q) (\COPYOPENFILE 155221Q . 160121Q) (EOFP 160123Q . 160713Q) (FLUSHOUTPUT 
160715Q . 161302Q) (\FLUSH.OPEN.STREAMS 161304Q . 162025Q) (GETEOFPTR 162027Q . 162410Q) (GETFILEINFO 
162412Q . 165736Q) (GETFILEPTR 165740Q . 166323Q) (SETFILEINFO 166325Q . 171567Q) (SETFILEPTR 171571Q
 . 172623Q)) (172664Q 176254Q (\NONPAGEDBINS 172676Q . 173421Q) (\NONPAGEDBOUTS 173423Q . 174106Q) (
\GENERIC.RENAMEFILE 174110Q . 174655Q) (\GENERIC.READP 174657Q . 176252Q)) (176400Q 214736Q (\EOSERROR
 176412Q . 176677Q) (\GETEOFPTR 176701Q . 177143Q) (\INCFILEPTR 177145Q . 202702Q) (\NEWLENGTHIS 
202704Q . 204414Q) (\PEEKBIN 204416Q . 204722Q) (\SETCLOSEDFILELENGTH 204724Q . 205547Q) (\SETEOF 
205551Q . 207704Q) (\SETEOFPTR 207706Q . 212524Q) (\SETFILEPTR 212526Q . 213322Q) (\UPDATEOF 213324Q
 . 214734Q)))))
STOP