(FILECREATED "17-AUG-83 02:07:26" {PHYLUM}<LISPCORE>SOURCES>COREIO.;33 23166  

      changes to:  (FNS \IOGenerateFiles)

      previous date: "19-JUL-83 03:33:50" {PHYLUM}<LISPCORE>SOURCES>COREIO.;32)


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

(PRETTYCOMPRINT COREIOCOMS)

(RPAQQ COREIOCOMS ((* Implementation of Core resident "files")
	(FNS \IOCloseFile \IODeleteFile \IOFindPage \IOGenerateFiles \IOGetFileHandle \IOGetFileInfo 
	     \IOGetFileName \IOInitializeStream \IONameScan \IONameSegment \IONextFileFn \IOOpenFile 
	     \IOPackFilename \IOReadPage \IOReadPages \IOReleasePages \IOSETFILEINFO \IOSetAccessTime 
	     \IOUnpackFilename \IOWritePages)
	(FNS COREDEVICE \CREATECOREDEVICE \NODIRCOREFDEV PRINTERDEVICE)
	(DECLARE: DONTCOPY (RECORDS IOPageEntry IOFILEINFOBLK IOSTREAM COREDEVICE PRINTERSTREAM))
	(INITRECORDS IOFILEINFOBLK)
	[DECLARE: DONTEVAL@LOAD DOCOPY (P (\NODIRCOREFDEV (QUOTE NODIRCORE))
					  (COREDEVICE (QUOTE CORE))
					  (PRINTERDEVICE (QUOTE LPT]
	(LOCALVARS . T)))



(* Implementation of Core resident "files")

(DEFINEQ

(\IOCloseFile
  [LAMBDA (STREAM)                                          (* rmk: "28-MAY-82 22:57")
                                                            (* Close a IO file.)
    (SELECTQ (fetch ACCESS of STREAM)
	     ((OUTPUT BOTH APPEND)
	       (\IOReleasePages STREAM (fetch EPAGE of STREAM)))
	     NIL)
    STREAM])

(\IODeleteFile
  [LAMBDA (FILENAME DEV)                                     (* bvm: " 3-JAN-83 17:35")
                                                             (* delete a file from a directory.)
    (PROG [(HANDLE (COND
		     ((type? STREAM FILENAME)
		       FILENAME)
		     (T (\IOGetFileHandle FILENAME (QUOTE OLDEST)
					  DEV]
          (COND
	    ((OR (NOT HANDLE)
		 (fetch ACCESS of HANDLE))                   (* Can't delete an open file)
	      (RETURN)))
          [for I on (fetch COREDIRECTORY of DEV) when [for J on (CADR I)
							 when [for K on (CADR J)
								 when (EQ (CDR (CADR K))
									  HANDLE)
								 do (RETURN (RPLACD K (CDDR K]
							 do (RETURN (OR (CDADR J)
									(RPLACD J (CDDR J]
	     do (RETURN (OR (CDADR I)
			    (RPLACD I (CDDR I]               (* Ad hoc code to Delete directory entry)
          (replace FILEPAGES of HANDLE with (LIST (create IOPageEntry
							  PAGENUMBER ← 0)))
          (RETURN (fetch FULLFILENAME of HANDLE])

(\IOFindPage
  [LAMBDA (fHandle PN)                                      (* rrb "11-JUN-80 13:54")
                                                            (* Finds the entry for page PN in the page list for 
							    fHandle, creating it if necessary.)
    (for P on (fetch FILEPAGES of fHandle)
       do                                                   (* There's always at least one)
	  (COND
	    ((EQ (fetch PAGENUMBER of (CAR P))
		 PN)
	      (RETURN (CAR P)))
	    [(IGREATERP (fetch PAGENUMBER of (CAR P))
			PN)
	      (RETURN (CAR (RPLNODE P (create IOPageEntry
					      PAGENUMBER ← PN)
				    (CONS (CAR P)
					  (CDR P]
	    ((NULL (CDR P))
	      (RETURN (CADR (RPLACD P (LIST (create IOPageEntry
						    PAGENUMBER ← PN])

(\IOGenerateFiles
  [LAMBDA (FDEV PATTERN)                                     (* lmm "17-AUG-83 02:00")
    (LIST [FUNCTION (LAMBDA (STATE SCRATCH NOV HD)
	      (PROG NIL
		    (RETURN (COND
			      ((AND HD (NOT NOV))
				(DCHCON (FULLNAME (OR (pop (CAR STATE))
						      (RETURN)))
					SCRATCH))
			      (T                             (* ???)
				 NIL]
	  (FOR NAM IN (CDR (fetch (FDEV DEVICEINFO) of FDEV)) JOIN (FOR EXT IN (CDR NAM)
								      JOIN (FOR VERS
									      IN (CDR EXT)
									      COLLECT (CDR VERS])

(\IOGetFileHandle
  [LAMBDA (NAME RECOG FD CREATEFLG)
    (DECLARE (SPECVARS CREATEFLG))                           (* bvm: "27-DEC-81 14:39")
    (PROG (ROOT EXT VERS SCR)
          (DECLARE (SPECVARS ROOT EXT VERS))
          (\IOUnpackFilename NAME)                           (* Sets ROOT EXT and VERS freely)
          (COND
	    ((SETQ SCR (\IONameScan ROOT (fetch COREDIRECTORY of FD)))
	      (SETQ ROOT (CAR SCR))                          (* In case name completion occurred)
	      )
	    (T (RETURN)))
          (COND
	    ((SETQ SCR (\IONameScan EXT SCR))
	      (SETQ EXT (CAR SCR)))
	    (T (RETURN)))
          (RETURN (COND
		    [VERS (OR (CDR (FASSOC VERS (CDR SCR)))
			      (AND CREATEFLG (PROG ((NEWSTREAM (create STREAM)))
					           (\IOInitializeStream NEWSTREAM FD)
					           (for I on SCR when (OR (NOT (CDR I))
									  (IGREATERP VERS
										     (CAADR I)))
						      do (RPLACD I (CONS (CONS VERS NEWSTREAM)
									 (CDR I)))
							 (RETURN))
					           (RETURN NEWSTREAM]
		    (T (SELECTQ (COND
				  ((NEQ RECOG (QUOTE OLD/NEW))
				    RECOG)
				  ((CDR SCR)
				    (QUOTE OLD))
				  (T (QUOTE NEW)))
				(NEW (SETQ VERS (ADD1 (OR (CAAR (CDR SCR))
							  0)))
				     (PROG ((NEWSTREAM (create STREAM)))
				           (\IOInitializeStream NEWSTREAM FD)
				           (RPLACD SCR (CONS (CONS VERS NEWSTREAM)
							     (CDR SCR)))
				           (RETURN NEWSTREAM)))
				(OLD (CDADR SCR))
				(OLDEST (CDAR (FLAST SCR)))
				(SHOULDNT])

(\IOGetFileInfo
  [LAMBDA (STREAM ATTRIBUTE DEV)                             (* rmk: "12-JUL-83 21:59")
                                                             (* Get the value of the ATTRIBUTE for a Core file.
							     If STREAM is a filename, then the file is not open.)
    (COND
      ((OR (type? STREAM STREAM)
	   (SETQ STREAM (\IOGetFileHandle STREAM (QUOTE OLD)
					  DEV)))
	(SELECTQ ATTRIBUTE
		 (LENGTH (create BYTEPTR
				 PAGE ←(fetch EPAGE of STREAM)
				 OFFSET ←(fetch EOFFSET of STREAM)))
		 (BYTESIZE 8)
		 (CREATIONDATE (GDATE (fetch CreationTime of STREAM)))
		 (READDATE (GDATE (fetch ReadTime of STREAM)))
		 (WRITEDATE (GDATE (fetch WriteTime of STREAM)))
		 (ICREATIONDATE (fetch CreationTime of STREAM))
		 (IREADDATE (fetch ReadTime of STREAM))
		 (IWRITEDATE (fetch WriteTime of STREAM))
		 (TYPE (fetch IOFIBType of (fetch (IOSTREAM INFOBLK) of STREAM)))
		 NIL])

(\IOGetFileName
  [LAMBDA (NAME RECOG FD)                                    (* rmk: " 8-JUL-81 23:19")
    (PROG (ROOT EXT VERS SCR CREATEFLG)
          (DECLARE (SPECVARS ROOT EXT VERS CREATEFLG))
          (\IOUnpackFilename NAME)                           (* Sets ROOT EXT and VERS freely)
          (AND [SETQ ROOT (CAR (OR (SETQ SCR (\IONameScan ROOT (fetch COREDIRECTORY of FD)))
				   (\IONameSegment ROOT]
	       [SETQ EXT (CAR (OR (SETQ SCR (\IONameScan EXT SCR))
				  (\IONameSegment EXT]
	       [COND
		 (VERS (OR (FASSOC VERS SCR)
			   (RETURN NIL)))
		 (T (SETQ VERS (SELECTQ (COND
					  ((NEQ RECOG (QUOTE OLD/NEW))
					    RECOG)
					  ((CDR SCR)
					    (QUOTE OLD))
					  (T (QUOTE NEW)))
					(NEW (ADD1 (OR (CAAR (CDR SCR))
						       0)))
					(OLD (CAAR (CDR SCR)))
					(OLDEST (CAAR (FLAST SCR)))
					(SHOULDNT]
	       (RETURN (\IOPackFilename (fetch DEVICENAME of FD])

(\IOInitializeStream
  [LAMBDA (STREAM FDEV)                                      (* bvm: "26-DEC-81 22:35")
                                                             (* Does those parts of the file handle initialization 
							     which are common to all io files.)
    (replace DEVICE of STREAM with FDEV)
    (replace INFOBLK of STREAM with (create IOFILEINFOBLK))
    (replace FILEPAGES of STREAM with (LIST (create IOPageEntry
						    PAGENUMBER ← 0)))
    (replace FULLFILENAME of STREAM with (\IOPackFilename (fetch DEVICENAME of FDEV])

(\IONameScan
  [LAMBDA (NAME NAMELST)                                     (* bvm: "26-DEC-81 22:42")
    (DECLARE (USEDFREE CREATEFLG))
    (COND
      ((LISTP NAMELST)
	(bind NEWSEG NEXTNAME while [AND (CDR NAMELST)
					 (COND
					   ((EQ (SETQ NEXTNAME (CAAR (CDR NAMELST)))
						NAME)        (* Found it)
					     (RETURN (CADR NAMELST)))
					   (T (ALPHORDER NEXTNAME NAME]
	   do                                                (* Segments are in order, so stop when 
							     (CDR NAMELST) is lexicographically greater than NAME)
	      (SETQ NAMELST (CDR NAMELST))
	   finally (RETURN (COND
			     ((AND CREATEFLG (SETQ NEWSEG (\IONameSegment NAME)))
			       (RPLACD NAMELST (CONS NEWSEG (CDR NAMELST)))
			       NEWSEG])

(\IONameSegment
  [LAMBDA (NAME)                                            (* bas: "12-DEC-79 20:31")
                                                            (* Checks that name is a valid name fragment and makes a
							    list of it if so)

          (* Possibly we should check the validity of each character of NAME, but for the time being we just upper case it to 
	  merge together files spelt with different case letters.)


    (AND (LITATOM NAME)
	 (LIST (U-CASE NAME])

(\IONextFileFn
  [LAMBDA (GENFILESTATE SCRATCHLIST NOVERSION)              (* rmk: " 4-MAY-81 13:11")
                                                            (* Start by looking at \M44NEXTFILEFN)
    (NOTIMP])

(\IOOpenFile
  [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV OLDSTREAM)       (* rmk: "12-JUL-83 21:57")
    (COND
      (OLDSTREAM                                             (* From REOPENFILE. Core files can't go away over 
							     logout, so just return old stream)
		 OLDSTREAM)
      (T (PROG (TYPE STREAM)
	       (for X in OTHERINFO
		  do                                         (* Check device-dependent parameters)
		     (SELECTQ [CAR (OR (LISTP X)
				       (SETQ X (LIST X T]
			      (TYPE                          (* Set the file TYPE (TEXT or BINARY))
				    (SELECTQ (CAR (SETQ TYPE (CDR X)))
					     ((TEXT BINARY NIL))
					     (LISPERROR "ILLEGAL ARG" OTHERINFO)))
			      NIL))
	       (OR (SETQ STREAM (\IOGetFileHandle NAME RECOG FDEV (SELECTQ RECOG
									   ((NEW OLD/NEW)
									     T)
									   NIL)))
		   (RETURN NIL))                             (* Head for not-found error in \OPENFILE)
	       (COND
		 ((fetch ACCESS of STREAM)                   (* Probably should say (LISPERROR "FILE WON'T OPEN" 
							     (fetch FULLFILENAME of STREAM)), but then \OPENLINEBUF 
							     gets upset)
		   )
		 (T (\IOSetAccessTime STREAM ACCESS)))
	       [AND (NEQ ACCESS (QUOTE INPUT))
		    (COND
		      (TYPE                                  (* Type NIL overrides default)
			    (\IOSETFILEINFO STREAM (QUOTE TYPE)
					    (CAR TYPE)
					    (fetch (STREAM DEVICE) of STREAM)))
		      ((AND DEFAULTFILETYPE (ZEROP (fetch EOFFSET of STREAM))
			    (ZEROP (fetch EPAGE of STREAM)))
			(\IOSETFILEINFO STREAM (QUOTE TYPE)
					DEFAULTFILETYPE
					(fetch (STREAM DEVICE) of STREAM]
	       (RETURN STREAM])

(\IOPackFilename
  [LAMBDA (DEVICE)
    (DECLARE (USEDFREE ROOT EXT VERS))                      (* rmk: "15-MAY-81 21:02")
    (PACK* (QUOTE {)
	   DEVICE
	   (QUOTE })
	   ROOT
	   (QUOTE %.)
	   EXT
	   (QUOTE ;)
	   VERS])

(\IOReadPage
  [LAMBDA (STREAM PAGENUMBER BUFFER)                        (* rmk: "29-MAY-82 00:00")
    [PROG ((PAGE (\IOFindPage STREAM PAGENUMBER)))          (* If we have a page, we copy it into the buffer.
							    Else we hold onto the BUFFER and zero it.)
          (COND
	    ((fetch PAGEPOINTER of PAGE)
	      (\MOVEWORDS (fetch PAGEPOINTER of PAGE)
			  0 BUFFER 0 WordsPerPage))
	    (T (replace PAGEPOINTER of PAGE with BUFFER)
	       (\ZEROWORDS BUFFER (\ADDBASE BUFFER (SUB1 WordsPerPage]
    (COND
      ((ILESSP PAGENUMBER (fetch EPAGE of STREAM))
	BYTESPERPAGE)
      ((EQ PAGENUMBER (fetch EPAGE of STREAM))
	(fetch EOFFSET of STREAM))
      (T 0])

(\IOReadPages
  [LAMBDA (STREAM FIRSTPAGE# BUFFERS)                        (* bvm: "26-DEC-81 22:48")
    (for BUF inside BUFFERS as PAGE from FIRSTPAGE# sum (\IOReadPage STREAM PAGE BUF])

(\IOReleasePages
  [LAMBDA (STREAM LP)                                        (* bvm: " 8-MAY-82 16:14")
                                                             (* Release all pages of the file beyond the last page)
    (OR LP (SETQ LP (fetch EPAGE of STREAM)))
    (for P in (fetch FILEPAGES of STREAM) when (ILESSP LP (fetch PAGENUMBER of P))
       do (replace PAGEPOINTER of P with NIL])

(\IOSETFILEINFO
  [LAMBDA (STREAM ATTRIBUTE VALUE DEV)                       (* rmk: "12-JUL-83 22:11")
    (PROG NIL
          (SELECTQ ATTRIBUTE
		   [CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
						 (LISPERROR "ILLEGAL ARG" VALUE]
		   (ICREATIONDATE (OR (FIXP VALUE)
				      (LISPERROR "NON-NUMERIC ARG" VALUE)))
		   [TYPE (OR (SELECTQ VALUE
				      ((TEXT BINARY NIL))
				      (LISPERROR "ILLEGAL ARG" VALUE]
		   (RETURN))
          (RETURN (SELECTQ ATTRIBUTE
			   (TYPE (replace IOFIBType of [fetch (IOSTREAM INFOBLK)
							  of (COND
							       ((type? STREAM STREAM)
								 STREAM)
							       (T (\IOGetFileHandle STREAM
										    (QUOTE OLD)
										    DEV]
				    with VALUE))
			   NIL])

(\IOSetAccessTime
  [LAMBDA (STREAM ACCESS)                                    (* bvm: "26-DEC-81 22:49")
                                                             (* Set the "last read" and/or "last written" times for a
							     core file according to access.)
    (PROG ((DT (IDATE)))
          (SELECTQ ACCESS
		   (INPUT (replace ReadTime of STREAM with DT))
		   (BOTH (replace ReadTime of STREAM with DT)
			 (replace WriteTime of STREAM with DT))
		   ((OUTPUT APPEND)
		     (replace WriteTime of STREAM with DT))
		   (SHOULDNT])

(\IOUnpackFilename
  [LAMBDA (NAME)                                            (* rmk: "29-JUN-81 20:58")
                                                            (* Breaks up a file name atom into its fields which it 
							    sets freely in its caller)
    (PROG ((START (OR (AND (EQ (NTHCHAR NAME 1)
			       (QUOTE {))
			   (STRPOS (QUOTE })
				   NAME NIL NIL NIL T))
		      1))
	   (N (ADD1 (NCHARS NAME)))
	   DOT SEMI)
          (DECLARE (USEDFREE ROOT EXT VERS))
          (SETQ DOT (STRPOS "." NAME START))
          (SETQ SEMI (STRPOS ";" NAME DOT))
          [COND
	    [DOT (AND SEMI (OR (IGREATERP SEMI DOT)
			       (RETURN]
	    (T (SETQ DOT (OR SEMI N]
          (COND
	    ((NOT SEMI)
	      (SETQ SEMI N)))
          [SETQ ROOT (OR (SUBATOM NAME START (SUB1 DOT))
			 (CONSTANT (MKATOM ""]
          [SETQ EXT (COND
	      ((IGEQ DOT (SUB1 SEMI))                       (* null extension. SUBATOM will return NIL)
		(CONSTANT (MKATOM "")))
	      (T (SUBATOM NAME (ADD1 DOT)
			  (SUB1 SEMI]
          (SETQ VERS (NUMBERP (SUBATOM NAME (ADD1 SEMI])

(\IOWritePages
  [LAMBDA (STREAM FIRSTPAGE BUFFERS)                        (* rmk: "28-MAY-82 23:41")
    (bind P PPTR for B inside BUFFERS as PN from FIRSTPAGE
       do (SETQ P (\IOFindPage STREAM PN))                  (* We use the current "file" page if it exists and is 
							    not a PMAP buffer, else create a new arrayblock)
	  [COND
	    ((OR (NULL (SETQ PPTR (fetch PAGEPOINTER of P)))
		 (EQ B PPTR))
	      (SETQ PPTR (replace PAGEPOINTER of P with (\ALLOCBLOCK (FOLDHI WordsPerPage 
									     WORDSPERCELL]
	  (\MOVEWORDS B 0 PPTR 0 WordsPerPage])
)
(DEFINEQ

(COREDEVICE
  [LAMBDA (NAME)                                            (* rmk: "28-JUN-81 08:30")
    (\DEFINEDEVICE NAME (\CREATECOREDEVICE NAME])

(\CREATECOREDEVICE
  (LAMBDA (NAME)                                             (* JonL "19-JUL-83 02:49")
                                                             (* DIRECTORYNAMEP has to be fixed up.
							     HOSTNAMEP is OK, cause each different host is defined by
							     its own name.)
    (create FDEV
	    DEVICENAME ← NAME
	    RESETABLE ← T
	    RANDOMACCESSP ← T
	    PAGEMAPPED ← T
	    CLOSEFILE ←(FUNCTION \IOCloseFile)
	    DELETEFILE ←(FUNCTION \IODeleteFile)
	    GETFILEINFO ←(FUNCTION \IOGetFileInfo)
	    OPENFILE ←(FUNCTION \IOOpenFile)
	    READPAGES ←(FUNCTION \IOReadPages)
	    SETFILEINFO ←(FUNCTION \IOSETFILEINFO)
	    TRUNCATEFILE ←(FUNCTION \IOReleasePages)
	    WRITEPAGES ←(FUNCTION \IOWritePages)
	    GETFILENAME ←(FUNCTION \IOGetFileName)
	    REOPENFILE ←(FUNCTION \IOOpenFile)
	    GENERATEFILES ←(FUNCTION \IOGenerateFiles)
	    EVENTFN ←(FUNCTION NILL)
	    DEVICEINFO ←(LIST (QUOTE CoreFiles))
	    DIRECTORYNAMEP ←(FUNCTION NILL)
	    HOSTNAMEP ←(FUNCTION NILL)
	    READP ←(FUNCTION \PAGEDREADP)
	    BIN ←(FUNCTION \PAGEDBIN)
	    BOUT ←(FUNCTION \PAGEDBOUT)
	    PEEKBIN ←(FUNCTION \PAGEDPEEKBIN)
	    BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
	    SETFILEPTR ←(FUNCTION \PAGEDSETFILEPTR)
	    GETFILEPTR ←(FUNCTION \PAGEDGETFILEPTR)
	    GETEOFPTR ←(FUNCTION \PAGEDGETEOFPTR)
	    EOFP ←(FUNCTION \PAGEDEOFP)
	    BLOCKIN ←(FUNCTION \PAGEDBINS)
	    BLOCKOUT ←(FUNCTION \PAGEDBOUTS))))

(\NODIRCOREFDEV
  (LAMBDA (NAME READPFN)                                     (* JonL "19-JUL-83 03:07")

          (* Creates a core device with no directory structure--files can't be found from names, only by saving a pointer to
	  the stream. This is used for linebuffers and perhaps other internal printing. The essential property is that the 
	  stream gets collected when it is no longer referenced.)


    (PROG ((FDEV (\CREATECOREDEVICE NAME)))
          (AND READPFN (replace READP of FDEV with READPFN))
          (replace OPENFILE of FDEV with (FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
					     (SELECTQ RECOG
						      ((NEW OLD/NEW)
							(PROG ((STREAM (create IOSTREAM)))
							      (replace DEVICE of STREAM with FDEV)
							      (\IOSetAccessTime STREAM ACCESS)
							      (RETURN STREAM)))
						      NIL))))
          (replace REOPENFILE of FDEV with (FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV 
								   OLDSTREAM)
					       OLDSTREAM)))
          (replace DELETEFILE of FDEV with (FUNCTION NILL))
          (replace GENERATEFILES of FDEV with (FUNCTION (LAMBDA (FDEV PATTERN)
						  (create FILEGENOBJ
							  NEXTFILEFN ←(FUNCTION NILL)))))
          (replace GETFILENAME of FDEV with (FUNCTION NILL))
          (replace DEVICEINFO of FDEV with NIL)
          (\DEFINEDEVICE NAME FDEV)
          (RETURN FDEV))))

(PRINTERDEVICE
  [LAMBDA (NAME)                                            (* rmk: " 7-DEC-82 21:52")
                                                            (* This defines an LPT device.
							    An LPT file is a core file that gets empressed and 
							    deleted when it is closed.)
    (PROG ((DEV (\CREATECOREDEVICE NAME)))
          [replace CLOSEFILE of DEV
	     with (FUNCTION (LAMBDA (STREAM)
		      (\IOCloseFile STREAM)
		      (COND
			((fetch BEINGPRINTED of STREAM)     (* Error while EMPESSING; do nothing now cause the 
							    RESETSAVE below will do the delete)
			  )
			(RESETSTATE                         (* Error while creating the file, if the user had 
							    wrapped a RESETLST/CLOSEF around his code.
							    Presumably, he doesn't want the file printed)
				    (\IODeleteFile STREAM (fetch DEVICE of STREAM)))
			(T (replace BEINGPRINTED of STREAM with T)
			   (RESETLST [RESETSAVE (fetch FULLNAME of STREAM)
						(QUOTE (PROGN (CLOSEF? OLDVALUE)
							      (DELFILE OLDVALUE]
                                                            (* Make sure file is closed and deleted after 
							    (trying to) print. Also close before EMPRESS.
							    Assume that it is already "logicaly" closed.)
                                                            (* Let EMPRESS choose the host if it is the generic 
							    printer LPT, otherwise use the name in the devicename 
							    field.)
				     (EMPRESS (fetch FULLNAME of STREAM)
					      NIL
					      (AND (NEQ (QUOTE LPT)
							(fetch DEVICENAME
							   of (fetch DEVICE of STREAM)))
						   (fetch DEVICENAME of (fetch DEVICE of STREAM)))
					      T]
          (\DEFINEDEVICE NAME DEV)
          (RETURN NAME])
)
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD IOPageEntry (PAGENUMBER . PAGEPOINTER))

(DATATYPE IOFILEINFOBLK ((IOFIBCreationTime FIXP)
			 (IOFIBReadTime FIXP)
			 (IOFIBWriteTime FIXP)
			 (IOFIBType POINTER))
			IOFIBCreationTime ←(IDATE))

(ACCESSFNS IOSTREAM ((INFOBLK (fetch F1 of DATUM)
			      (replace F1 of DATUM with NEWVALUE))
		     (FILEPAGES (fetch F2 of DATUM)
				(replace F2 of DATUM with NEWVALUE))
		     (CreationTime (fetch IOFIBCreationTime of (fetch INFOBLK of DATUM))
				   (replace IOFIBCreationTime of (fetch INFOBLK of DATUM)
				      with NEWVALUE))
		     (ReadTime (fetch IOFIBReadTime of (fetch INFOBLK of DATUM))
			       (replace IOFIBReadTime of (fetch INFOBLK of DATUM) with NEWVALUE))
		     (WriteTime (fetch IOFIBWriteTime of (fetch INFOBLK of DATUM))
				(replace IOFIBWriteTime of (fetch INFOBLK of DATUM) with NEWVALUE)))
		    (CREATE (create STREAM))
		    INFOBLK ←(create IOFILEINFOBLK)
		    FILEPAGES ←(LIST (create IOPageEntry
					     PAGENUMBER ← 0)))

(ACCESSFNS COREDEVICE ((COREDIRECTORY (FETCH DEVICEINFO OF DATUM)
				      (REPLACE DEVICEINFO OF DATUM WITH NEWVALUE))))

(ACCESSFNS PRINTERSTREAM ((BEINGPRINTED (fetch F3 of DATUM)
					(replace F3 of DATUM with NEWVALUE))))
]
(/DECLAREDATATYPE (QUOTE IOFILEINFOBLK)
		  (QUOTE (FIXP FIXP FIXP POINTER)))
)
(/DECLAREDATATYPE (QUOTE IOFILEINFOBLK)
		  (QUOTE (FIXP FIXP FIXP POINTER)))
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\NODIRCOREFDEV (QUOTE NODIRCORE))
(COREDEVICE (QUOTE CORE))
(PRINTERDEVICE (QUOTE LPT))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(PUTPROPS COREIO COPYRIGHT ("Xerox Corporation" 1981 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1080 16229 (\IOCloseFile 1090 . 1451) (\IODeleteFile 1453 . 2559) (\IOFindPage 2561 . 
3375) (\IOGenerateFiles 3377 . 3972) (\IOGetFileHandle 3974 . 5553) (\IOGetFileInfo 5555 . 6563) (
\IOGetFileName 6565 . 7528) (\IOInitializeStream 7530 . 8164) (\IONameScan 8166 . 8949) (
\IONameSegment 8951 . 9460) (\IONextFileFn 9462 . 9688) (\IOOpenFile 9690 . 11453) (\IOPackFilename 
11455 . 11692) (\IOReadPage 11694 . 12435) (\IOReadPages 12437 . 12657) (\IOReleasePages 12659 . 13119
) (\IOSETFILEINFO 13121 . 13882) (\IOSetAccessTime 13884 . 14492) (\IOUnpackFilename 14494 . 15594) (
\IOWritePages 15596 . 16227)) (16230 21274 (COREDEVICE 16240 . 16400) (\CREATECOREDEVICE 16402 . 17866
) (\NODIRCOREFDEV 17868 . 19369) (PRINTERDEVICE 19371 . 21272)))))
STOP