(FILECREATED "25-JUL-83 02:48:13" {PHYLUM}<LISPCORE>DIG>FILEIO.;3
 86088  

      changes to:  (RECORDS FDEV)

      previous date: "22-JUL-83 08:58:48" {PHYLUM}<LISPCORE>DIG>FILEIO.;2)


(* Copyright (c) 1981, 1982, 1983 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)))
	      (FNS PPSTREAM)
	      (COMS (* Needed b/c of STREAM initialization)
		    (INITVARS (FILELINELENGTH 102)))
	      (FNS \GETACCESS \SETACCESS)
	      (DECLARE: DONTCOPY (EXPORT (MACROS FDEVOP)
					 (RECORDS FDEV FILEGENOBJ)))
	      (INITRECORDS FDEV)
	      (SYSRECORDS FDEV))
	(COMS (* Device operations)
	      (FNS \CLOSEFILE \DEFINEDEVICE \DELETEFILE \DEVICEEVENT \GENERATEFILES \GENERATENOFILES 
		   \NOFILESNEXTFILEFN \GENERATENEXTFILE \GETDEVICEFROMNAME \GETFILENAME 
		   \GETFILENAME.OR.STREAM \OPENFILE \READPAGES \RENAMEFILE \REVALIDATEFILE 
		   \TRUNCATEFILE \WRITEPAGES \ILLEGAL.DEVICEOP)
	      (ADDVARS (\FILEDEVICES)
		       (\FILEDEVICENAMES)
		       (\DEVICENAMETODEVICE))
	      (COMS (* Device instances)
		    (FNS \FDEVINSTANCE)
		    (MACROS \INHERITFDEVOP.D \INHERITFDEVOP.S))
	      (INITVARS (LOGINHOST/DIR (QUOTE {DSK})))
	      (GLOBALVARS \OPENFILES))
	(COMS (* Directory defaulting)
	      (FNS CNDIR DIRECTORYNAME DIRECTORYNAMEP HOSTNAMEP \ADD.CONNECTED.DIR))
	(COMS (* Binary I/O - Public functions)
	      (FNS \BACKFILEPTR BIN \BACKPEEKBIN \BACKBIN \BIN \BINS \NONPAGEDBINS BOUT \BOUT \BOUTS 
		   \NONPAGEDBOUTS COPYBYTES \SLOWCOPYBYTES COPYFILE \COPYOPENFILE \GENERIC.RENAMEFILE 
		   \GENERIC.READP EOFP GETEOFPTR GETFILEINFO GETFILEPTR SETFILEINFO SETFILEPTR))
	(COMS (* Internal functions)
	      (FNS \EOSERROR \GETEOFPTR \INCFILEPTR \NEWLENGTHIS \PEEKBIN \SETCLOSEDFILELENGTH 
		   \SETEOF \SETEOFPTR \SETFILEPTR \UPDATEOF)
	      (DECLARE: DONTCOPY (RECORDS CHAR)
			(MACROS GETPAGEBASE RELEASECPAGE)
			(EXPORT (MACROS \DECFILEPTR \GETFILEPTR \WIN \WOUT \BINS \BOUTS \EOFP)
				(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE)
										(VAX 10)
										9))
					   WordsPerPage)
				(RECORDS BYTEPTR))
			(CONSTANTS MaxChar)))
	(COMS (* Functions for page-mapped devices)
	      (FNS \GETPAGEBASE \PAGEDBACKFILEPTR \PAGEDBIN \PAGEDSETFILEPTR \PAGEDGETFILEPTR 
		   \PAGEDGETEOFPTR \PAGEDREADP \PAGEDEOFP \PAGEDBINS \PAGEDBOUT \PAGEDBOUTS 
		   \PAGEDPEEKBIN \TURNPAGE))
	(LOCALVARS . T)
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA \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 POINTER 
			       POINTER POINTER POINTER POINTER POINTER)))
)
[ADDTOVAR SYSTEMRECLST

(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)
		  (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)
		  (XPOSITION WORD)
		  (DIRTYBITS WORD)
		  (LINELENGTH WORD)
		  (OUTCHARFN POINTER)
		  (ENDOFSTREAMOP POINTER)                    (* For use of applications programs, not devices)

		  (USERFIELD POINTER)
		  (IMAGEOPS POINTER)                         (* Image operations vector)

		  (IMAGEDATA POINTER)                        (* Image instance variables--format depends on IMAGEOPS 

							     value)

		  (EXTRASTREAMOP POINTER))
		 (BLOCKRECORD STREAM ((NIL 2 WORD)
			       (UCODEFLAGS BYTE)
			       (NIL POINTER)))
		 (ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
			     (CPDIRTY (ZEROP (fetch
 DIRTYBITS of
 DATUM))
				      (replace
 DIRTYBITS of
 DATUM
					 with
 (if
 NEWVALUE
						  then
 0
						else
 1)))
			     (FULLNAME (OR (fetch
 FULLFILENAME of
 DATUM)
					   DATUM))
			     (NAMEDP (AND (fetch
 FULLFILENAME of
 DATUM)
					  T))))
		 USERCLOSEABLE ← T USERVISIBLE ← T ACCESSBITS ← NoBits BUFFS ← NIL BYTESIZE ← 8 CPPTR 
		 ← NIL DIRTYBITS ← 1 MAXBUFFERS ← 3 XPOSITION ← 0 LINELENGTH ←(PROGN
		   (DECLARE
 (GLOBALVARS FILELINELENGTH))
		   FILELINELENGTH)
		 OUTCHARFN ←(FUNCTION \FILEOUTCHARFN)
		 ENDOFSTREAMOP ←(FUNCTION \EOSERROR)
		 IMAGEOPS ← \NOIMAGEOPS)
]
(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)
		  (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)
		  (XPOSITION WORD)
		  (DIRTYBITS WORD)
		  (LINELENGTH WORD)
		  (OUTCHARFN POINTER)
		  (ENDOFSTREAMOP POINTER)                    (* For use of applications programs, not devices)

		  (USERFIELD POINTER)
		  (IMAGEOPS POINTER)                         (* Image operations vector)

		  (IMAGEDATA POINTER)                        (* Image instance variables--format depends on IMAGEOPS 

							     value)

		  (EXTRASTREAMOP POINTER))
		 (BLOCKRECORD STREAM ((NIL 2 WORD)
			       (UCODEFLAGS BYTE)
			       (NIL POINTER)))
		 (ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
			     (CPDIRTY (ZEROP (fetch
 DIRTYBITS of
 DATUM))
				      (replace
 DIRTYBITS of
 DATUM
					 with
 (if
 NEWVALUE
						  then
 0
						else
 1)))
			     (FULLNAME (OR (fetch
 FULLFILENAME of
 DATUM)
					   DATUM))
			     (NAMEDP (AND (fetch
 FULLFILENAME of
 DATUM)
					  T))))
		 USERCLOSEABLE ← T USERVISIBLE ← T ACCESSBITS ← NoBits BUFFS ← NIL BYTESIZE ← 8 CPPTR 
		 ← NIL DIRTYBITS ← 1 MAXBUFFERS ← 3 XPOSITION ← 0 LINELENGTH ←(PROGN
		   (DECLARE
 (GLOBALVARS FILELINELENGTH))
		   FILELINELENGTH)
		 OUTCHARFN ←(FUNCTION \FILEOUTCHARFN)
		 ENDOFSTREAMOP ←(FUNCTION \EOSERROR)
		 IMAGEOPS ← \NOIMAGEOPS)
]
(/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 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)))))
)


(* END EXPORTED DEFINITIONS)

)
(DEFINEQ

(PPSTREAM

  [LAMBDA (STREAM)                                           (* bvm: " 2-JAN-82 17:16")

    [DECLARE
 (PUTPROPS .MAYBEP. MACRO ((X NUL)
			(AND (NEQ (fetch
 X of
 STREAM)
				  NUL)
			     (printout
 T .TAB LM (QUOTE X)
				       ":  "
				       (fetch
 X of
 STREAM]
    [PROG [(LM (IPLUS 2 (POSITION]
          (OR (type?
 STREAM STREAM)
	      (SETQ STREAM (\GETOFD STREAM)))
          (printout
 T STREAM)
          (printout
 T .TAB LM "File name:   " (fetch
 FULLFILENAME of
 STREAM)
		    .TAB LM "File device: " (fetch
 DEVICENAME of
 (fetch
 DEVICE of
 STREAM))
		    .TAB LM "Validation:  " (fetch
 VALIDATION of
 STREAM)
		    .TAB LM "EPAGE:  " (fetch
 EPAGE of
 STREAM)
		    .TAB LM "EOFFS:  " (fetch
 EOFFSET of
 STREAM)
		    T)
          (.MAYBEP. F1)
          (.MAYBEP. F2)
          (.MAYBEP. F3)
          (.MAYBEP. F4)
          (.MAYBEP. F5)
          (.MAYBEP. FW6 0)
          (.MAYBEP. FW7 0)
          (printout
 T .TAB LM "Access: " (fetch
 ACCESS of
 STREAM)
		    .TAB LM "uCode flags: ")
          [COND
	    ((ZEROP (fetch
 UCODEFLAGS of
 STREAM))
	      (PRIN1 "none" T))
	    (T (COND
		 ((fetch
 BINABLE of
 STREAM)
		   (PRIN1 "Bin " T)))
	       (COND
		 ((fetch
 BOUTABLE of
 STREAM)
		   (PRIN1 "Bout " T)))
	       (COND
		 ((fetch
 EXTENDABLE of
 STREAM)
		   (PRIN1 "Extend" T]
          (printout
 T .TAB LM "BSize:  " (fetch
 BYTESIZE of
 STREAM)
		    .TAB LM "CPAGE:  " (fetch
 CPAGE of
 STREAM)
		    .TAB LM "COFFS:  " (fetch
 COFFSET of
 STREAM)
		    .TAB LM "Buffer size: " (fetch
 CBUFSIZE of
 STREAM)
		    .TAB LM "Dirty?: " (fetch
 CPDIRTY of
 STREAM))
          (.MAYBEP. CPPTR)
          (COND
	    ((fetch
 BUFFS of
 STREAM)
	      (printout
 T .TAB LM "Buffers:    ")
	      (PPBUFS (fetch
 BUFFS of
 STREAM)))
	    (T (TERPRI T]
    STREAM])
)



(* Needed b/c of STREAM initialization)



(RPAQ? FILELINELENGTH
 102)
(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)                                    (* bvm: "26-DEC-81 15:44")

    (replace
 ACCESSBITS of
 STREAM with
 (SELECTQ ACCESS
						(NIL NoBits)
						(INPUT ReadBit)
						(APPEND AppendBit)
						(OUTPUT OutputBits)
						(BOTH BothBits)
						(SHOULDNT)))
    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)

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

		(EOLCONVENTION POINTER)
		(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 \ILLEGAL.DEVICEOP)
	       GETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
	       GETEOFPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
	       EOFP ←(FUNCTION \ILLEGAL.DEVICEOP)
	       BLOCKIN ←(FUNCTION \NONPAGEDBINS)
	       BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
	       RENAMEFILE ←(FUNCTION \GENERIC.RENAMEFILE))

(RECORD FILEGENOBJ
 (NEXTFILEFN . GENFILESTATE))
]
(/DECLAREDATATYPE (QUOTE FDEV)
		  (QUOTE (POINTER 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 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)                            (* True if i/o handled by pmap routines)

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

		(EOLCONVENTION POINTER)
		(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 \ILLEGAL.DEVICEOP)
	       GETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
	       GETEOFPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
	       EOFP ←(FUNCTION \ILLEGAL.DEVICEOP)
	       BLOCKIN ←(FUNCTION \NONPAGEDBINS)
	       BLOCKOUT ←(FUNCTION \NONPAGEDBOUTS)
	       RENAMEFILE ←(FUNCTION \GENERIC.RENAMEFILE))
]



(* Device operations)


(DEFINEQ

(\CLOSEFILE

  [LAMBDA (STREAM)                                          (* rmk: "15-JUL-83 07:20")

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

	))
    (RELEASECPAGE STREAM)                                   (* Let the current page go)

    (\CLEARMAP STREAM)

          (* This must be done after sysout's if the file is no longer open. We must also clear it from the list of openfiles 

	  then too.)



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

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

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

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

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

(\GETDEVICEFROMNAME

  [LAMBDA (NAME NOERROR)                                     (* bvm: " 6-APR-83 12:39")

                                                             (* 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 (CHCON1 NAME)
				   (CHARCODE {))
				(SUBATOM NAME 2 (IDIFFERENCE (OR (STRPOS (QUOTE })
									 NAME NIL NIL NIL T)
								 2)
							     2)))
			      (T (SELECTQ (SYSTEMTYPE)
					  (VAX (QUOTE DSK))
					  NAME]
			  (OR (CDR (FASSOC HOSTNAME \DEVICENAMETODEVICE))
			      (CDR (FASSOC (SETQ HOSTNAME (U-CASE HOSTNAME))
					   \DEVICENAMETODEVICE))
			      (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)                                  (* bvm: " 5-JAN-82 13:44")

                                                             (* Expands NAME according to recog, returning either the

							     full NAME or NIL.)

    (SETQ NAME (\ADD.CONNECTED.DIR
 NAME))
    (OR (for
 STRM in
 \OPENFILES when
 (EQ NAME (fetch
 FULLFILENAME of
 STRM)) do
 
                                                             (* If this names an open file, must be okay)

									       (RETURN NAME))
	(AND (OR FDEV (SETQ FDEV (\GETDEVICEFROMNAME
 NAME T)))
	     (FDEVOP (QUOTE GETFILENAME)
		     FDEV NAME RECOG FDEV])

(\GETFILENAME.OR.STREAM

  [LAMBDA (NAME RECOG FDEV)                                 (* rmk: "14-JUN-82 10:50")

                                                            (* 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
	  ((for
 STRM in
 \OPENFILES when
 (EQ NAME (fetch
 FULLFILENAME of
 STRM)) do
 
                                                            (* Full name matches open file)

										  (RETURN STRM)))
	  ((SETQ NAME (AND (OR FDEV (SETQ FDEV (\GETDEVICEFROMNAME
 NAME T)))
			   (FDEVOP (QUOTE GETFILENAME)
				   FDEV NAME RECOG FDEV)))
	    (OR (for
 STRM in
 \OPENFILES when
 (EQ NAME (fetch
 FULLFILENAME of
 STRM))
		   do
                                       (* Works this time with full filename)

		      (RETURN STRM))
		NAME]
      (T (\GETOFD NAME NIL T])

(\OPENFILE

  [LAMBDA (NAME ACCESS RECOG OTHERINFO)                     (* rmk: "29-MAY-82 22:32")


          (* Opens the file identified by NAME possibly expanded according to RECOG. Returns an open file descriptor for the 

	  file. ACCESS is assumed to be one of INPUT, OUTPUT, BOTH, or APPEND.)



    (PROG (FDEV CDNAME STREAM)
      RETRY
          [SETQ FDEV (COND
	      ((type?
 STREAM NAME)
		(SETQ CDNAME NAME)
		(fetch
 DEVICE of
 NAME))
	      (T (\GETDEVICEFROMNAME
 (SETQ CDNAME (\ADD.CONNECTED.DIR
 NAME]
                                                            (* 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 OTHERINFO FDEV)))
	    (T (SETQ NAME (LISPERROR "FILE NOT FOUND" NAME))
	       (GO RETRY)))
          (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)))
          (COND
	    ((fetch
 PAGEMAPPED of
 FDEV)
	      (SELECTQ ACCESS
		       (INPUT (replace
 BINABLE of
 STREAM with
 T))
		       (OUTPUT (replace
 BOUTABLE of
 STREAM with
 (replace
 EXTENDABLE of
 STREAM
								   with
 T)))
		       [BOTH (replace
 BINABLE of
 STREAM
				with
 (replace
 BOUTABLE of
 STREAM
					with
 (replace
 EXTENDABLE of
 STREAM with
 T]
		       NIL)
	      (replace
 CBUFSIZE of
 STREAM with
 0)           (* This has to be zero until CPPTR gets set)

	      ))
          (RETURN STREAM])

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

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

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

(ADDTOVAR \FILEDEVICES
 )

(ADDTOVAR \FILEDEVICENAMES
 )

(ADDTOVAR \DEVICENAMETODEVICE
 )



(* Device instances)


(DEFINEQ

(\FDEVINSTANCE

  [LAMBDA (FDEV)                                             (* bvm: "25-MAY-83 12:29")


          (* 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])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS \INHERITFDEVOP.D MACRO 
(X
  (SUBPAIR (QUOTE (NEWARGS OPNAME . ARGS))
	   (CONS (SUBST (QUOTE (fetch DEVICEINFO of FDEV))
			(QUOTE FDEV)
			(CDR X))
		 X)
	   (QUOTE (FUNCTION (LAMBDA ARGS
			      (FDEVOP (QUOTE OPNAME)
				      (fetch
 DEVICEINFO of
 FDEV) . NEWARGS)))))))

(PUTPROPS \INHERITFDEVOP.S MACRO 
((OPNAME . ARGS)
  (FUNCTION (LAMBDA ARGS
      (FDEVOP (QUOTE OPNAME)
	      (fetch
 DEVICEINFO of
 (fetch
 DEVICE of
 STREAM)) . ARGS)))))
)

(RPAQ? LOGINHOST/DIR
 (QUOTE {DSK}))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \OPENFILES)
)



(* Directory defaulting)


(DEFINEQ

(CNDIR

  [LAMBDA (HOST/DIR)               (* lmm "28-MAY-83 11:25")

                                   (* 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 (NEWDIR FDEV TEMP (NEWHOST \CONNECTED.HOST)
		  (REST HOST/DIR))
          [COND
	    ((EQ (CHCON1 HOST/DIR)
		 (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 NEWDIR (COND
	      [(NULL REST)
		(COND
		  ((fetch
 NODIRECTORIES of
 FDEV)
                                   (* Device does not support directories--e.g.

				   DSK)

		    "")
		  (T (PACK* (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 >)

		     (PACK* REST (QUOTE >]
	      ((EQ (NTHCHARCODE REST -1)
		   (CHARCODE >))
		(PACK* (QUOTE <)
		       REST))
	      (T (PACK* (QUOTE <)
			REST
			(QUOTE >]
          (SETQ TEMP (PACK* (QUOTE {)
			    NEWHOST
			    (QUOTE })
			    NEWDIR))
          (COND
	    ((FDEVOP (QUOTE DIRECTORYNAMEP)
		     FDEV TEMP)
	      [COND
		((EQ (fetch
 DEVICENAME of
 FDEV)
		     (QUOTE LEAF))
                                   (* Canonicalize name in case of multiple names for same host.

				   Should be better interface for this)

		  (COND
		    ((NEQ NEWHOST (SETQ NEWHOST (\CANONICAL.HOSTNAME NEWHOST)))
		      (SETQ TEMP (PACK* (QUOTE {)
					NEWHOST
					(QUOTE })
					NEWDIR]
	      (UNINTERRUPTABLY
                  (SETQ \CONNECTED.HOST NEWHOST)
                                   (* Don't smash globals until new setting has been verified.)

		  (SETQ \CONNECTED.DIR NEWDIR))
	      (RETURN TEMP))
	    (T                     (* To reduce confusion, include host name in error message, in case it was 

				   defaulted)

	       (ERROR "Non-existent directory" TEMP])

(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)                                (* rmk: "12-NOV-81 16:41")


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

(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)                                           (* lmm " 7-JUL-83 10:09")

                                                             (* UFN FOR BIN OPCODE)

    (FDEVOP (QUOTE BIN)
	    [ffetch
 DEVICE of
 (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])

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

(BOUT

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

                                   (* MERELY EXECUTE OPCODE)

    (\BOUT
 STREAM CHAR])

(\BOUT

  [LAMBDA (STREAM BYTE)                                      (* bvm: "29-APR-82 18:25")

    (FDEVOP (QUOTE BOUT)
	    [ffetch
 DEVICE of
 (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])

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

(COPYBYTES

  [LAMBDA (SRCFIL DSTFIL START END)                          (* rrb "21-JUL-83 07:32")

                                                             (* Copies bytes from START up to but not including END 

							     from SRCFIL into DSTFIL.)

    (PROG ((SRC (\GETOFD SRCFIL (QUOTE INPUT)))
	   (DST (\GETOFD 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 (bind
 (STARTPAGE ←(fetch
 CPAGE of
 SRC))
		     (STARTOFFSET ←(fetch
 COFFSET of
 SRC))
		     (ENDPAGE ←(fetch
 (BYTEPTR PAGE) of
 ACTUALEND))
		     (ENDOFFSET ←(fetch
 (BYTEPTR OFFSET) of
 ACTUALEND))
		  do
 (COND
		       ((NEQ STARTPAGE ENDPAGE)
			 (\BOUTS
 DST (GETPAGEBASE SRC (QUOTE READ))
				 STARTOFFSET
				 (IDIFFERENCE BYTESPERPAGE STARTOFFSET))
                                                             (* Copy thru to end of source page)

			 (add
 STARTPAGE 1)
			 (SETQ STARTOFFSET 0)
			 (\TURNPAGE
 SRC (QUOTE READ)))
		       (T (COND
			    ((IGREATERP ENDOFFSET STARTOFFSET)
			      (\BOUTS
 DST (GETPAGEBASE SRC (QUOTE READ))
				      STARTOFFSET
				      (IDIFFERENCE ENDOFFSET STARTOFFSET))
                                                             (* Copy part of a page)

			      (replace
 COFFSET of
 SRC with
 ENDOFFSET)
                                                             (* Update current pointer)

			      ))
			  (RETURN]
          (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: " 4-JUN-83 22:26")

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

(\COPYOPENFILE

  [LAMBDA (INSTREAM NEWNAME)                                 (* bvm: " 4-JUN-83 22:29")

    (PROG (X PROPS)
          [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 X (GETFILEINFO
 INSTREAM (QUOTE TYPE)))
		  (NEQ X (QUOTE ?)))
	      (push
 PROPS (LIST (QUOTE TYPE)
				X))
	      (COND
		([AND (EQ X (QUOTE TEXT))
		      (SETQ X (GETFILEINFO
 INSTREAM (QUOTE EOLCONVENTION]
		  (push
 PROPS (LIST (QUOTE EOLCONVENTION)
				    X]
          [RESETSAVE (SETQ NEWNAME (OPENFILE NEWNAME (QUOTE OUTPUT)
					     (QUOTE NEW)
					     NIL
					     (CONS (QUOTE SEQUENTIAL)
						   PROPS)))
		     (QUOTE (AND RESETSTATE (DELFILE (CLOSEF OLDVALUE]
          (COPYBYTES
 INSTREAM NEWNAME)
          (RETURN (CLOSEF NEWNAME])

(\GENERIC.RENAMEFILE

  [LAMBDA (OLDFILE NEWFILE)                                  (* bvm: " 4-JUN-83 22:28")

    (RESETLST [RESETSAVE (SETQ OLDFILE (OPENFILE 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)))])

(EOFP

  [LAMBDA (FILE)                                            (* rmk: " 6-JUL-82 10:00")

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

							    following the 10, we only consider input files.)

    (\EOFP (\GETOFD FILE (QUOTE INPUT])

(GETEOFPTR

  [LAMBDA (FILE)                   (* lmm "25-MAY-83 23:15")

    (PROG ((STREAM (\GETOFD FILE)))
          (RETURN (FDEVOP (QUOTE GETEOFPTR)
			  (fetch
 DEVICE of
 STREAM)
			  STREAM])

(GETFILEINFO

  [LAMBDA (FILE ATTRIB)                                      (* bvm: " 5-JUN-83 00:23")

    (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))
				    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)                   (* lmm "25-MAY-83 23:16")

    (PROG ((STREAM (\GETOFD FILE)))
          (RETURN (FDEVOP (QUOTE GETFILEPTR)
			  (fetch
 DEVICE of
 STREAM)
			  STREAM])

(SETFILEINFO

  [LAMBDA (FILE ATTRIB VALUE)                                (* bvm: " 5-JAN-82 14:03")

    (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 OFD.)

		      (SELECTQ ATTRIB
			       ((ACCESS BYTESIZE OPENBYTESIZE)
                                                             (* These cant be changed for an open file)

				 NIL)
			       [LENGTH (\SETEOFPTR
 STREAM (COND
						     ((type?
 BYTEPTR VALUE)
						       VALUE)
						     (T (LISPERROR "ILLEGAL ARG" VALUE]
			       (FDEVOP (QUOTE SETFILEINFO)
				       (SETQ DEV (fetch
 DEVICE of
 STREAM))
				       STREAM ATTRIB VALUE DEV)))
		    (STREAM                                  (* STREAM is a full filename)

			    (SELECTQ ATTRIB
				     ((ACCESS OPENBYTESIZE)
				       NIL)
				     [LENGTH (\SETCLOSEDFILELENGTH
 STREAM (COND
								     ((type?
 BYTEPTR VALUE)
								       VALUE)
								     (T (LISPERROR "ILLEGAL ARG" 
										   VALUE]
				     (FDEVOP (QUOTE SETFILEINFO)
					     (SETQ DEV (\GETDEVICEFROMNAME
 STREAM))
					     STREAM ATTRIB VALUE DEV)))
		    (T (LISPERROR "FILE NOT FOUND" FILE])

(SETFILEPTR

  [LAMBDA (FILE ADR)               (* lmm "25-MAY-83 23:16")

    (PROG ((STREAM (\GETOFD 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
 XPOSITION of
 STREAM with
 0)
          (RETURN ADR)             (* Not coerced!)

      ])
)



(* 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)          (* lmm " 5-MAR-83 16:44")

    (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 XPOSITION 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: "31-DEC-81 19:55")

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

	    ))
	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)            (* lmm "25-MAY-83 23:18")


          (* Fast case of SETFILEPTR, assumes STREAM is a stream and INDX is an already coerced fileptr 

	  (not -1) Does not reset XPOSITION 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 
[DECLARE: EVAL@COMPILE 

(RECORD CHAR
 NIL (TYPE?
 (AND (IGEQ DATUM 0)
			     (ILEQ DATUM (CONSTANT MaxChar)))))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS GETPAGEBASE MACRO 
((STREAM PURPOSE)
  (PROG1 (OR (fetch
 CPPTR of
 STREAM)
	     (\GETPAGEBASE STREAM PURPOSE))
	 (AND (EQ PURPOSE (QUOTE WRITE))
	      (replace
 CPDIRTY of
 STREAM with
 T)))))

(PUTPROPS RELEASECPAGE MACRO 
((STREAM)
  (PROGN (COND
	   ((fetch
 CPDIRTY of
 STREAM)
	     (\SETIODIRTY STREAM (fetch
 CPAGE of
 STREAM))
	     (replace
 CPDIRTY of
 STREAM with
 NIL)))
	 (replace
 CPPTR of
 STREAM with
 NIL))))
)

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

(RPAQ ByteOffsetSize
 (SELECTQ (SYSTEMTYPE)
			      (VAX 10)
			      9))

(RPAQQ WordsPerPage
 256)

(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE)
						(VAX 10)
						9))
	   WordsPerPage)
)
[DECLARE: EVAL@COMPILE 

(ACCESSFNS BYTEPTR
 ((PAGE (FOLDLO DATUM BYTESPERPAGE))
		    (OFFSET (MOD DATUM BYTESPERPAGE)))
		   (TYPE?
 (AND (FIXP DATUM)
			       (IGEQ DATUM 0)))
		   (CREATE
 (IPLUS (UNFOLD PAGE BYTESPERPAGE)
				  OFFSET)))
]


(* END EXPORTED DEFINITIONS)


(DECLARE: EVAL@COMPILE 

(RPAQQ MaxChar
 255)

(CONSTANTS MaxChar)
)
)



(* Functions for page-mapped devices)


(DEFINEQ

(\GETPAGEBASE

  [LAMBDA (STREAM WHATFOR)                                   (* bvm: "31-DEC-81 18:04")

                                                             (* Obtains page for current position.

							     Takes this opportunity to check access)

    (PROG (BUF)
          [OR (SELECTQ WHATFOR
		       (READ (READABLE STREAM))
		       (WRITE (WRITEABLE STREAM))
		       (SHOULDNT))
	      (COND
		((OPENED STREAM)
		  (LISPERROR "PROTECTION VIOLATION" (fetch
 FULLNAME of
 STREAM)))
		(T (LISPERROR "FILE NOT OPEN" (fetch
 FULLNAME of
 STREAM]
                                                             (* First, set Last Char of Current Page)

          (SETQ BUF (\MAPPAGE (fetch
 CPAGE of
 STREAM)
			      STREAM))                       (* This is interruptable)

          (UNINTERRUPTABLY                                   (* But these two fields must be set uninterruptably for 

							     benefit of ucode & \UPDATEOF)

	      (replace
 CBUFSIZE of
 STREAM with
 (COND
						 ((IGREATERP (fetch
 EPAGE of
 STREAM)
							     (fetch
 CPAGE of
 STREAM))
                                                             (* Full page)

						   BYTESPERPAGE)
						 ((EQ (fetch
 EPAGE of
 STREAM)
						      (fetch
 CPAGE of
 STREAM))
                                                             (* Last page)

						   (fetch
 EOFFSET of
 STREAM))
						 (T          (* Beyond EOF so no data)

						    0)))
	      (replace
 CPPTR of
 STREAM with
 BUF))
          (RETURN BUF])

(\PAGEDBACKFILEPTR

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

                                   (* also see similar function \DRIBBACKFILEPTR)

    [COND
      ((APPENDONLY STREAM)
	(LISPERROR "ILLEGAL ARG" (fetch
 FULLNAME of
 STREAM]
                                   (* Checks done separately so we dont take an error with interrupts off)

    (COND
      ([NOT (AND (ZEROP (fetch
 COFFSET of
 STREAM))
		 (ZEROP (fetch
 CPAGE of
 STREAM]
	(UNINTERRUPTABLY
            [replace
 COFFSET of
 STREAM with
 (COND
					      ((ZEROP (fetch
 COFFSET of
 STREAM))
						(RELEASECPAGE STREAM)
						(add
 (fetch
 CPAGE of
 STREAM)
						     -1)
						(replace
 CBUFSIZE of
 STREAM with
 0)
						(SUB1 BYTESPERPAGE))
					      (T (SUB1 (fetch
 COFFSET of
 STREAM]
	    [replace
 XPOSITION of
 STREAM with
 (IMAX 0 (SUB1 (fetch
 XPOSITION of
 STREAM])])

(\PAGEDBIN

  [LAMBDA (STREAM)                                          (* rmk: "29-MAY-82 00:14")

    (CHECK (type?
 STREAM STREAM)
	   (READABLE STREAM)
	   (EQ (fetch
 BYTESIZE of
 STREAM)
	       (CONSTANT BitsPerByte)))                     (* EOF checked in INCREAD)

    (PROG (X)
      RETRY
          (RETURN (\GETBASEBYTE (GETPAGEBASE STREAM (QUOTE READ))
				(PROG1 (fetch
 COFFSET of
 STREAM)
				       (COND
					 ((ILESSP (fetch
 COFFSET of
 STREAM)
						  (fetch
 CBUFSIZE of
 STREAM))
					   (add
 (fetch
 COFFSET of
 STREAM)
						1))
					 ((EQ (SETQ X (\TURNPAGE
 STREAM (QUOTE READ)))
					      T)            (* \TURNPAGE found the next page, so try again)

					   (GO RETRY))
					 (T (RETURN X])

(\PAGEDSETFILEPTR

  [LAMBDA (STREAM INDX)                                     (* rmk: " 2-JUL-82 14:55")

    (\UPDATEOF
 STREAM)                                      (* Update the EOF in case we have writen thru it)

    (PROG ((NEWPAGE (fetch
 (BYTEPTR PAGE) of
 INDX))
	   (NEWOFF (fetch
 (BYTEPTR OFFSET) of
 INDX)))
          (UNINTERRUPTABLY
              (COND
		([OR (NEQ NEWPAGE (fetch
 CPAGE of
 STREAM))
		     (AND (APPENDONLY STREAM)
			  (ILESSP NEWOFF (fetch
 COFFSET of
 STREAM]
                                                            (* Force page release if ptr is going off the beaten 

							    path)

		  (RELEASECPAGE STREAM)
		  (replace
 CBUFSIZE of
 STREAM with
 0)       (* Disable microcode)

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

(\PAGEDGETFILEPTR

  [LAMBDA (STREAM)                                          (* rmk: " 2-JUL-82 13:07")

    (create
 BYTEPTR
	    PAGE ←(fetch
 CPAGE of
 STREAM)
	    OFFSET ←(fetch
 COFFSET of
 STREAM])

(\PAGEDGETEOFPTR

  [LAMBDA (STREAM)                                          (* bvm: "26-DEC-81 15:48")

    (\UPDATEOF
 STREAM)                                      (* If we have been writing the EOF may not be current)

    (create
 BYTEPTR
	    PAGE ←(fetch
 EPAGE of
 STREAM)
	    OFFSET ←(fetch
 EOFFSET of
 STREAM])

(\PAGEDREADP

  [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 as the last character of 

							     the file doesn't count.)

    (AND (NOT (\PAGEDEOFP
 STREAM))
	 (OR (NOT (NULL FLG))
	     (NEQ EOL.TC (\SYNCODE \PRIMTERMSA (\PAGEDPEEKBIN
 STREAM)))
	     (OR (ILESSP (ffetch
 CPAGE of
 STREAM)
			 (ffetch
 EPAGE of
 STREAM))
		 (PROG2 

          (* Having done a \PAGEDPEEKBIN above, we won't be in the case where COFFSET is BYTESPERPAGE Thus there are at 

	  least two characters in the buffer)



			(ILESSP (ADD1 (ffetch
 COFFSET of
 STREAM))
				(ffetch
 CBUFSIZE of
 STREAM])

(\PAGEDEOFP

  [LAMBDA (STREAM)                                           (* JonL "10-JUN-83 00:50")

                                                             (* Determines if a paged file is at EOF.)

    (OR (READONLY STREAM)
	(\UPDATEOF
 STREAM))
    (COND
      ((ILESSP (IPLUS (fetch
 CPAGE of
 STREAM)
		      (FOLDLO (fetch
 COFFSET of
 STREAM)
			      BYTESPERPAGE))
	       (fetch
 EPAGE of
 STREAM))

          (* Not on last page yet, so not eof. Need to figure in the COFFSET because it is possible for COFFSET to be 

	  BYTESPERPAGE before the page is turned)



	NIL)
      ((IGREATERP (fetch
 CPAGE of
 STREAM)
		  (fetch
 EPAGE of
 STREAM)))
      ((IGEQ (IMOD (fetch
 COFFSET of
 STREAM)
		   BYTESPERPAGE)
	     (fetch
 EOFFSET of
 STREAM])

(\PAGEDBINS

  [LAMBDA (STREAM BASE OFF N)      (* lmm " 5-MAR-83 16:45")

                                   (* For page-mapped streams, BINs N bytes from STREAM to memory starting at 

				   BASE+OFF. End of file check is in TURNPAGE.)

    (bind
 CNT END PG START
       do
 (SETQ PG (GETPAGEBASE STREAM (QUOTE READ))) 
                                   (* Page handle)

	  (SETQ START (fetch
 COFFSET of
 STREAM)) 
                                   (* First byte. Zero xcpt on first pass)

	  [SETQ END (IMIN (IPLUS START N)
			  (COND
			    ((ILESSP (fetch
 CPAGE of
 STREAM)
				     (fetch
 EPAGE of
 STREAM))
			      BYTESPERPAGE)
			    (T (fetch
 CBUFSIZE of
 STREAM]
                                   (* First byte BEYOND whats to be read from this page)

	  (\MOVEBYTES PG START BASE OFF (SETQ CNT (IDIFFERENCE END START)))
	  (COND
	    ((IGREATERP N CNT)
	      (SETQ N (IDIFFERENCE N CNT))
                                   (* This much more to do)

	      (SETQ OFF (IPLUS OFF CNT))
                                   (* starting here)

	      (\TURNPAGE
 STREAM (QUOTE READ))
                                   (* next page, pls)

	      )
	    (T (COND
		 ((EQ END BYTESPERPAGE)
		   (\TURNPAGE
 STREAM (QUOTE READ))
                                   (* Move onto next page)

		   )
		 (T (replace
 COFFSET of
 STREAM with
 END)
                                   (* Move to after the last byte we read)

		    ))
	       (RETURN])

(\PAGEDBOUT

  [LAMBDA (STREAM CHAR)                                     (* rmk: "29-MAY-82 00:14")

    (CHECK (type?
 STREAM STREAM)
	   (type?
 CHAR CHAR)
	   (WRITEABLE STREAM)
	   (EQ (fetch
 BYTESIZE of
 STREAM)
	       (CONSTANT BitsPerByte)))
    (PROG NIL
      RETRY
          (RETURN (\PUTBASEBYTE (GETPAGEBASE STREAM (QUOTE WRITE))
				[PROG1 (fetch
 COFFSET of
 STREAM)
				       (COND
					 ((ILESSP (fetch
 COFFSET of
 STREAM)
						  BYTESPERPAGE)
					   (add
 (fetch
 COFFSET of
 STREAM)
						1))
					 (T (\TURNPAGE
 STREAM (QUOTE WRITE))
					    (GO RETRY]
				CHAR)))
    1])

(\PAGEDBOUTS

  [LAMBDA (STREAM BASE OFF N)      (* lmm " 5-MAR-83 16:45")

                                   (* For page-mapped streams, bouts N bytes to stream from Base,off)

    (bind
 CNT END PG START
       do
 (SETQ PG (GETPAGEBASE STREAM (QUOTE WRITE)))
	  (SETQ START (fetch
 COFFSET of
 STREAM))
	  (SETQ END (IMIN (IPLUS START N)
			  BYTESPERPAGE))
	  (\MOVEBYTES BASE OFF PG START (SETQ CNT (IDIFFERENCE END START)))
	  (COND
	    ((IGREATERP N CNT)
	      (SETQ N (IDIFFERENCE N CNT))
	      (SETQ OFF (IPLUS OFF CNT))
	      (\TURNPAGE
 STREAM (QUOTE WRITE)))
	    (T (COND
		 ((EQ END BYTESPERPAGE)
		   (\TURNPAGE
 STREAM (QUOTE WRITE)))
		 (T (replace
 COFFSET of
 STREAM with
 END)))
	       (RETURN])

(\PAGEDPEEKBIN

  [LAMBDA (STREAM NOERRORFLG)                               (* rmk: "30-JUN-82 17:46")


          (* Grabs next byte. The GETPAGEBASE loads the current page if necessary. If we are beyond the EOF it will load a 

	  blank page of zeros, but we are heading for an error then anyway (unless NOERRORFLG, in which case we return NIL.

	  This option is used by SKIPSEPRS.) A value returned from ERRORX2 under ENDOFSTREAMOP will be returned as the peeked 

	  byte, although ENDOFSTREAMOP doesn't return at all if STREAM is the terminal.)



    (PROG (X)
      RETRY
          (RETURN (\GETBASEBYTE (GETPAGEBASE STREAM (QUOTE READ))
				(PROG1 (fetch
 COFFSET of
 STREAM)
				       (COND
					 ((ILESSP (fetch
 COFFSET of
 STREAM)
						  (fetch
 CBUFSIZE of
 STREAM))
                                                            (* The buffer returned by GETPAGEBASE is valid)

					   )
					 ((EQ (SETQ X (\TURNPAGE
 STREAM (QUOTE READ)
								 NOERRORFLG))
					      T)            (* \TURNPAGE found the next page, so try again)

					   (GO RETRY))
					 (T (RETURN X])

(\TURNPAGE

  [LAMBDA (STREAM WHATFOR NOERRORFLG)                       (* rmk: "30-JUN-82 17:46")


          (* Advances STREAM to a new page. Leaves the current page pointer NIL as the new page may never be written, so must 

	  update eof. Returns T on success; any other return is a value to use by \BIN)



    (PROG NIL
          [COND
	    ((IGEQ (fetch
 CPAGE of
 STREAM)
		   (fetch
 EPAGE of
 STREAM))                 (* Next page is past end of file)

	      (SELECTQ WHATFOR
		       [READ (RETURN (AND (NULL NOERRORFLG)
					  (STREAMOP (QUOTE ENDOFSTREAMOP)
						    STREAM STREAM]
		       (WRITE (\SETEOF
 STREAM (ADD1 (fetch
 CPAGE of
 STREAM))
				       0))
		       (SHOULDNT]
          (RELEASECPAGE STREAM)                             (* Let current page go)

          (UNINTERRUPTABLY
              (replace
 CBUFSIZE of
 STREAM with
 (replace
 COFFSET of
 STREAM with
 0))
                                                            (* First byte. \GETPAGEBASE will fix CBUFSIZE.)

	      (add
 (fetch
 CPAGE of
 STREAM)
		   1)                                       (* Next page)

	      )
          (RETURN T])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

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

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 \ILLEGAL.DEVICEOP)
)
(PUTPROPS FILEIO COPYRIGHT ("Xerox Corporation" 1981 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (12538 14516 (PPSTREAM 12548 . 14514)) (14597 15481 (\GETACCESS 14607 . 15157) (
\SETACCESS 15159 . 15479)) (25042 42558 (\CLOSEFILE 25052 . 26125) (\DEFINEDEVICE 26127 . 28038) (
\DELETEFILE 28040 . 28318) (\DEVICEEVENT 28320 . 29011) (\GENERATEFILES 29013 . 29491) (
\GENERATENOFILES 29493 . 30650) (\NOFILESNEXTFILEFN 30652 . 32054) (\GENERATENEXTFILE 32056 . 32826) (
\GETDEVICEFROMNAME 32828 . 34335) (\GETFILENAME 34337 . 35018) (\GETFILENAME.OR.STREAM 35020 . 36127) 
(\OPENFILE 36129 . 38420) (\READPAGES 38422 . 38904) (\RENAMEFILE 38906 . 39378) (\REVALIDATEFILE 
39380 . 41345) (\TRUNCATEFILE 41347 . 41752) (\WRITEPAGES 41754 . 42332) (\ILLEGAL.DEVICEOP 42334 . 
42556)) (42689 44579 (\FDEVINSTANCE 42699 . 44577)) (45243 51365 (CNDIR 45253 . 48351) (DIRECTORYNAME 
48353 . 49203) (DIRECTORYNAMEP 49205 . 49794) (HOSTNAMEP 49796 . 50549) (\ADD.CONNECTED.DIR 50551 . 
51363)) (51408 64269 (\BACKFILEPTR 51418 . 51611) (BIN 51613 . 51774) (\BACKPEEKBIN 51776 . 52238) (
\BACKBIN 52240 . 52744) (\BIN 52746 . 53046) (\BINS 53048 . 53395) (\NONPAGEDBINS 53397 . 53736) (BOUT
 53738 . 53906) (\BOUT 53908 . 54128) (\BOUTS 54130 . 54517) (\NONPAGEDBOUTS 54519 . 54826) (COPYBYTES
 54828 . 57361) (\SLOWCOPYBYTES 57363 . 57901) (COPYFILE 57903 . 58163) (\COPYOPENFILE 58165 . 59161) 
(\GENERIC.RENAMEFILE 59163 . 59518) (\GENERIC.READP 59520 . 60283) (EOFP 60285 . 60589) (GETEOFPTR 
60591 . 60802) (GETFILEINFO 60804 . 62259) (GETFILEPTR 62261 . 62474) (SETFILEINFO 62476 . 63795) (
SETFILEPTR 63797 . 64267)) (64301 71379 (\EOSERROR 64311 . 64492) (\GETEOFPTR 64494 . 64656) (
\INCFILEPTR 64658 . 66527) (\NEWLENGTHIS 66529 . 67369) (\PEEKBIN 67371 . 67567) (\SETCLOSEDFILELENGTH
 67569 . 67972) (\SETEOF 67974 . 68823) (\SETEOFPTR 68825 . 70247) (\SETFILEPTR 70249 . 70599) (
\UPDATEOF 70601 . 71377)) (73947 85799 (\GETPAGEBASE 73957 . 75554) (\PAGEDBACKFILEPTR 75556 . 76512) 
(\PAGEDBIN 76514 . 77287) (\PAGEDSETFILEPTR 77289 . 78188) (\PAGEDGETFILEPTR 78190 . 78417) (
\PAGEDGETEOFPTR 78419 . 78768) (\PAGEDREADP 78770 . 79680) (\PAGEDEOFP 79682 . 80506) (\PAGEDBINS 
80508 . 82046) (\PAGEDBOUT 82048 . 82689) (\PAGEDBOUTS 82691 . 83448) (\PAGEDPEEKBIN 83450 . 84584) (
\TURNPAGE 84586 . 85797)))))
STOP