(FILECREATED "19-JUL-83 03:32:12" {PHYLUM}<LISPCORE>SOURCES>MOD44IO.;36
 87060  

      changes to:  (VARS MOD44IOCOMS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD \NWORDS.BCPLPASSWORD)
		   (RECORDS M44DEVICE UNAME FILESPEC M44GENFILESTATE M44DIRSEARCHSTATE)
		   (MACROS UCASECHAR UPDATEVALIDATION BETWEEN)
		   (FNS \OPENDISKDEVICE)

      previous date: "18-JUL-83 15:32:02" {PHYLUM}<LISPCORE>SOURCES>MOD44IO.;35)


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

(PRETTYCOMPRINT MOD44IOCOMS)

(RPAQQ MOD44IOCOMS
 ((* Device dependent code for the Model44 disk)
	(FNS \M44AddDiskPages \M44AllocFilePageMap \M44CloseFile \M44CompleteFH \M44CREATEFILE 
	     \M44DeleteFile \M44EVENTFN \M44ExtendFilePageMap \M44FillInMap \M44GENERATEFILES 
	     \M44GetAccessTime \M44GetFileHandle \M44GetFileInfo \M44GetFileName \M44GetPageLoc 
	     \M44KillFilePageMap \M44MAKEDIRENTRY \M44NEXTFILEFN \M44OpenFile \M44OPENFILEFROMFP 
	     \M44ReadDiskPage \M44ReadLeaderPage \M44ReadPages \M44ReleasePages \M44SetAccessTimes 
	     \M44SetEndOfFile \M44SetFileInfo \M44TruncateFile \M44WriteDiskPage \M44WriteLeaderPage 
	     \M44WritePages)
	(FNS \ADDDISKPAGES \GETPAGEHINT \M44DELETEPAGES \ASSIGNDISKPAGE \COUNTDISKFREEPAGES 
	     \M44MARKPAGEFREE \M44FLUSHDISKDESCRIPTOR \MAKELEADERDAS \CREATE.FID.FOR.DD \OPENDISK 
	     DISKFREEPAGES VMEMSIZE)
	(DECLARE: DONTCOPY (MACROS UCASECHAR UPDATEVALIDATION)
		  (RECORDS M44DEVICE)
		  (CONSTANTS (PageMapIncrement 64)
			     (NameFirstCharPos 13)))
	(GLOBALRESOURCES (\M44PAGEBUFFER (NCREATE (QUOTE VMEMPAGEP))))
	(COMS (* Directory lookup routines)
	      (FNS \FILESPEC \FINDDIRHOLE \LISPFILENAME \LOOKUPVERSIONS \OPENDISKDESCRIPTOR 
		   \READDIRFPTR \SEARCHDIR1 \UNPACKFILENAME \WRITEDIRFPTR)
	      (FNS ALTOFILENAME)
	      (VARS \FILENAMECHARSLST)
	      (GLOBALVARS \FILENAMECHARSLST)
	      (DECLARE: DONTCOPY (RECORDS UNAME FILESPEC M44GENFILESTATE M44DIRSEARCHSTATE)
			(MACROS BETWEEN)))
	(COMS (FNS \OPENDISKDEVICE \OPENDIR \M44CHECKPASSWORD \M44HOSTNAMEP)
	      (DECLARE: DONTCOPY (CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD 
					    \NWORDS.BCPLPASSWORD))
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (\OPENDISKDEVICE 0)
						(OR (BOUNDP (QUOTE \CONNECTED.DIR))
						    (CNDIR)))))
	(COMS (* SYSOUT etc)
	      (FNS \COPYSYS \COPYSYS1))
	(COMS (* Stats code. On MOD44IO because it writes on the disk and uses records not exported 
		 from MOD44IO)
	      (FNS GATHERSTATS)
	      (VARS (\STATSON NIL)))
	(DECLARE: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
		  (FILES (LOADCOMP)
			 LLBFS))))



(* Device dependent code for the Model44 disk)


(DEFINEQ

(\M44AddDiskPages

  [LAMBDA (STREAM NEWLASTPAGE NEWLASTBYTE)                   (* bvm: "29-DEC-82 17:49")


          (* Add pages to an existing Model44 file. NEWLASTPAGE is the page number of the last page in the extended file.

	  Return the disk address of the new last page.)



    (\M44FillInMap
 STREAM (fetch
 LastPage of
 STREAM))        (* Fill in map to end of file.

							     Code below assumes at least one valid map entry)

    (\ADDDISKPAGES STREAM (ADD1 (fetch
 LASTMAPPEDPAGE of
 STREAM))
		   (IDIFFERENCE NEWLASTPAGE (fetch
 LASTMAPPEDPAGE of
 STREAM))
		   (fetch
 (ARRAYP BASE) of
 (\M44ExtendFilePageMap
 STREAM NEWLASTPAGE))
		   NEWLASTBYTE)
    (replace
 LASTMAPPEDPAGE of
 STREAM with
 NEWLASTPAGE)
    (replace
 LastPage of
 STREAM with
 NEWLASTPAGE)
    (replace
 LastOffset of
 STREAM with
 NEWLASTBYTE)          (* record new eof in filehandle only)

    NEWLASTPAGE])

(\M44AllocFilePageMap

  [LAMBDA (STREAM LASTPAGE)                                  (* bvm: "20-OCT-82 16:46")


          (* Allocate a page map array large enough to map the given page and store the new map into the given file handle.

	  Return the new array.)



    (replace
 FILEPAGEMAP of
 STREAM with
 (ARRAY (CEIL (IPLUS LASTPAGE 4)
						     PageMapIncrement)
					       (QUOTE SMALLPOSP)
					       \FILLINDA 0])

(\M44CloseFile

  [LAMBDA (STREAM)                                           (* bvm: "25-MAY-83 12:02")

                                                             (* Update EOF in leader page)

    [COND
      ((NEQ (fetch
 ACCESS of
 STREAM)
	    (QUOTE INPUT))
	(\M44TruncateFile
 STREAM (fetch
 EPAGE of
 STREAM)
			  (fetch
 EOFFSET of
 STREAM)
			  T)
	(\M44FLUSHDISKDESCRIPTOR (fetch
 DEVICE of
 STREAM]
    STREAM])

(\M44CompleteFH

  [LAMBDA (STREAM SCRBUFF)                                   (* bvm: "25-MAY-83 12:03")


          (* Completes the fields of a file handle that describes an existing file by reading in its leader page which it 

	  leaves for its caller)



    [PROG ((NUMCHARS (CONS))
	   (BUF (\M44ReadLeaderPage
 STREAM SCRBUFF))
	   (DSK (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM)))
	   LASTPAGE# NBYTES)

          (* Get the page number and the number of bytes on the last page of the file specified by fHandle.

	  If the last page number hint is wrong in the leader page, then find the real last page and change the hint.)



          (COND
	    ((AND (NEQ (SETQ LASTPAGE# (SUB1 (fetch
 LastPageNumber of
 BUF)))
		       -1)
		  (EQ [PROG ((DAs (ARRAY 3 (QUOTE WORD)
					 \FILLINDA 0))
			     (BFSPG# (ADD1 LASTPAGE#)))
			    (SETA DAs 1 (fetch
 LastPageAddress of
 BUF))
			    (SETA DAs 2 \EOFDA)
			    (RETURN (AND (EQ (\ACTONDISKPAGES DSK NIL (fetch
 (ARRAYP BASE)
									 of
 DAs)
							      LASTPAGE# STREAM BFSPG# BFSPG# 
							      \DC.READD NUMCHARS NIL T)
					     BFSPG#)
					 (SETQ NBYTES (CAR NUMCHARS]
		      (fetch
 LastPageByteCount of
 BUF)))
	      (replace
 LastPage of
 STREAM with
 LASTPAGE#)    (* Update STREAM eof)

	      (replace
 LastOffset of
 STREAM with
 NBYTES))
	    (T                                               (* Hint was wrong so scan the file for last page)

	       (for
 PN from
 PageMapIncrement by
 PageMapIncrement
		  do
 (SETQ LASTPAGE# (\M44FillInMap
 STREAM PN)) 
                                                             (* Wait until attempt to find page fails)

		  repeatwhile
 (EQ PN LASTPAGE#))
	       (SETQ NBYTES (\ACTONDISKPAGES DSK NIL (fetch
 (ARRAYP BASE)
							of
 (fetch
 FILEPAGEMAP of
 STREAM))
					     -1 STREAM (ADD1 LASTPAGE#)
					     (ADD1 LASTPAGE#)
					     \DC.READD NUMCHARS))
	       (\M44SetEndOfFile
 STREAM LASTPAGE# (CAR NUMCHARS)
				 BUF)))
          (UPDATEVALIDATION STREAM BUF)                      (* Validation is low order bits of creation and write 

							     dates)

          (COND
	    ((EQ (fetch
 LastOffset of
 STREAM)
		 BYTESPERPAGE)                               (* Shouldn't happen, because alto files should never 

							     have a full last page. However, cope if it happens...)

	      (replace
 EPAGE of
 STREAM with
 (ADD1 (fetch
 LastPage of
 STREAM)))
	      (replace
 EOFFSET of
 STREAM with
 0))
	    (T (replace
 EPAGE of
 STREAM with
 (fetch
 LastPage of
 STREAM))
	       (replace
 EOFFSET of
 STREAM with
 (fetch
 LastOffset of
 STREAM]
    STREAM])

(\M44CREATEFILE

  [LAMBDA (FDEV UNAME SCRBUFF DIRECTORYP)                    (* bvm: " 8-DEC-82 17:32")

                                                             (* Create a file on the Model44 disk.)

    (PROG ((DSK (fetch
 DSKOBJ of
 FDEV))
	   (PNAME (\LISPFILENAME
 UNAME))
	   NC STREAM FP MAP FPBASE DAT)
          (OR PNAME (RETURN))                                (* Cant create as name wasnt complete)

          (OR SCRBUFF (HELP "No buffer for createfile"))
          (SETQ STREAM (create
 M44STREAM))
          (replace
 FULLFILENAME of
 STREAM with
 PNAME)
          (replace
 DEVICE of
 STREAM with
 FDEV)
          (replace
 FID of
 STREAM with
 (SETQ FP (create
 FID)))
          (replace
 FILEPAGEMAP of
 STREAM with
 (SETQ MAP (ARRAY PageMapIncrement (QUOTE WORD)
							       \FILLINDA 0)))
          (replace
 LASTMAPPEDPAGE of
 STREAM with
 0)
          (SETQ FPBASE (fetch
 (ARRAYP BASE) of
 FP))
          (replace
 FPSERIAL# of
 FPBASE with
 (add
 (fetch
 (DSKOBJ DISKLASTSERIAL#) of
 DSK)
						 1))
          (COND
	    (DIRECTORYP (add
 (fetch
 FPSERIALHI of
 FPBASE)
			     \FP.DIRECTORYP)))
          (replace
 FPVERSION of
 FPBASE with
 1)
          (SETA MAP 0 \EOFDA)
          (SETA MAP 3 \EOFDA)                                (* We are about to create pages 0 and 1, everything else

							     is nonexistent)

          (\ZEROPAGE (fetch
 (POINTER PAGE#) of
 SCRBUFF))
          (\BLT (LOCF (fetch
 TimeCreate of
 SCRBUFF))
		(SETQ DAT (\DAYTIME0 (CREATECELL \FIXP)))
		WORDSPERCELL)                                (* Set creation and write dates)

          (\BLT (LOCF (fetch
 TimeWrite of
 SCRBUFF))
		DAT WORDSPERCELL)
          (replace
 PropertyPtr of
 SCRBUFF with
 \INITPROPPTR)
          (SETQ SCRBUFF SCRBUFF)                             (* Get leader page to write the name in.

							     See \M44MAKEDIRENTRY for the name logic.)

          (for
 POS from
 NameFirstCharPos as
 C in
 (fetch
 CHARPAIRS of
 UNAME)
	     do
 (\PUTBASEBYTE SCRBUFF POS (UCASECHAR (CAR C)))
	     finally
 [COND
		       ((OR (CDR (fetch
 VERSION of
 UNAME))
			    (NEQ (CAR (fetch
 VERSION of
 UNAME))
				 (CHARCODE 1)))
			 (\PUTBASEBYTE SCRBUFF POS (CHARCODE !))
			 (for
 old
 POS from
 (ADD1 POS) as
 C in
 (fetch
 VERSION of
 UNAME)
			    do
 (\PUTBASEBYTE SCRBUFF POS C]
		     (\PUTBASEBYTE SCRBUFF POS (CHARCODE %.))
		     (OR (EVENP (add
 POS 1)
				BYTESPERWORD)
			 (\PUTBASEBYTE SCRBUFF POS 0))       (* Fill out the last word)

		     (SETQ NC (IDIFFERENCE POS NameFirstCharPos)))
          (replace
 NameCharCount of
 SCRBUFF with
 NC)         (* The end of file will be zero and the validation not 

							     set as befits a new file.)

          (\WRITEDISKPAGES DSK (LIST SCRBUFF NIL)
			   (fetch
 (ARRAYP BASE) of
 MAP)
			   -1 STREAM 0 1 NIL NIL 0 0)
          (replace
 FPLEADERVDA of
 FPBASE with
 (\WORDELT MAP 1))
          (replace
 DIRINFO of
 STREAM with
 (\M44MAKEDIRENTRY
 (fetch
 FID of
 STREAM)
							    UNAME NC FDEV))
          (RETURN STREAM])

(\M44DeleteFile

  [LAMBDA (FILENAME DEV)                                     (* bvm: " 3-JAN-83 17:44")

                                                             (* Delete a Model44 file.)

    (GLOBALRESOURCE \M44PAGEBUFFER
        (PROG ((STREAM (\M44GetFileHandle
 FILENAME (QUOTE OLDEST)
					  DEV NIL \M44PAGEBUFFER T)))
	      (COND
		((OR (NOT STREAM)
		     (bind
 (NAME ←(fetch
 FULLFILENAME of
 STREAM)) find
 ST in
 \OPENFILES
			suchthat
 (EQ (fetch
 FULLFILENAME of
 ST)
				     NAME)))                 (* Can't delete an open file)

		  (RETURN)))
	      (\M44DELETEPAGES STREAM -1)
	      (PROG ((DIROFD (fetch
 (M44DEVICE SYSDIROFD) of
 DEV)))
                                                             (* Delete directory entry)

		    (\SETFILEPTR DIROFD (fetch
 DIRINFO of
 STREAM))
		    (\BOUT DIROFD (LOGAND 3 (\PEEKBIN DIROFD)))
		    (FLUSHMAP DIROFD))
	      (\M44KillFilePageMap
 STREAM)
	      (replace
 FID of
 STREAM with
 NIL)
	      (RETURN (fetch
 FULLFILENAME of
 STREAM))))])

(\M44EVENTFN

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

    (SELECTQ EVENT
	     [(AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
	       (SELECTQ (MACHINETYPE)
			(DANDELION (AND (GETD (QUOTE \Duration.global.setup))
					(\Duration.global.setup))
				   (COREDEVICE (QUOTE DSK)))
			(PROG (DD)
			      (COND
				((AND (NOT (fetch
 (M44DEVICE DDVALID) of
 FDEV))
				      (SETQ DD (fetch
 (M44DEVICE DISKDESCRIPTOROFD) of
 FDEV)))
                                                             (* Flush out of date disk descriptor, too)

				  (FORGETPAGES DD)
				  (replace
 (M44DEVICE DISKDESCRIPTOROFD) of
 FDEV with
 NIL)))
			      (FORGETPAGES (fetch
 (M44DEVICE SYSDIROFD) of
 FDEV))
			      (\OPENDIR
 FDEV]
	     (BEFORELOGOUT (\M44FLUSHDISKDESCRIPTOR FDEV))
	     NIL])

(\M44ExtendFilePageMap

  [LAMBDA (STREAM TOPAGE#)                                   (* bvm: "21-OCT-82 18:27")


          (* If the file's page map is not big enough to map the given page, then create a new one that is big enough and 

	  copy the old OLDMAP information into the new map. If the file has no map, then create one big enough to map the 

	  given page. Return the new map. -

	  Map entry 0 corresponds to bfs page -1, entry 1 corresponds to the leader page, and entry 2 corresponds to Lisp 

	  page 0)



    (PROG ((OLDMAP (fetch
 FILEPAGEMAP of
 STREAM))
	   NEWMAP)
          (RETURN (COND
		    ((NOT OLDMAP)
		      (SETQ NEWMAP (\M44AllocFilePageMap
 STREAM TOPAGE#))
                                                             (* Initialize with leader page hint)

		      (SETA NEWMAP 0 \EOFDA)
		      [SETA NEWMAP 1 (fetch
 FPLEADERVDA of
 (fetch
 (ARRAYP BASE)
							      of
 (fetch
 FID of
 STREAM]
		      NEWMAP)
		    ((ILESSP (IPLUS TOPAGE# 3)
			     (ARRAYSIZE OLDMAP))
		      OLDMAP)
		    (T (SETQ NEWMAP (\M44AllocFilePageMap
 STREAM TOPAGE#))
		       (for
 i from
 0 to
 (SUB1 (ARRAYSIZE OLDMAP)) do
 (SETA NEWMAP i (\WORDELT OLDMAP 
											      i)))
		       NEWMAP])

(\M44FillInMap

  [LAMBDA (STREAM UPTOPAGE)                                  (* bvm: "29-OCT-82 13:16")

    (PROG ((MAP (\M44ExtendFilePageMap
 STREAM UPTOPAGE)))    (* Extend MAP)

          (RETURN (add
 (fetch
 LASTMAPPEDPAGE of
 STREAM)
		       (\GETPAGEHINT STREAM (fetch
 LASTMAPPEDPAGE of
 STREAM)
				     (IDIFFERENCE UPTOPAGE (fetch
 LASTMAPPEDPAGE of
 STREAM))
				     (fetch
 (ARRAYP BASE) of
 MAP])

(\M44GENERATEFILES

  [LAMBDA (FDEV PATTERN)                                     (* bvm: " 5-APR-83 17:53")


          (* Returns a file-generator object that will generate AT LEAST all files in the sys-dir of FDEV whose names match 

	  PATTERN. Clients might need to provide additional filtering. For M44, the generate state consists of the HOSTNAME 

	  (DSK) followed by a "search state", a directory pointer and a character list of the sort that \SEARCHDIR1 expects.

	  DIRPTR is the position of the next file to be considered in the directory.)



    (PROG ((DIROFD (fetch
 (M44DEVICE SYSDIROFD) of
 FDEV))
	   (HOSTNAME (FILENAMEFIELD PATTERN (QUOTE HOST)))
	   CHARLIST)
          [OR DIROFD (RETURN (create
 FILEGENOBJ
				     NEXTFILEFN ←(FUNCTION NILL]
          (SETQ PATTERN (PACKFILENAME (QUOTE HOST)
				      NIL
				      (QUOTE BODY)
				      PATTERN))
          [SETQ CHARLIST (for
 C inatom
 PATTERN as
 I from
 1
			    collect
 (COND
				      [(AND (IGEQ C (CHARCODE a))
					    (ILEQ C (CHARCODE z)))
					(LIST C (IPLUS (IDIFFERENCE C (CHARCODE a))
						       (CHARCODE A]
				      [(AND (IGEQ C (CHARCODE A))
					    (ILEQ C (CHARCODE Z)))
					(LIST C (IPLUS (IDIFFERENCE C (CHARCODE A))
						       (CHARCODE a]
				      ((FMEMB C (CHARCODE (ESCAPE * ; ?)))

          (* \SEARCHDIR1 currently only checks prefixes, so we truncate at the first * or escape. Also ignore version 

	  specifications, because of the alternative representations of version 1)



					(RETURN $$VAL))
				      ([AND (EQ C (CHARCODE %.))
					    (FMEMB (NTHCHARCODE PATTERN (ADD1 I))
						   (CHARCODE (ESCAPE * ? ; NIL]
                                                             (* We don't require a dot match unless it separates a 

							     real extension. The client must filter for various 

							     combinations of version numbers.)

					(RETURN $$VAL))
				      (T (LIST C]
          (RETURN (create
 FILEGENOBJ
			  NEXTFILEFN ←(FUNCTION \M44NEXTFILEFN)
			  GENFILESTATE ←(create
 M44GENFILESTATE
						DIROFD ← DIROFD
						HOSTNAME ← HOSTNAME
						SEARCHSTATE ←(create
 M44DIRSEARCHSTATE
								     DIRPTR ← 0
								     CHARLIST ← CHARLIST])

(\M44GetAccessTime

  [LAMBDA (STREAM ACCESS SCRBUFF)                            (* bvm: "28-OCT-82 11:14")


          (* Return either the last write date, last read date, or creation date for the file specified by the file handle 

	  in the form of an integer. SCRBUFF is a scratch buffer for reading the leader page. ACCESS is assumed to be WRITE,

	  READ, or CREATE)



    (\M44ReadLeaderPage
 STREAM SCRBUFF)
    (SELECTQ ACCESS
	     (CREATE (fetch
 TimeCreate of
 SCRBUFF))
	     (READ (fetch
 TimeRead of
 SCRBUFF))
	     (WRITE (fetch
 TimeWrite of
 SCRBUFF))
	     (SHOULDNT])

(\M44GetFileHandle

  [LAMBDA (NAME RECOG FDEV CREATEFLG SCRBUFF FAST)           (* bvm: "14-JUN-83 16:03")


          (* Creates a STREAM for dsk file NAME, creating it if necessary when CREATEFLG is true. SCRBUFF is a scratch 

	  buffer for manipluating the leader page. If FAST is true, does not fill in any fields of STREAM that would require

	  reading the file, e.g., the length and full map)



    (PROG ((DIROFD (fetch
 (M44DEVICE SYSDIROFD) of
 FDEV))
	   FS STREAM)
          (RETURN (COND
		    ((NULL DIROFD)                           (* Non-existent device)

		      NIL)
		    ((EQ (fetch
 FSDIRPTR of
 (SETQ FS (\FILESPEC
 NAME RECOG DIROFD)))
			 (QUOTE DIRECTORY))                  (* directory name was given.)

		      NIL)
		    ((fetch
 FSDIRPTR of
 FS)
		      (\SETFILEPTR DIROFD (IPLUS 2 (fetch
 FSDIRPTR of
 FS)))
		      (SETQ STREAM (create
 M44STREAM))
		      (replace
 FULLFILENAME of
 STREAM with
 (fetch
 PNAME of
 FS))
		      (replace
 DEVICE of
 STREAM with
 FDEV)
		      (replace
 FID of
 STREAM with
 (\READDIRFPTR
 DIROFD))
		      (replace
 DIRINFO of
 STREAM with
 (fetch
 FSDIRPTR of
 FS))
		      (OR FAST (\M44CompleteFH
 STREAM SCRBUFF))
		      STREAM)
		    ((NULL (fetch
 UNAME of
 FS))
		      (LISPERROR "BAD FILE NAME" NAME))
		    (CREATEFLG (COND
				 ((AND (FIXP CREATEFLG)
				       (IGREATERP CREATEFLG (fetch
 (M44DEVICE DISKFREEPAGES)
							       of
 FDEV)))
				   (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" NAME))
				 (T (\M44CREATEFILE
 FDEV (fetch
 UNAME of
 FS)
						    SCRBUFF])

(\M44GetFileInfo

  [LAMBDA (STREAM ATTRIBUTE DEV)                             (* bvm: "28-OCT-82 10:58")

                                                             (* Get the value of the ATTRIBUTE for a model44 file.

							     If STREAM is a filename, then the file is not open.)

    (GLOBALRESOURCE \M44PAGEBUFFER
        (COND
	  ((OR (type?
 STREAM STREAM)
	       (SETQ STREAM (\M44GetFileHandle
 STREAM (QUOTE OLD)
					       DEV NIL \M44PAGEBUFFER T)))
	    (SELECTQ ATTRIBUTE
		     (LENGTH (COND
			       ((NULL (fetch
 VALIDATION of
 STREAM))
                                                             (* Need to read leader page etc to get length)

				 (\M44CompleteFH
 STREAM \M44PAGEBUFFER)))
			     (create
 BYTEPTR
				     PAGE ←(fetch
 EPAGE of
 STREAM)
				     OFFSET ←(fetch
 EOFFSET of
 STREAM)))
		     [WRITEDATE (GDATE (ALTO.TO.LISP.DATE (\M44GetAccessTime
 STREAM (QUOTE WRITE)
									     \M44PAGEBUFFER]
		     [READDATE (GDATE (ALTO.TO.LISP.DATE (\M44GetAccessTime
 STREAM (QUOTE READ)
									    \M44PAGEBUFFER]
		     [CREATIONDATE (GDATE (ALTO.TO.LISP.DATE (\M44GetAccessTime
 STREAM (QUOTE CREATE)
										\M44PAGEBUFFER]
		     (IWRITEDATE (ALTO.TO.LISP.DATE (\M44GetAccessTime
 STREAM (QUOTE WRITE)
								       \M44PAGEBUFFER)))
		     (IREADDATE (ALTO.TO.LISP.DATE (\M44GetAccessTime
 STREAM (QUOTE READ)
								      \M44PAGEBUFFER)))
		     (ICREATIONDATE (ALTO.TO.LISP.DATE (\M44GetAccessTime
 STREAM (QUOTE CREATE)
									  \M44PAGEBUFFER)))
		     NIL))))])

(\M44GetFileName

  [LAMBDA (NAME RECOG FDEV)                                  (* bvm: "19-NOV-82 17:02")

    (fetch
 PNAME of
 (\FILESPEC
 NAME RECOG (fetch
 (M44DEVICE SYSDIROFD) of
 FDEV])

(\M44GetPageLoc

  [LAMBDA (STREAM PAGENO CREATE?)                            (* bvm: "29-DEC-82 17:50")


          (* Look in the file's page map to find the disk address of the page. If the map does not include the page, then 

	  extend it appropriately. If page does not exit, create it if CREATE? is true, else return \EOFDA)



    (COND
      ((ILEQ PAGENO (fetch
 LastPage of
 STREAM))
	(COND
	  ((IGREATERP PAGENO (fetch
 LASTMAPPEDPAGE of
 STREAM))
	    (\M44FillInMap
 STREAM PAGENO)))
	(\WORDELT (fetch
 FILEPAGEMAP of
 STREAM)
		  (IPLUS PAGENO 2)))
      (CREATE? (\M44AddDiskPages
 STREAM PAGENO 0)
	       (\M44GetPageLoc
 STREAM PAGENO))
      (T \EOFDA])

(\M44KillFilePageMap

  [LAMBDA (fHandle)                                         (* bas: " 7-JAN-80 19:43")

                                                            (* Remove the file's page map.)

    (replace
 FILEPAGEMAP of
 fHandle with
 NIL)
    (replace
 LASTMAPPEDPAGE of
 fHandle with
 -1])

(\M44MAKEDIRENTRY

  [LAMBDA (FID UNAME NC FDEV)                                (* bvm: "19-NOV-82 17:04")

                                                             (* Makes a directory entry for a new file)

    (PROG (POS (DIROFD (fetch
 (M44DEVICE SYSDIROFD) of
 FDEV)))
          (SETQ POS (\FINDDIRHOLE
 (LRSH (IPLUS NC 16Q)
					1)
				  DIROFD))
          (\WRITEDIRFPTR
 DIROFD FID)
          (\BOUT DIROFD NC)

          (* Now write out the alto-style name "name[.ext]!ver." with ver omitted if 1; This is basically the same logic as 

	  is used to write the name in the leader page in \M44CREATEFILE. We can't share cause here we do bouts, cause we 

	  might run over a page; there we must do PUTBASEBYTE's cause we can't set the fileptr to the leader page.)



          [for
 C in
 (fetch
 CHARPAIRS of
 UNAME) do
 (\BOUT DIROFD (UCASECHAR (CAR C]
          [COND
	    ([OR (CDR (fetch
 VERSION of
 UNAME))
		 (NEQ (CHARCODE 1)
		      (CAR (fetch
 VERSION of
 UNAME]
	      (\BOUT DIROFD (CHARCODE !))
	      (for
 C in
 (fetch
 VERSION of
 UNAME) do
 (\BOUT DIROFD C]
          (\BOUT DIROFD (CHARCODE %.))
          (COND
	    ((EVENP NC BYTESPERWORD)
	      (\BOUT DIROFD 0)))
          (\SETFILEPTR DIROFD POS)
          (\BOUT DIROFD (LOGOR 4 (\PEEKBIN DIROFD)))         (* When everything is ready, finally change the type 

							     from hole to file.)

          (FLUSHMAP DIROFD)
          (RETURN POS])

(\M44NEXTFILEFN

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


          (* GENFILESTATE is the state information from the file-generator object created by \M44GENERATEFILES.

	  This function returns 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 GENFILESTATE 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)



    (SCRATCHLIST SCRATCHLIST (PROG (TEMP LEN (DIROFD (fetch
 DIROFD of
 GENFILESTATE))
					 SAWDOT)
			           (COND
				     ((SETQ TEMP (\SEARCHDIR1
 DIROFD (fetch
 SEARCHSTATE of
 
										     GENFILESTATE)))
				       [COND
					 (HOST/DIR (ADDTOSCRATCHLIST (CHARCODE {))
						   (for
 C inatom
 (fetch
 HOSTNAME of
 GENFILESTATE)
						      do
 (ADDTOSCRATCHLIST C))
						   (ADDTOSCRATCHLIST (CHARCODE }]
				       [\SETFILEPTR DIROFD
						    (IDIFFERENCE (GETFILEPTR DIROFD)
								 (SETQ LEN
								   (LENGTH (fetch
 CHARLIST
									      of
 (fetch
 SEARCHSTATE
										    of
 GENFILESTATE]
                                                            (* Read all the characters from the directory)

				       (for
 I from
 1 to
 (IPLUS TEMP (SUB1 LEN))
					  do
                (* The SUB1 is because the last character is the 

							    undesired dot)

					     (COND
					       ((EQ (SETQ TEMP (\BIN DIROFD))
						    (CHARCODE !))
						 (COND
						   (NOVERSION (RETURN)))
						 (SETQ NOVERSION T)
						 (OR SAWDOT (ADDTOSCRATCHLIST (CHARCODE ".")))
						 (SETQ TEMP (CHARCODE ;)))
					       [(AND (IGEQ TEMP (CHARCODE a))
						     (ILEQ TEMP (CHARCODE z)))
						 (SETQ TEMP (IPLUS (IDIFFERENCE TEMP (CHARCODE a))
								   (CHARCODE A]
					       ((EQ TEMP (CHARCODE "."))
						 (SETQ SAWDOT T)))
					     (ADDTOSCRATCHLIST TEMP))
				       (COND
					 ((NOT NOVERSION)   (* No version found--insert ;1)

					   (OR SAWDOT (ADDTOSCRATCHLIST (CHARCODE %.)))
					   (ADDTOSCRATCHLIST (CHARCODE ;))
					   (ADDTOSCRATCHLIST (CHARCODE 1])

(\M44OpenFile

  [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV OLDSTREAM)       (* bvm: "14-JUN-83 16:29")

                                                             (* Open a Model44 file. Gets the physical end of file 

							     and sets up ofd)

    (GLOBALRESOURCE \M44PAGEBUFFER (PROG ([PAGESTIMATE
					    (AND (NEQ ACCESS (QUOTE INPUT))
						 (for
 X in
 OTHERINFO
						    when
 (EQ (CAR (LISTP X))
							     (QUOTE LENGTH))
						    do
 (RETURN (IPLUS 2 (FOLDHI (CADR X)
										BYTESPERPAGE]
					  STREAM)
				         (OR [SETQ STREAM
					       (COND
						 ((NOT (type?
 STREAM NAME))
						   (\M44GetFileHandle
 NAME RECOG FDEV
								      (AND (NEQ ACCESS (QUOTE INPUT))
									   (OR PAGESTIMATE T))
								      \M44PAGEBUFFER))
						 ((OR (fetch
 (M44DEVICE DSKPASSWORDOK)
							 of
 (fetch
 DEVICE of
 NAME))
						      (EQ (fetch
 W0 of
 (fetch
 FID of
 NAME))
							  32768))
                                                             (* Make sure password is ok if trying to reopen anything

							     but a directory)

						   (\M44CompleteFH
 NAME \M44PAGEBUFFER]
					     (RETURN NIL))
				         [COND
					   ([AND PAGESTIMATE (IGREATERP PAGESTIMATE
									(IPLUS (fetch
 (M44DEVICE
											DISKFREEPAGES)
										  of
 FDEV)
									       (fetch
 LastPage
										  of
 STREAM]
					     (RETURN (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" NAME]
				         [COND
					   ((EQ ACCESS (QUOTE OUTPUT))
                                                             (* File is EMPTY even if it is old)

					     (replace
 EPAGE of
 STREAM
						with
 (replace
 EOFFSET of
 STREAM with
 0]
                                                             (* Leader page is read in during STREAM initialization)

				         (COND
					   ((AND (NOT OLDSTREAM)
						 (NOT (FMEMB (QUOTE DON'T.CHANGE.DATE)
							     OTHERINFO)))
                                                             (* For REOPENFILE op, don't change dates)

					     (\M44SetAccessTimes
 STREAM ACCESS \M44PAGEBUFFER)
                                                             (* Resets validation)

					     (\M44WriteLeaderPage
 STREAM \M44PAGEBUFFER)
                                                             (* We write out accumulated changes to leader page)

					     ))
				         (RETURN STREAM])

(\M44OPENFILEFROMFP

  [LAMBDA (DEV NAME ACCESS FID DIRINFO)                      (* bvm: " 1-NOV-82 15:13")

                                                             (* Opens a disk file given its FP)

    (PROG ((STREAM (create
 M44STREAM)))
          (replace
 FULLFILENAME of
 STREAM with
 (SETQ NAME (PACK* (QUOTE {)
								 (fetch
 DEVICENAME of
 DEV)
								 (QUOTE })
								 NAME)))
          (replace
 DEVICE of
 STREAM with
 DEV)
          (replace
 FID of
 STREAM with
 FID)
          (replace
 DIRINFO of
 STREAM with
 (OR DIRINFO -1))
          (RETURN (\OPENFILE STREAM ACCESS])

(\M44ReadDiskPage

  [LAMBDA (STREAM PAGENO BUF)                                (* bvm: "25-MAY-83 12:03")


          (* The functions for reading a disk page called by \M44ReadPages. Returns the number of bytes read.

	  If PAGEADDR is 0, then assume 0 bytes read. Fill the BUF with zeros beyond the last byte read.)



    (PROG ((PAGEADDR (\M44GetPageLoc
 STREAM PAGENO))
	   (BFSPG# (ADD1 PAGENO)))
          (RETURN (COND
		    ((EQ PAGEADDR \EOFDA)                    (* no bytes read, fill with zeroes.)

		      (\ZEROWORDS BUF (\ADDBASE BUF (SUB1 WordsPerPage)))
		      0)
		    ((EQ PAGEADDR \FILLINDA)
		      (SHOULDNT))
		    ((EQ (\ACTONDISKPAGES (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM))
					  BUF
					  (fetch
 (ARRAYP BASE) of
 (fetch
 FILEPAGEMAP of
 STREAM))
					  -1 STREAM BFSPG# BFSPG# \DC.READD)
			 BFSPG#)
		      BYTESPERPAGE)
		    (T                                       (* if READDISKPAGE returns NIL, presumably there is an 

							     error of some kind, hope it was with the file map and 

							     try again.)

		       (\M44KillFilePageMap
 STREAM)
		       (\M44ReadDiskPage
 STREAM PAGENO BUF])

(\M44ReadLeaderPage

  [LAMBDA (STREAM BUFFER)                                    (* bvm: "25-MAY-83 12:04")


          (* File leader page format: Words 0-1, time created. Words 2-3, time last written. Words 4-5, time last read.

	  Words 6-25, name of file. Words 26-235, leader properties. Words 236-245, spare. Word 246, property pointer.

	  Word 247, change serial number. Words 248-252, STREAM hint for directory. Word 253, disk address of last page.

	  Word 254, page number of last page. Word 255, number of bytes on last page.)



    (\ACTONDISKPAGES (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM))
		     BUFFER
		     (fetch
 (ARRAYP BASE) of
 (OR (fetch
 FILEPAGEMAP of
 STREAM)
						 (\MAKELEADERDAS STREAM)))
		     -1 STREAM 0 0 \DC.READD)
    BUFFER])

(\M44ReadPages

  [LAMBDA (STREAM FIRSTPAGE# BUFFERS)                        (* bvm: "26-DEC-81 23:50")

                                                             (* Read pages from a Model44 file.)

    (for
 BUF inside
 BUFFERS as
 PAGENO from
 FIRSTPAGE# sum
 (\M44ReadDiskPage
 STREAM PAGENO BUF])

(\M44ReleasePages

  [LAMBDA (STREAM LASTPAGE LASTOFFSET)                       (* bvm: "29-DEC-82 16:27")

                                                             (* Release all pages of the file beyond LASTPAGE)

    (\M44DELETEPAGES STREAM (ADD1 LASTPAGE))
    (COND
      ((ILESSP LASTPAGE (fetch
 LASTMAPPEDPAGE of
 STREAM))
	(for
 I from
 (ADD1 LASTPAGE) to
 (fetch
 LASTMAPPEDPAGE of
 STREAM)
	   do
 (SETA (fetch
 FILEPAGEMAP of
 STREAM)
		    (IPLUS I 2)
		    \EOFDA))
	(replace
 LASTMAPPEDPAGE of
 STREAM with
 LASTPAGE)))
    (\M44SetEndOfFile
 STREAM LASTPAGE LASTOFFSET])

(\M44SetAccessTimes

  [LAMBDA (STREAM ACCESS BUF)                                (* bvm: " 4-APR-83 11:26")


          (* The leader page of STREAM has been read into buffer. Set the "last read" and/or "last written" times in the BUF

	  according to access, which is assumed to be either INPUT, OUTPUT, BOTH, or APPEND.)



    (PROG [(DT (DAYTIME0 (create
 FIXP]                       (* Note: DAYTIME0 returns an Alto time, not Lisp time.

							     This is consistent with the dates in the leader page)

          (SELECTQ ACCESS
		   ((OUTPUT BOTH APPEND)
		     (replace
 TimeCreate of
 BUF with
 DT)
		     (replace
 TimeWrite of
 BUF with
 DT)      (* Must revalidate because write DT has changed)

		     (UPDATEVALIDATION STREAM BUF))
		   NIL)
          (SELECTQ ACCESS
		   ((INPUT BOTH)
		     (replace
 TimeRead of
 BUF with
 DT))
		   NIL])

(\M44SetEndOfFile

  [LAMBDA (STREAM EPAGE EOFFSET BUFFER)                      (* bvm: "20-OCT-82 18:28")


          (* Reset the file's leader page end-of-file hint. If BUFFER is given, then simply update the buffer.

	  If it is not, then read and write the leader page.)



    (replace
 LastPage of
 STREAM with
 EPAGE)                  (* Update handle)

    (replace
 LastOffset of
 STREAM with
 EOFFSET)
    (RESOURCECONTEXT \M44PAGEBUFFER
        [PROG [(EADDR (\M44GetPageLoc
 STREAM EPAGE))
	       (BUF (OR BUFFER (PROGN (GETRESOURCE \M44PAGEBUFFER)
				      (\M44ReadLeaderPage
 STREAM \M44PAGEBUFFER]
	      (replace
 LastPageAddress of
 BUF with
 EADDR)
	      (replace
 LastPageNumber of
 BUF with
 (ADD1 EPAGE))
                                                             (* M44 counts from 1)

	      (replace
 LastPageByteCount of
 BUF with
 EOFFSET)
	      (COND
		((NOT BUFFER)
		  (\M44WriteLeaderPage
 STREAM BUF)
		  (FREERESOURCE \M44PAGEBUFFER])])

(\M44SetFileInfo

  [LAMBDA (fHandle STREAM attribute value)                   (* bvm: "26-DEC-81 21:26")

                                                             (* Set the attribute of a Model44 file to value.

							     If STREAM is NIL, then the file is assumed to be 

							     closed.)

    NIL])

(\M44TruncateFile

  [LAMBDA (STREAM LP LO UPDATENOW)                           (* bvm: " 6-JAN-83 16:06")

                                                             (* Resets the length of the file to LP page and LO 

							     offset. Can both shorten and lengthen files.)

    [COND
      ((NOT LP)
	(SETQ LP (fetch
 EPAGE of
 STREAM))
	(SETQ LO (fetch
 EOFFSET of
 STREAM]
    (COND
      ((IGREATERP LP (fetch
 LastPage of
 STREAM))
	(\M44AddDiskPages
 STREAM LP LO))
      ((ILESSP LP (fetch
 LastPage of
 STREAM))
	(\M44ReleasePages
 STREAM LP LO)
	(replace
 LastPage of
 STREAM with
 LP)
	(replace
 LastOffset of
 STREAM with
 LO)               (* Now need to rewrite last page with new length, null 

							     next pointer)

	(\MAPPAGE LP STREAM)
	(\SETIODIRTY STREAM LP)
	(FLUSHMAP STREAM LP))
      (T (replace
 LastOffset of
 STREAM with
 LO)))
    (AND UPDATENOW (\M44SetEndOfFile
 STREAM LP LO))
    STREAM])

(\M44WriteDiskPage

  [LAMBDA (STREAM PAGENO BUF NBYTES)                         (* bvm: "25-MAY-83 12:04")

                                                             (* Write a disk page on the Model44.)

    (\M44GetPageLoc
 STREAM PAGENO T)                         (* Ensure that PAGENO is in map)

    (PROG ((BFSPG# (ADD1 PAGENO)))
          (RETURN (COND
		    ([COND
			((NEQ PAGENO (fetch
 LastPage of
 STREAM))
                                                             (* Writing only data)

			  (\ACTONDISKPAGES (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM))
					   BUF
					   (fetch
 (ARRAYP BASE) of
 (fetch
 FILEPAGEMAP of
 STREAM))
					   -1 STREAM BFSPG# BFSPG# \DC.WRITED))
			(T                                   (* When writing last page, need to fill in the numchars 

							     field of label, so this is harder)

			   (COND
			     ((EQ PAGENO (fetch
 EPAGE of
 STREAM))
			       (EQ (\WRITEDISKPAGES (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM))
						    BUF
						    (fetch
 (ARRAYP BASE)
						       of
 (fetch
 FILEPAGEMAP of
 STREAM))
						    -1 STREAM BFSPG# BFSPG# NIL NIL NBYTES)
				   BFSPG#))
			     (T 

          (* We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the 

	  file while we're at it. This may save a call to \ADDDISKPAGES)



				[COND
				  ((ILEQ (fetch
 LASTMAPPEDPAGE of
 STREAM)
					 PAGENO)
				    (\M44ExtendFilePageMap
 STREAM (ADD1 PAGENO]
				(COND
				  ((EQ (\WRITEDISKPAGES (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM))
							(LIST BUF NIL)
							(fetch
 (ARRAYP BASE)
							   of
 (fetch
 FILEPAGEMAP of
 STREAM))
							-1 STREAM BFSPG# (ADD1 BFSPG#)
							NIL NIL 0)
				       (ADD1 BFSPG#))        (* Write two pages, the second of which is blank)

				    (replace
 LastPage of
 STREAM with
 (ADD1 PAGENO))
				    (replace
 LastOffset of
 STREAM with
 0)
				    T]
		      NBYTES)
		    (T (\M44KillFilePageMap
 STREAM)
		       (\M44WriteDiskPage
 STREAM PAGENO BUF NBYTES])

(\M44WriteLeaderPage

  [LAMBDA (STREAM BUFFER)                                    (* bvm: "25-MAY-83 12:04")

                                                             (* Write the file's leader page from the buffer)

    (\ACTONDISKPAGES (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM))
		     BUFFER
		     (fetch
 (ARRAYP BASE) of
 (OR (fetch
 FILEPAGEMAP of
 STREAM)
						 (\MAKELEADERDAS STREAM)))
		     -1 STREAM 0 0 \DC.WRITED])

(\M44WritePages

  [LAMBDA (STREAM FIRSTPAGE# BUFFERS)                        (* bvm: "26-DEC-81 23:52")

                                                             (* Write pages onto a Model44 file.)

    (for
 BUF inside
 BUFFERS as
 PAGENO from
 FIRSTPAGE# do
 (\M44WriteDiskPage
 STREAM PAGENO BUF
									    (COND
									      ((EQ PAGENO
										   (fetch
 EPAGE
										      of
 STREAM))
										(fetch
 EOFFSET
										   of
 STREAM))
									      (T BYTESPERPAGE])
)
(DEFINEQ

(\ADDDISKPAGES

  [LAMBDA (STREAM FIRSTNEWPAGE NPAGES DAs LASTNUMCHARS)      (* bvm: "25-MAY-83 12:06")


          (* Adds to file STREAM NPAGES, where FIRSTNEWPAGE-1 is the last existing page. DAs is the vector of disk 

	  addresses, where first element corresponds to BFS page -1)


                                                             (* Note FIRSTNEWPAGE is in Lisp terms, so it is actually

							     LASTOLDPAGE for the BFS)

    (GLOBALRESOURCE \M44PAGEBUFFER
		    (PROG ((BUFFERS (CONS \M44PAGEBUFFER (for
 I from
 1 to
 (IMIN NPAGES \MAXDISKDAs)
							    collect
 NIL)))
			   (DSK (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM)))
			   (LASTEXISTINGPAGE FIRSTNEWPAGE)
			   CHUNK)
		          (\ACTONDISKPAGES DSK \M44PAGEBUFFER DAs -1 STREAM LASTEXISTINGPAGE 
					   LASTEXISTINGPAGE \DC.READD NIL NIL NIL LASTEXISTINGPAGE)
                                                             (* Read last existing page, so we can rewrite it with 

							     new label)

		          (while
 (IGREATERP NPAGES 0)
			     do
 (SETQ CHUNK (IMIN \MAXDISKDAs NPAGES))
				(\WRITEDISKPAGES DSK BUFFERS DAs -1 STREAM LASTEXISTINGPAGE
						 (IPLUS LASTEXISTINGPAGE CHUNK)
						 NIL NIL LASTNUMCHARS LASTEXISTINGPAGE)
				(RPLACA BUFFERS NIL)
				(add
 LASTEXISTINGPAGE CHUNK)
				(SETQ NPAGES (IDIFFERENCE NPAGES CHUNK])

(\GETPAGEHINT

  [LAMBDA (STREAM LASTKNOWNPAGE NPAGES DAs)                  (* bvm: "25-MAY-83 12:06")

    (PROG ((DSK (fetch
 DSKOBJ of
 (fetch
 DEVICE of
 STREAM)))
	   (KP (ADD1 LASTKNOWNPAGE))
	   (DONE 0)
	   CHUNK LASTPAGEREAD DA)
          [while
 (IGREATERP NPAGES DONE) do
 (COND
					      [(NEQ (SETQ DA (\GETBASE DAs (IPLUS KP 2)))
						    \FILLINDA)
                                                             (* There already is an entry for KP+1, so no need to 

							     read it)

						(COND
						  ((EQ DA \EOFDA)
						    (RETURN))
						  (T (add
 DONE 1)
						     (add
 KP 1]
					      (T [SETQ CHUNK (IMIN \MAXDISKDAs
								   (ADD1 (IDIFFERENCE NPAGES DONE]
						 (SETQ LASTPAGEREAD
						   (\ACTONDISKPAGES DSK NIL DAs -1 STREAM KP
								    (IPLUS KP CHUNK -1)
								    \DC.READD NIL NIL NIL NIL))
						 (add
 DONE (IDIFFERENCE LASTPAGEREAD KP))
						 (COND
						   ((ILESSP LASTPAGEREAD (IPLUS KP CHUNK -1))
                                                             (* Hit end of file)

						     (RETURN)))
						 (SETQ KP LASTPAGEREAD]
          (RETURN DONE])

(\M44DELETEPAGES

  [LAMBDA (STREAM FIRSTPAGE)                                 (* bvm: "25-MAY-83 12:07")

                                                             (* FIRSTPAGE is in Lisp terms, i.e. -1 = leader page)

    (PROG ((DEV (fetch
 DEVICE of
 STREAM))
	   (NPAGES (COND
		     ((fetch
 VALIDATION of
 STREAM)
		       (IPLUS (ADD1 (IDIFFERENCE (fetch
 LastPage of
 STREAM)
						 FIRSTPAGE))
			      2))
		     (T PageMapIncrement)))
	   (PN (ADD1 FIRSTPAGE))
	   DAs FIRSTDA LASTPAGESEEN DSK)

          (* NPAGES is used to decide how much to do at once. Need be no more than number of pages known to exist.

	  The ADD1 is that, plus two for the pages around it)



          (COND
	    ((ILESSP NPAGES 2)                               (* Nothing to delete)

	      (RETURN)))
          (SETQ DSK (fetch
 DSKOBJ of
 DEV))                   (* (\FLUSHDISKDESCRIPTOR (EMPOINTER 

							     (fetch (DSKOBJ DSKDDMGR) of DSK)) 

							     (fetch ALTODSKOBJ of DSK)))

                                                             (* Tell Alto to clear out anything it knows about dd)

                                                             (* IF STREAM:LASTMAPPEDPAGE GE FIRSTPAGE+NPAGES THEN DAs

							     ← STREAM:FILEPAGEMAP DAorigin ← -1)

          (SETQ DAs (ARRAY (SETQ NPAGES (IMIN NPAGES \MAXDISKDAs))
			   (QUOTE WORD)
			   NIL 0))
          [SETQ FIRSTDA (COND
	      [(EQ FIRSTPAGE -1)
		(fetch
 FPLEADERVDA of
 (fetch
 FIDBLOCK of
 (fetch
 FID of
 STREAM]
	      (T (\M44GetPageLoc
 STREAM FIRSTPAGE]
          (while
 (NEQ FIRSTDA \EOFDA)
	     do
 (SETA DAs 0 \FILLINDA)
		(SETA DAs 1 FIRSTDA)                         (* Corresponds to PN)

		(for
 I from
 2 to
 (SUB1 NPAGES) do
 (SETA DAs I \FILLINDA))
		[SETQ LASTPAGESEEN (\ACTONDISKPAGES DSK NIL (fetch
 (ARRAYP BASE) of
 DAs)
						    (SUB1 PN)
						    STREAM PN (IPLUS PN NPAGES -3)
						    \DC.READD NIL NIL NIL
						    (ADD1 (fetch
 EPAGE of
 STREAM]
                                                             (* Read DAs for the next NPAGES-2)

		(\WRITEDISKPAGES DSK NIL (fetch
 (ARRAYP BASE) of
 DAs)
				 (SUB1 PN)
				 \FREEPAGEFID PN LASTPAGESEEN (UNSIGNED -1 BITSPERWORD))
		[for
 I from
 PN to
 LASTPAGESEEN do
 (\M44MARKPAGEFREE
 DEV
								    (ELT DAs (ADD1 (IDIFFERENCE
										     I PN]
		(SETQ FIRSTDA (ELT DAs (IPLUS (IDIFFERENCE LASTPAGESEEN PN)
					      2)))
		(SETQ PN (ADD1 LASTPAGESEEN)))               (* (FLUSHMAP (fetch (M44DEVICE DISKDESCRIPTOROFD) of 

							     DEV)))

                                                             (* (FORGETPAGES (fetch (M44DEVICE DISKDESCRIPTOROFD) of 

							     DEV)))

          (\M44FLUSHDISKDESCRIPTOR
 DEV])

(\ASSIGNDISKPAGE

  [LAMBDA (DSK PREVDA)                                       (* bvm: " 3-JAN-83 14:51")


          (* * Assigns a new page on DSK. If PREVDA is \EOFDA will pick random page, otherwise will attempt to allocate 

	  PREVDA+1. Returns NIL if disk is full)



    (PROG ([VDA (COND
		  ((OR (EQ PREVDA \EOFDA)
		       (COND
			 ((EQ PREVDA \FILLINDA)
			   (AND \DISKDEBUG (RAID 
			    "[Disk debug] \ASSIGNDISKPAGE called with \FILLINDA.  ↑N to continue"))
			   T)))
		    (fetch
 DISKLASTPAGEALLOC of
 DSK))
		  (T (ADD1 PREVDA]
	   (DD (fetch
 DISKDESCRIPTOROFD of
 DSK))
	   (MASK 128)
	   BITS A LOOPEDONCE FREE)
          (OR (fetch
 DDVALID of
 DSK)
	      (RAID "DISKDESCRIPTOR not open" DSK))
          (\SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO VDA BITSPERBYTE)))
          (SETQ A (MOD VDA BITSPERBYTE))
          (FRPTQ A (SETQ MASK (LRSH MASK 1)))
      LP  (COND
	    ((NULL (SETQ BITS (\BIN DD)))

          (* End of file -- wrap around to start. This technique takes longer than necessary to bomb out when disk is full, 

	  but who cares?)



	      (COND
		(LOOPEDONCE (RETURN NIL)))
	      (SETQ LOOPEDONCE T)
	      (\SETFILEPTR DD \DDBITTABSTART))
	    ((NEQ BITS 255)
	      (until
 [OR (ZEROP (LOGAND BITS MASK))
			 (ZEROP (SETQ MASK (LRSH MASK 1]
		 do
 (add
 A 1))
	      (COND
		((NOT (ZEROP MASK))                          (* Found a free page)

		  (\BACKFILEPTR DD)
		  (SETQ VDA (IPLUS (UNFOLD (IDIFFERENCE (\GETFILEPTR DD)
							\DDBITTABSTART)
					   BITSPERBYTE)
				   A))
		  (\BOUT DD (LOGOR BITS MASK))               (* Set bit indicating we snarfed this page)

                                                             (* Decrement free page count hint)

		  [replace
 DISKFREEPAGES of
 DSK with
 (COND
						       ((ZEROP (SETQ FREE (fetch
 DISKFREEPAGES
									     of
 DSK)))
							 (AND \DISKDEBUG (RAID 
				     "[Disk debug] Free page hint went negative.  ↑N to continue"))
							 (\COUNTDISKFREEPAGES
 DD))
						       (T (SUB1 FREE]
		  (replace
 DISKLASTPAGEALLOC of
 DSK with
 VDA)
		  (replace
 DDDIRTY of
 DSK with
 T)
		  (RETURN VDA)))
	      (SETQ MASK 128)
	      (SETQ A 0)))
          (GO LP])

(\COUNTDISKFREEPAGES

  [LAMBDA (DD)                                               (* bvm: " 3-JAN-83 12:25")


          (* * Counts number of free pages on a disk. DD is the diskdescriptor stream)



    [OR (type?
 STREAM DD)
	(SETQ DD (\OPENDISKDESCRIPTOR
 (\GETDEVICEFROMNAME (OR DD (QUOTE DSK]
    (PROG ((CNT 0)
	   MASK BITS)
          (\SETFILEPTR DD \DDBITTABSTART)
      LP  [COND
	    ((NULL (SETQ BITS (\BIN DD)))                    (* End of file)

	      (RETURN CNT))
	    ((EQ BITS 0)
	      (add
 CNT 8))
	    ((NEQ BITS 255)
	      (SETQ MASK 128)
	      (do
 (COND
		    ((ZEROP (LOGAND BITS MASK))
		      (add
 CNT 1)))
		 until
 (ZEROP (SETQ MASK (LRSH MASK 1]
          (GO LP])

(\M44MARKPAGEFREE

  [LAMBDA (DEV DA)                                           (* bvm: "16-DEC-82 13:02")

                                                             (* Mark disk address DA on disk device DEV free)

    (PROG ([DD (COND
		 ((fetch
 (M44DEVICE DDVALID) of
 DEV)
		   (fetch
 (M44DEVICE DISKDESCRIPTOROFD) of
 DEV))
		 (T (\OPENDISKDESCRIPTOR
 DEV]
	   BITS MASK)
          (SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO DA BITSPERBYTE)))
          (SETQ BITS (\BIN DD))
          [SETQ MASK (LLSH 1 (IDIFFERENCE 7 (MOD DA BITSPERBYTE]
          (COND
	    ((NEQ (LOGAND BITS MASK)
		  0)                                         (* Page is marked occupied, so free it)

	      (\BACKFILEPTR DD)
	      (\BOUT DD (LOGXOR BITS MASK))
	      (add
 (fetch
 (M44DEVICE DISKFREEPAGES) of
 DEV)
		   1)
	      (replace
 (M44DEVICE DDDIRTY) of
 DEV with
 T])

(\M44FLUSHDISKDESCRIPTOR

  [LAMBDA (DEV)                                              (* bvm: " 5-APR-83 12:36")

    (PROG ((DSK (COND
		  ((type?
 FDEV DEV)
		    (fetch
 (M44DEVICE DSKOBJ) of
 DEV))
		  (T DEV)))
	   DD)
          (OR (fetch
 (DSKOBJ DDDIRTY) of
 DSK)
	      (RETURN))
          (OR (SETQ DD (fetch
 DISKDESCRIPTOROFD of
 DSK))
	      (RETURN (RAID "[Disk debug] no disk descriptor stream")))
          (\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#)
          (\BOUTS DD (LOCF (fetch
 DISKLASTSERIAL# of
 DSK))
		  0 \NBYTES.DISKINFO)                        (* Copy interesting stuff into diskdescriptor header)

          (FLUSHMAP DD)
          (replace
 DDDIRTY of
 DSK with
 NIL)
          (RETURN T])

(\MAKELEADERDAS

  [LAMBDA (STREAM)                                           (* bvm: "20-OCT-82 18:42")

                                                             (* Makes a page map for STREAM that includes the leader 

							     vda)

    (PROG ((MAP (ARRAY 4 (QUOTE WORD)
		       \FILLINDA 0)))
          (SETA MAP 0 \EOFDA)
          [SETA MAP 1 (fetch
 FPLEADERVDA of
 (fetch
 (ARRAYP BASE) of
 (fetch
 FID of
 STREAM]
          (replace
 FILEPAGEMAP of
 STREAM with
 MAP)
          (replace
 LASTMAPPEDPAGE of
 STREAM with
 -1)
          (RETURN MAP])

(\CREATE.FID.FOR.DD

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

                                                             (* Creates a FID for the file DISKDESCRIPTOR on FDEV, 

							     which must be the default disk partition's device)

    (PROG ((FID (create
 FID)))

          (* Currently \SYSDISK has a copy of the diskdescriptor fp inside it, as looked up by alto at beginning of world, 

	  so be lazy and use that)



          (\BLT (fetch
 FIDBLOCK of
 FID)
		(LOCF (fetch
 (M44DEVICE DSKDDBLK) of
 FDEV))
		\LENFP)
          (RETURN FID])

(\OPENDISK

  [LAMBDA (PARTNUM)                                          (* bvm: " 5-APR-83 13:42")

    (PROG (DSK DD)
          (OR (\TESTPARTITION PARTNUM)
	      (RETURN))
          (SETQ DSK (create
 DSKOBJ))
          (\LOCKWORDS DSK \NWORDS.DSKOBJ)
          (replace
 DSKPARTITION of
 DSK with
 PARTNUM)
          (replace
 ddPOINTER of
 DSK with
 (LOCF (fetch
 ddLASTSERIAL# of
 DSK)))
          (replace
 NDISKS of
 DSK with
 2)
          (replace
 NTRACKS of
 DSK with
 406)
          (replace
 NHEADS of
 DSK with
 2)
          (replace
 NSECTORS of
 DSK with
 14)
          (replace
 RETRYCOUNT of
 DSK with
 8)
          (replace
 CBQUEUE of
 DSK with
 (fetch
 CBQUEUE of
 \MAINDISK))
                                                             (* Really should have our own)

          (RETURN (\OPENDISKDEVICE
 PARTNUM DSK])

(DISKFREEPAGES

  [LAMBDA (DSK RECOMPUTE)                                    (* bvm: " 3-JAN-83 12:40")

                                                             (* DSK ignored for now)

    (PROG ((DEV (COND
		  ((LITATOM DSK)
		    (\GETDEVICEFROMNAME (OR DSK (QUOTE DSK))
					T))
		  (T DSK)))
	   CNT)
          (COND
	    ((NOT (type?
 M44DEVICE DEV))
	      (\ILLEGAL.ARG DSK)))
          (RETURN (COND
		    (RECOMPUTE (SETQ CNT (\COUNTDISKFREEPAGES
 (\OPENDISKDESCRIPTOR
 DEV)))
			       (COND
				 ((NEQ CNT (fetch
 (M44DEVICE DISKFREEPAGES) of
 DEV))
				   (replace
 (M44DEVICE DISKFREEPAGES) of
 DEV with
 CNT)
				   (replace
 (M44DEVICE DDDIRTY) of
 DEV with
 T)))
			       CNT)
		    (T (fetch
 (M44DEVICE DISKFREEPAGES) of
 DEV])

(VMEMSIZE

  [LAMBDA NIL                                                (* bvm: " 1-NOV-82 16:44")

    (fetch
 (IFPAGE NActivePages) of
 \InterfacePage])
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS UCASECHAR MACRO 
((C)
  (COND
    ((ILESSP C (CHARCODE a))
      C)
    (T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
				   (CHARCODE A)))))))

(PUTPROPS UPDATEVALIDATION MACRO 
((STREAM BUF)
  (replace
 VALIDATION of
 STREAM with
 (\MAKENUMBER (\GETBASE BUF 1)
						  (\GETBASE BUF 3)))))
)

[DECLARE: EVAL@COMPILE 

(ACCESSFNS M44DEVICE
 ((DSKOBJ (fetch
 DEVICEINFO of
 DATUM)
			      (replace
 DEVICEINFO of
 DATUM with
 NEWVALUE)))
		     (TYPE?
 (AND (type?
 FDEV DATUM)
				 (EQ (fetch
 OPENFILE of
 DATUM)
				     (QUOTE \M44OpenFile)))))
]

(DECLARE: EVAL@COMPILE 

(RPAQQ PageMapIncrement
 64)

(RPAQQ NameFirstCharPos
 13)

(CONSTANTS (PageMapIncrement 64)
	   (NameFirstCharPos 13))
)
)

(RPAQQ \M44PAGEBUFFER
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \M44PAGEBUFFER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(PUTDEF (QUOTE \M44PAGEBUFFER)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (NCREATE (QUOTE VMEMPAGEP))))
)



(* Directory lookup routines)


(DEFINEQ

(\FILESPEC

  [LAMBDA (X RECOG DIROFD)                                  (* rrb "10-JUN-80 11:06")


          (* This returns a full file specification, with all the information needed to do open, delete, etc. A filespec is a 

	  (packedname unpackedname dirptr) triple, with the true version number smashed into the uname.

	  The dirptr is NIL if the file does not currently exist in the directory.)



    (PROG (DP V L (UNAME (\UNPACKFILENAME
 X)))
          [COND
	    ((NULL UNAME)                                   (* BAD FILE NAME)

	      (RETURN (create
 FILESPEC
			      UNAME ← NIL)))
	    [(EQ UNAME (QUOTE DIRECTORY))                   (* directory name found on front of file name, needs to 

							    generate file not found error in openfile.)

	      (RETURN (create
 FILESPEC
			      UNAME ← NIL
			      FSDIRPTR ←(QUOTE DIRECTORY]
	    ([AND (SETQ L (\LOOKUPVERSIONS
 UNAME DIROFD (SELECTQ RECOG
								 ((NEW OLD/NEW)
								   T)
								 NIL)))
		  (SETQ V (SELECTQ (OR (fetch
 VERSION of
 UNAME)
				       RECOG)
				   ((OLD
 OLD/NEW)
				     (CAR (LAST L)))
				   [NEW                     (* A new version, so the DIRPTR is NIL)

					(LIST (ADD1 (CAAR (LAST L]
				   (OLDEST (CAR L))
				   (SASSOC (fetch
 VERSION of
 UNAME)
					   L]
	      (SETQ DP (CDR V))
	      (SETQ V (CAR V)))
	    (T (SETQ DP NIL)                                (* Since file doesnt exist, recognition mode takes 

							    precedence over version number)

	       (SETQ V (SELECTQ (OR RECOG (fetch
 VERSION of
 UNAME))
				((NEW OLD/NEW)
				  (COND
				    ((fetch
 ESCFLAG of
 UNAME)
				      NIL)
				    ((FIXP (fetch
 VERSION of
 UNAME)))
				    (T 1)))
				((OLD
 OLDEST)
				  NIL)
				(FIXP (fetch
 VERSION of
 UNAME]
          (replace
 VERSION of
 UNAME with
 (AND V (CHCON V)))
                                                            (* We may have to zap a version number that was 

							    specified but not found)

          (RETURN (create
 FILESPEC
			  UNAME ← UNAME
			  FSDIRPTR ← DP])

(\FINDDIRHOLE

  [LAMBDA (WDS DIRSTREAM)                                    (* bvm: "10-MAR-83 22:01")


          (* Returns the byte address of a directory hole of size WDS. The directory file is positioned just after the 

	  2-byte length field of the hole.)



    (PROG ((PTR (OR (fetch
 DIRHOLEPTR of
 DIRSTREAM)
		    0))
	   T1 C)
      NEXT(\SETFILEPTR DIRSTREAM PTR)
          (COND
	    ((\EOFP DIRSTREAM)
	      (GO END))
	    ((ILESSP 3 (SETQ C (\BIN DIRSTREAM)))
	      (SETQ T1 (\BIN DIRSTREAM))                     (* Already occupied)

	      )
	    [(IGREATERP WDS (SETQ T1 (IPLUS (LLSH C 10Q)
					    (\BIN DIRSTREAM]
	    (T (\SETFILEPTR DIRSTREAM PTR)                   (* Hole is large enough)

	       [COND
		 ((IGREATERP T1 WDS)                         (* Too large, so break it apart.)

		   (SETQ T1 (IDIFFERENCE T1 WDS))
		   (\WOUT DIRSTREAM T1)
		   (\SETFILEPTR DIRSTREAM (SETQ PTR (IPLUS PTR T1 T1]
	       (GO END)))
          (SETQ PTR (IPLUS PTR T1 T1))
          (GO NEXT)
      END (\WOUT DIRSTREAM WDS)
          (RETURN PTR])

(\LISPFILENAME

  [LAMBDA (UNAME)                                           (* rmk: "26-OCT-81 19:11")

                                                            (* Produces a Lisp style file-name of the form 

							    "name.[ext];ver")

    (AND (fetch
 VERSION of
 UNAME)
	 (PACK* (COND
		  ((fetch
 PARTNUM of
 UNAME)
		    (PACK* "{DSK" (fetch
 PARTNUM of
 UNAME)
			   "}"))
		  (T "{DSK}"))
		(PACKC (NCONC (for
 X in
 (fetch
 CHARPAIRS of
 UNAME) collect
 (UCASECHAR (CAR X)))
			      [APPEND (COND
					((FASSOC (CHARCODE %.)
						 (fetch
 CHARPAIRS of
 UNAME))
					  (CHARCODE (;)))
					(T (CHARCODE (%. ;]
			      (fetch
 VERSION of
 UNAME])

(\LOOKUPVERSIONS

  [LAMBDA (UNAME STREAM HMIN)                                (* bvm: " 3-JUN-83 17:26")


          (* UNAME is a value of \UNPACKFILENAME. STREAM is the directory ofd. HMIN=T means look for a hole big enough for 

	  UNAME, a number N means look for that size hole, NIL means don't look. Returns a list of (version . fileptr) pairs

	  sorted by increasing version. Ptr is a pointer to the beginning of the directory slot for the file.

	  If the UNAME had an escape which matches unambiguously, the UNAME is smashed with the completion characters.)



    (PROG ([LEN1 (IPLUS 13 (LENGTH (fetch
 CHARPAIRS of
 UNAME]
	   (ESC (fetch
 ESCFLAG of
 UNAME))
	   (TLIST (CONS 0 (fetch
 CHARPAIRS of
 UNAME)))
	   (FIXEDVERSION (FIXP (fetch
 VERSION of
 UNAME)))
	   PTR NCHARSLEFT L V END CHARLIST L1 OLDESCLIST L2)
          (COND
	    ((AND FIXEDVERSION (OR ESC (ZEROP FIXEDVERSION)))
	      (SETQ FIXEDVERSION NIL)))
          [COND
	    ((EQ HMIN T)                                     (* The 6 is to allow for the maximum number of chars in 

							     a version number)

	      (SETQ HMIN (FOLDLO (IPLUS LEN1 6)
				 BYTESPERWORD]
      S   (COND
	    ((NULL (SETQ NCHARSLEFT (\SEARCHDIR1
 STREAM TLIST HMIN)))
	      [AND ESC OLDESCLIST (NCONC UNAME (MAPCAR (DREVERSE OLDESCLIST)
						       (FUNCTION CONS]
	      (RETURN L)))
          (SETQ PTR (\GETFILEPTR STREAM))
          [for
 I C LASTBANG from
 NCHARSLEFT to
 2 by
 -1
	     first
 (SETQ CHARLIST NIL)
		   (SETQ V NIL)
	     do
                                              (* Stop at 2 to exclude the terminating period)

		(SETQ C (\BIN STREAM)) 

          (* Non-version characters are reversed in CL. Version characters (if any) are used to build the integer V.

	  We fool around with LASTBANG cause, according to the alto filespecs, names like FOO!BAR!3.

	  are legit.)



		(push
 CHARLIST C)
		(COND
		  [V (COND
		       [(AND (IGEQ C (CHARCODE 0))
			     (ILEQ C (CHARCODE 9)))
			 (SETQ V (IPLUS (ITIMES V 10)
					(IDIFFERENCE C (CHARCODE 0]
		       (T                                    (* A non-numeric after a ! means that that wasn't the 

							     version marker. Try again)

			  (SETQ V NIL]
		  ((EQ C (CHARCODE !))
		    (SETQ LASTBANG CHARLIST)                 (* This might or might not be the version marker.

							     Save the current pointer in case it is.)

		    (SETQ V 0)))
	     finally
 (SELECTQ V
			      ((NIL 0)
				(SETQ V 1))
			      (PROGN                         (* Turns out there WAS a real version;

							     remove its characters and the ! from CHARLIST)

				     (SETQ CHARLIST (CDR LASTBANG]
          [COND
	    [(NULL ESC)                                      (* Everything but version has to match exactly if there 

							     was no Escape)

	      (COND
		(CHARLIST (GO NEXT]
	    ((EQ ESC T)                                      (* Escape, first time.)

	      (SETQ OLDESCLIST CHARLIST)
	      (SETQ ESC 0)                                   (* 0 means ESC but not first time.

							     Used for ambiguity checking.)

	      )
	    (T                                               (* ESC is 0)

                                                             (* Make sure that the rest of the name is the same)

	       (OR [for
 (L1 ← CHARLIST) by
 (CDR L1) as
 (L2 ← OLDESCLIST) by
 (CDR L2)
		      do
 (COND
			   ((NULL L1)
			     (RETURN (NULL L2)))
			   ([OR (NULL L2)
				(AND (NEQ (CAR L1)
					  (CAR L2))
				     (NEQ (CAR L1)
					  (LOGXOR (CAR L2)
						  32]
			     (RETURN NIL]
		   (RETURN]

          (* * Name matches. V is the version number. Cons up a piece of the result. If UNAME has an explicit version, 

	  insist on it now)



          (SETQ PTR (IDIFFERENCE PTR LEN1))                  (* Find beginning of the directory entry)

                                                             (* Merge new element into L)

          (COND
	    [FIXEDVERSION (COND
			    [(EQ V FIXEDVERSION)
			      (RETURN (LIST (CONS V PTR]
			    (T (GO NEXT]
	    ((OR (NULL L)
		 (IGREATERP (CAAR L)
			    V))
	      (SETQ L (CONS (CONS V PTR)
			    L))
	      (GO NEXT)))
          (SETQ END L)
      INS (COND
	    ((AND (CDR END)
		  (IGREATERP V (CAADR END)))
	      (SETQ END (CDR END))
	      (GO INS)))
          (RPLACD END (CONS (CONS V PTR)
			    (CDR END)))
      NEXT(AND HMIN (fetch
 DIRHOLEPTR of
 STREAM)
	       (SETQ HMIN NIL))                              (* Stop looking if found a hole)

          (GO S])

(\OPENDISKDESCRIPTOR

  [LAMBDA (DEV)                                              (* bvm: "25-MAY-83 12:16")

                                                             (* Opens and returns a stream on the disk descriptor 

							     file for DEV)

    [COND
      ((NOT (type?
 FDEV DEV))
	(SETQ DEV (\GETDEVICEFROMNAME (fetch
 DISKDEVICENAME of
 DEV]
    (OR (fetch
 (M44DEVICE DDVALID) of
 DEV)
	(PROG ((OLDD (fetch
 (M44DEVICE DISKDESCRIPTOROFD) of
 DEV))
	       STREAM)
	      (COND
		(OLDD (FORGETPAGES OLDD)))
	      [SETQ STREAM (COND
		  ((EQ (fetch
 DSKOBJ of
 DEV)
		       \MAINDISK)
		    (\M44OPENFILEFROMFP
 DEV "DISKDESCRIPTOR.;1" (QUOTE BOTH)
					(\CREATE.FID.FOR.DD DEV)))
		  (T (\OPENFILE (PACK* (QUOTE {)
				       (fetch
 DEVICENAME of
 DEV)
				       (QUOTE })
				       "DISKDESCRIPTOR.;1")
				(QUOTE BOTH]
	      (replace
 (M44DEVICE DISKDESCRIPTOROFD) of
 DEV with
 STREAM)
	      (replace
 MAXBUFFERS of
 STREAM with
 (ADD1 (fetch
 EPAGE of
 STREAM)))
                                                             (* Prepare to buffer the whole file, so that we don't 

							     get in trouble under \NEWPAGE)

	      (for
 I from
 0 to
 (fetch
 EPAGE of
 STREAM) do
 (\MAPPAGE I STREAM))
                                                             (* Ought to define a \MAPPAGES to do that more 

							     efficiently)

	      (replace
 ENDOFSTREAMOP of
 STREAM with
 (FUNCTION NILL))
	      (replace
 (M44DEVICE DDVALID) of
 DEV with
 T)))
    (fetch
 (M44DEVICE DISKDESCRIPTOROFD) of
 DEV])

(\READDIRFPTR

  [LAMBDA (STREAM FPTR)                                      (* bvm: "26-DEC-81 21:25")

    (OR FPTR (SETQ FPTR (create
 FID)))
    (replace
 W0 of
 FPTR with
 (\WIN STREAM))
    (replace
 W1 of
 FPTR with
 (\WIN STREAM))
    (replace
 W2 of
 FPTR with
 (\WIN STREAM))
    (replace
 W3 of
 FPTR with
 (\WIN STREAM))
    (replace
 W4 of
 FPTR with
 (\WIN STREAM))
    FPTR])

(\SEARCHDIR1

  [LAMBDA (STREAM TLIST HMIN)                                (* bvm: " 3-JUN-83 17:22")


          (* Finds next directory entry for which TLIST::1 is a prefix of the filename. Returns NIL if no entry found, else 

	  the length of the remaining chars in the entry. Leaves the directory positioned after the char matching the last 

	  char of TLIST::1 -

	  STREAM is the ofd of the directory file -

	  TLIST is a list of the form (POS . CHARPAIRS), where POS at entry is a fileptr in the directory file at which to 

	  start searching and CHARPAIRS is like the characters pairs of a uname. At exit, TLIST is smashed so that POS is 

	  the fileptr just beyond the found entry. -

	  if HMIN~=NIL, sets STREAM's DIRHOLEPTR to NIL or the fileptr of the first hole of at least HMIN words.)



    (PROG ((NEXT (CAR TLIST))
	   (CHARPAIRS (CDR TLIST))
	   THISNAMELENGTH TARGETLENGTH PTR L CHPAIR TYP ENTRYLENGTH CH)
          (COND
	    (HMIN (replace
 DIRHOLEPTR of
 STREAM with
 NIL)))
          (SETQ TARGETLENGTH (LENGTH CHARPAIRS))
      NEXT(\SETFILEPTR STREAM (SETQ PTR NEXT))
          (COND
	    ((\EOFP STREAM)
	      (RETURN)))

          (* * Format of a directory entry is -

	  Type (0 = hole, 1 = file), 6 bits -

	  Length of entry in words, 10 bits -

	  FP 5 words -

	  Name as a BcplString)



          (SETQ TYP (\BIN STREAM))
          (SETQ ENTRYLENGTH (IPLUS (LLSH (LOGAND TYP 3)
					 8)
				   (\BIN STREAM)))
          (SETQ NEXT (IPLUS (UNFOLD ENTRYLENGTH BYTESPERWORD)
			    PTR))
          (COND
	    ((NEQ (LRSH TYP 2)
		  1)                                         (* Not a file)

	      (COND
		((AND HMIN (NOT (IGREATERP HMIN ENTRYLENGTH)))
		  (replace
 DIRHOLEPTR of
 STREAM with
 PTR)
		  (SETQ HMIN NIL)))
	      (GO NEXT)))
          (\SETFILEPTR STREAM (IPLUS PTR 12))
          (COND
	    ((ILESSP (SETQ THISNAMELENGTH (\BIN STREAM))
		     TARGETLENGTH)
	      (GO NEXT)))
          (SETQ L CHARPAIRS)
      READ[COND
	    ((NULL L)
	      (RPLACA TLIST NEXT)
	      (RETURN (IDIFFERENCE THISNAMELENGTH TARGETLENGTH]
          (SETQ CHPAIR (CAR L))
          (SETQ CH (\BIN STREAM))
          (COND
	    ((OR (EQ CH (CAR CHPAIR))
		 (EQ CH (CADR CHPAIR)))
	      (SETQ L (CDR L))
	      (GO READ))
	    (T (GO NEXT])

(\UNPACKFILENAME

  [LAMBDA (NAME)                                             (* bvm: " 3-JUN-83 17:48")


          (* Unpacks file name into a UNAME of the form ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS) where VERSION is the 

	  version indicator (either a positive integer or one of OLD, OLDEST, NEW) PARTNUM is the partion number 

	  (NIL for current Partition) and ESCFLAG indicates that NAME terminated in escape, and the CHARPAIRS is a list of 

	  pairs the first element of which is the char actually specified in name, and the second is the upper/lower case 

	  alternative for alphabetics.)


                                                             (* changed to generate a file not found error in the 

							     case that a directory is specified -

							     rrb.)

    (PROG (J C END NEGATEDVERSION VERSION RESULT PARTNUM)
          (COND
	    ([OR (NOT NAME)
		 (EQ NAME T)
		 (NOT (LITATOM NAME))
		 (NEQ (NTHCHARCODE NAME 1)
		      (CHARCODE {))
		 (NEQ (U-CASE (SUBATOM NAME 2 4))
		      (QUOTE DSK))
		 (NOT (SETQ J (STRPOS "}" NAME 5)))
		 (AND (NEQ J 5)
		      (NOT (FIXP (SETQ PARTNUM (SUBATOM NAME 5 (SUB1 J]
	      (RETURN)))
          (SETQ END (SETQ RESULT (create
 UNAME
					 PARTNUM ← PARTNUM)))
                                                             (* End is the cell whose CDR can be smashed.)

          (add
 J 1)
          [COND
	    ((EQ (NTHCHARCODE NAME J)
		 (CHARCODE <))                               (* if directory name is included, generate file not 

							     found error. If not, return NIL which will cause bad 

							     file name error.)

	      (RETURN (COND
			((STRPOS ">" NAME)                   (* pass back special error code.)

			  (QUOTE DIRECTORY]
      COLLECTNAME
          (COND
	    ((NOT (SETQ C (NTHCHARCODE NAME J)))
	      (GO RET))
	    (T [RPLACD END (SETQ END (LIST (COND
					     [(BETWEEN C (CHARCODE A)
						       (CHARCODE Z))
					       (LIST C (IPLUS C (IDIFFERENCE (CHARCODE a)
									     (CHARCODE A]
					     [(BETWEEN C (CHARCODE a)
						       (CHARCODE z))
					       (LIST C (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
										   (CHARCODE A]
					     ((BETWEEN C (CHARCODE 0)
						       (CHARCODE 9))
					       (LIST C))
					     (T (SELCHARQ C
							  ((; !)
							    (GO SEMI))
							  ((ESCAPE *)
							    (replace
 ESCFLAG of
 RESULT with
 T)
							    (SETQ C (NTHCHARCODE NAME
										 (add
 J 1)))
							    (GO TERM))
							  (%. 
                                                             (* Omit trailing dots)

							      (SELCHARQ (NTHCHARCODE NAME
										     (ADD1 J))
									(NIL (GO RET))
									((; !)
									  (add
 J 1)
									  (GO SEMI))
									(LIST C)))
							  (($ + -)
							    (LIST C))
							  (GO ERR]
	       (add
 J 1)
	       (GO COLLECTNAME)))
      SEMI[SELCHARQ (SETQ C (NTHCHARCODE NAME (add
 J 1)))
		    ((H h)
		      (SETQQ VERSION OLD)
		      (SELCHARQ (SETQ C (NTHCHARCODE NAME (add
 J 1)))
				(NIL (GO RET))
				((; !)
				  (GO SEMI))
				(GO ERR)))
		    ((L l)
		      (SETQQ VERSION OLDEST)
		      (SELCHARQ (SETQ C (NTHCHARCODE NAME (add
 J 1)))
				(NIL (GO RET))
				((; !)
				  (GO SEMI))
				(GO ERR)))
		    ((N n)
		      (SETQQ VERSION NEW)
		      (SELCHARQ (SETQ C (NTHCHARCODE NAME (add
 J 1)))
				(NIL (GO RET))
				((; !)
				  (GO SEMI))
				(GO ERR)))
		    [(T t S s A a P p)                       (* Various Tenex crocks. Not implemented, but don't 

							     complain about them)

		      (PROG NIL
			SKIP(SELCHARQ (NTHCHARCODE NAME (add
 J 1))
				      ((; !)
					(GO SEMI))
				      (NIL (GO RET))
				      (GO SKIP]
		    [- (COND
			 (VERSION (GO ERR))
			 (T (SETQ NEGATEDVERSION T)
			    (SETQ VERSION 0)
			    (SETQ C (NTHCHARCODE NAME (add
 J 1)))
			    (GO COLLECTVERSION]
		    (NIL (GO ERR))
		    (COND
		      (VERSION (GO ERR))
		      (T (SETQ VERSION 0)
			 (GO COLLECTVERSION]
      COLLECTVERSION
          (COND
	    ((AND C (BETWEEN C (CHARCODE 0)
			     (CHARCODE 9)))
	      [SETQ VERSION (IPLUS (ITIMES VERSION 10)
				   (IDIFFERENCE C (CHARCODE 0]
	      (SETQ C (NTHCHARCODE NAME (add
 J 1)))
	      (GO COLLECTVERSION)))
          (COND
	    [NEGATEDVERSION (SETQ VERSION (SELECTQ VERSION
						   (1 (QUOTE NEW))
						   (2 (QUOTE OLDEST))
						   (GO ERR]
	    ((ZEROP VERSION)
	      (SETQQ VERSION OLD))
	    ((IGREATERP VERSION 65535)
	      (GO ERR)))
      TERM(SELCHARQ C
		    (NIL (GO RET))
		    ((; !)
		      (GO SEMI))
		    (GO ERR))
      ERR                                                    (* BAD FILE NAME)

          (RETURN NIL)
      RET (replace
 VERSION of
 RESULT with
 VERSION)
          (RETURN RESULT])

(\WRITEDIRFPTR

  [LAMBDA (STREAM FPTR)                                      (* bvm: "26-DEC-81 21:26")

    (\WOUT STREAM (fetch
 W0 of
 FPTR))
    (\WOUT STREAM (fetch
 W1 of
 FPTR))
    (\WOUT STREAM (fetch
 W2 of
 FPTR))
    (\WOUT STREAM (fetch
 W3 of
 FPTR))
    (\WOUT STREAM (fetch
 W4 of
 FPTR))
    NIL])
)
(DEFINEQ

(ALTOFILENAME

  [LAMBDA (X)                                               (* rmk: "28-OCT-81 22:49")

                                                            (* Converts the lisp filename X to the equivalent 

							    Alto-format filename.)

    (PROG [(EXT (FILENAMEFIELD X (QUOTE EXTENSION]
          (RETURN (CONCAT (FILENAMEFIELD X (QUOTE NAME))
			  (COND
			    ((SETQ EXT (FILENAMEFIELD X (QUOTE EXTENSION)))
			      (CONCAT "." EXT))
			    (T ""))
			  (COND
			    ([EQ 1 (SETQ X (FILENAMEFIELD X (QUOTE VERSION]
			      "")
			    (T (CONCAT "!" X])
)

(RPAQQ \FILENAMECHARSLST
 (36 43 45 46))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \FILENAMECHARSLST)
)
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD UNAME
 ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS))

(RECORD FILESPEC
 (UNAME FSDIRPTR)
		 (ACCESSFNS FILESPEC ((PNAME (\LISPFILENAME (fetch
 UNAME of
 DATUM))))))

(RECORD M44GENFILESTATE
 (DIROFD HOSTNAME . SEARCHSTATE))

(RECORD M44DIRSEARCHSTATE
 (DIRPTR . CHARLIST))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS BETWEEN MACRO 
(OPENLAMBDA (V LO HI)
  (AND (IGEQ V LO)
       (ILEQ V HI))))
)
)
(DEFINEQ

(\OPENDISKDEVICE

  (LAMBDA (PARTITION DSKOBJ)                                 (* JonL "19-JUL-83 03:13")

    (DECLARE
 (GLOBALVARS \MAINDISK))                         (* Creates the model 44 DSK device and opens its 

							     SYSDIR.)

    (PROG ((NAME (COND
		   ((ZEROP PARTITION)
		     (QUOTE DSK))
		   (T (PACK* (QUOTE DSK)
			     PARTITION))))
	   FDEV)
          (SETQ FDEV
	    (create
 FDEV
		    DEVICENAME ← NAME
		    RESETABLE ← T
		    RANDOMACCESSP ← T
		    NODIRECTORIES ← T
		    PAGEMAPPED ← T
		    CLOSEFILE ←(FUNCTION \M44CloseFile)
		    DELETEFILE ←(FUNCTION \M44DeleteFile)
		    GETFILEINFO ←(FUNCTION \M44GetFileInfo)
		    GETFILENAME ←(FUNCTION \M44GetFileName)
		    OPENFILE ←(FUNCTION \M44OpenFile)
		    READPAGES ←(FUNCTION \M44ReadPages)
		    SETFILEINFO ←(FUNCTION \M44SetFileInfo)
		    TRUNCATEFILE ←(FUNCTION \M44TruncateFile)
		    WRITEPAGES ←(FUNCTION \M44WritePages)
		    REOPENFILE ←(FUNCTION \M44OpenFile)
		    GENERATEFILES ←(FUNCTION \M44GENERATEFILES)
		    EVENTFN ←(FUNCTION \M44EVENTFN)
		    DIRECTORYNAMEP ←(FUNCTION (LAMBDA (NAME)
                                                             (* Assume host is OK, check that no directory)

			(EQ (NTHCHARCODE NAME -1)
			    (CHARCODE }))))
		    HOSTNAMEP ←(COND
		      ((ZEROP PARTITION)
			(FUNCTION \M44HOSTNAMEP))
		      (T (FUNCTION NILL)))
		    READP ← \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)))
          (replace
 DSKOBJ of
 FDEV with
 (OR DSKOBJ (SETQ DSKOBJ \MAINDISK)))
          (replace
 DISKDEVICENAME of
 DSKOBJ with
 NAME)
          (\DEFINEDEVICE (fetch
 DEVICENAME of
 FDEV)
			 FDEV)
          (RETURN (COND
		    ((\OPENDIR
 FDEV)
		      FDEV)
		    (T                                       (* Oops, it didn't work, take it away)

		       (\DEFINEDEVICE (fetch
 DEVICENAME of
 FDEV)
				      NIL)
		       NIL))))))

(\OPENDIR

  [LAMBDA (FDEV)                                             (* bvm: " 6-APR-83 12:16")

                                                             (* Opens the model44 directory on the current partition)

    (PROG ((PART (fetch
 (M44DEVICE DSKPARTITION) of
 FDEV))
	   STREAM DD)
          (replace
 (M44DEVICE DSKPASSWORDOK) of
 FDEV with
 NIL)
          (COND
	    ((AND (NEQ PART 0)
		  (NOT (\TESTPARTITION PART)))
	      (replace
 (M44DEVICE SYSDIROFD) of
 FDEV with
 NIL)
	      (RETURN)))
          (SETQ STREAM
	    (\M44OPENFILEFROMFP
 FDEV "SYSDIR.;1" (QUOTE BOTH)
				(create
 FID
					W0 ← 100000Q
					W1 ← 144Q
					W2 ← 1
					W3 ← 0
					W4 ← 1)))            (* {DSK}SYSDIR.;1 always has sn 100, leader page on 

							     virtual page 1)

          [replace
 MAXBUFFERS of
 STREAM with
 (IMAX 100Q (ADD1 (fetch
 EPAGE of
 STREAM]
                                                             (* Enough buffers so that directory is effectively 

							     always in core)

          (replace
 (M44DEVICE SYSDIROFD) of
 FDEV with
 STREAM)
          [COND
	    ((NEQ PART 0)
	      (SETQ DD (\OPENDISKDESCRIPTOR
 FDEV))
	      (\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#)
	      (\BINS DD (LOCF (fetch
 (M44DEVICE DISKLASTSERIAL#) of
 FDEV))
		     0 \NBYTES.DISKINFO)
	      (add
 (fetch
 (M44DEVICE DISKLASTSERIAL#) of
 FDEV)
		   3)                                        (* Try to avoid collisions)

	      (COND
		((NOT (\M44CHECKPASSWORD
 FDEV))
		  (replace
 (M44DEVICE SYSDIROFD) of
 FDEV with
 NIL)
		  (RETURN]
          (replace
 (M44DEVICE DSKPASSWORDOK) of
 FDEV with
 T)
          (RETURN STREAM])

(\M44CHECKPASSWORD

  [LAMBDA (DEV)                                              (* bvm: " 6-APR-83 22:37")

    (PROG ((STREAM (\OPENFILE (PACK* (QUOTE {)
				     (fetch
 DEVICENAME of
 DEV)
				     "}SYS.BOOT;1")
			      (QUOTE INPUT)
			      (QUOTE OLD)))
	   PASSVECTOR BUF PASSINFO ASKEDONCE NAME N)
          (COND
	    ((NULL STREAM)
	      (RETURN T)))
          (SETQ PASSVECTOR (\ALLOCBLOCK (FOLDHI \NWORDS.BCPLPASSWORD WORDSPERCELL)))
          (SETFILEPTR STREAM \OFFSET.BCPLPASSWORD)
          (\BINS STREAM PASSVECTOR 0 (UNFOLD \NWORDS.BCPLPASSWORD BYTESPERWORD))
          (COND
	    ((ZEROP (\GETBASE PASSVECTOR 0))                 (* No password)

	      (\CLOSEFILE STREAM)
	      (RETURN T)))
          (SETFILEPTR STREAM \OFFSET.BCPLUSERNAME)
          [SETQ NAME (ALLOCSTRING (SETQ N (\BIN STREAM]      (* Read in a bcpl string which is the username installed

							     on the disk)

          (\BINS STREAM (fetch
 (STRINGP BASE) of
 NAME)
		 0 N)
          (\CLOSEFILE STREAM)
      LP  (SETQ PASSINFO (\INTERNAL/GETPASSWORD (fetch
 DEVICENAME of
 DEV)
						ASKEDONCE NIL NIL NAME))
          (COND
	    ((NULL PASSINFO)
	      (RETURN NIL)))
          (COND
	    ((UNINTERRUPTABLY
                 (SETQ BUF (\GETPACKETBUFFER))               (* HORRIBLE CHEAP TRICK to get some emulator space)

		 (\BLT (\ADDBASE BUF 100Q)
		       PASSVECTOR \NWORDS.BCPLPASSWORD)
		 (SetBcplString (\ADDBASE BUF (IPLUS 100Q \NWORDS.BCPLPASSWORD))
				(CDR PASSINFO))
		 (\CHECKBCPLPASSWORD (\ADDBASE BUF (IPLUS 100Q \NWORDS.BCPLPASSWORD))
				     (\ADDBASE BUF 100Q)))
	      (RETURN T))
	    (T (SETQ ASKEDONCE T)
	       (GO LP])

(\M44HOSTNAMEP

  [LAMBDA (NAME DEV)                                         (* bvm: " 6-APR-83 12:28")

    (PROG (PARTNUM)
          (RETURN (COND
		    ((AND (STRPOS (QUOTE DSK)
				  NAME 1 NIL T)
			  (SETQ PARTNUM (FIXP (SUBATOM NAME 4)))
			  (\TESTPARTITION PARTNUM))
		      (COND
			((EQ PARTNUM (DISKPARTITION))
			  (RETURN DEV))
			(T (\OPENDISK PARTNUM])
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \OFFSET.BCPLUSERNAME
 512)

(RPAQQ \OFFSET.BCPLPASSWORD
 768)

(RPAQQ \NWORDS.BCPLPASSWORD
 9)

(CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD \NWORDS.BCPLPASSWORD)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\OPENDISKDEVICE 0)
(OR (BOUNDP (QUOTE \CONNECTED.DIR))
    (CNDIR))
)



(* SYSOUT etc)


(DEFINEQ

(\COPYSYS

  [LAMBDA (FILE SYSNAME)                                     (* bvm: "14-JUN-83 16:01")

    (DECLARE
 (GLOBALVARS SYSOUTCURSOR))
    (RESETLST
      (RESETSAVE \VMEM.INHIBIT.WRITE T)                      (* Prevent dirty pages from being written after the 

							     \FLUSHVM)

      (PROG (FL STREAM VAL)
	RETRY
	    (RECLAIM)
	    (RETURN
	      (PROG1 (COND
		       ([NULL (SETQ VAL
				(OR (\FLUSHVM)
				    (PROGN [SETQ FL (OPENFILE
					       FILE
					       (QUOTE OUTPUT)
					       (QUOTE NEW)
					       NIL
					       (CONS (LIST (QUOTE LENGTH)
							   (UNFOLD (fetch
 (IFPAGE NActivePages)
								      of
 \InterfacePage)
								   BYTESPERPAGE))
						     (QUOTE ((SEQUENTIAL T)
							      (TYPE BINARY]
					   (SETQ STREAM (GETSTREAM FL))
					   (RESETSAVE NIL
						      (LIST [FUNCTION (LAMBDA (FILE)
								(CLOSEF FILE)
								(AND RESETSTATE
								     (DELFILE (fetch
 FULLNAME
										 of
 FILE]
							    STREAM))
					   (COND
					     (SYSNAME (SET SYSNAME FL)))
					   [RESETSAVE (CURSOR (COND
								((type?
 CURSOR SYSOUTCURSOR)
                                                             (* Comes from a later file)

								  SYSOUTCURSOR)
								(T T]
					   (\COPYSYS1
 STREAM]

          (* First is T when resuming this vmem; second is starting the sysout. If \COPYSYS1 did not itself do a \FLUSHVM, 

	  the second would never return T, yes? NIL is normal return, <fixp> is error return)


                                                             (* Continuing in the current image)

			 FL)
		       ((AND (SMALLP VAL)
			     (IGREATERP 0 VAL))              (* Error occurred while making sysout.)

			 (LISPERROR (IMINUS VAL)
				    FL)
			 (GO RETRY))
		       (T                                    (* Starting sysout)

			  (\CLEARSYSBUF)
			  (CLEARMOUSEBUF)
			  (\RESETKEYBOARD)
			  (LIST FL)))
		     (\RESETKEYBOARD])

(\COPYSYS1

  [LAMBDA (STREAM)                                           (* bvm: "28-JUN-83 15:02")

    (COND
      [(type?
 M44DEVICE (fetch
 DEVICE of
 STREAM))            (* Haven't quite worked out the buffer strategy yet)

	(\M44FLUSHDISKDESCRIPTOR
 (fetch
 DEVICE of
 STREAM))
	(replace
 DDVALID of
 (fetch
 DEVICE of
 STREAM) with
 NIL)
	(PROG1 (\COPYSYS0SUBR (fetch
 (ARRAYP BASE) of
 (fetch
 FID of
 STREAM)))
	       (replace
 LastPage of
 STREAM with
 (replace
 EPAGE of
 STREAM with
 (fetch
 (IFPAGE 
										     NActivePages)
										 of
 \InterfacePage)))
	       (replace
 LastOffset of
 STREAM with
 (replace
 EOFFSET of
 STREAM with
 0]
      (T (PROG ((PAGEMAPPED (fetch
 PAGEMAPPED of
 (fetch
 DEVICE of
 STREAM)))
		(NBUFS (SUB1 \#EMUBUFFERS))
		(BUFBASE \EMUBUFFERS)
		(FIRSTPAGE 2)
		(LASTPAGE (fetch
 (IFPAGE NActivePages) of
 \InterfacePage))
		(CURSORBAR \EM.CURSORBITMAP)
		(CURSORMASK (LLSH 1 (SUB1 BITSPERWORD)))
		(DOMINOPAGE (fetch
 LastDominoFilePage of
 \InterfacePage))
		CURSORINC CURSORNEXT LASTPAGESEEN NPAGES BUFFERS DAS)
	       (RESETSAVE \#SWAPBUFFERS 1)                   (* Reduce us to one swap buffer, so we can use the rest 

							     for copying the vmem)

	       (RESETSAVE \EMUSWAPBUFFERS (\ADDBASE BUFBASE (UNFOLD NBUFS WORDSPERPAGE)))
	       (RESETSAVE \#DISKBUFFERS (COND
			    ((type?
 M44DEVICE (fetch
 DEVICE of
 STREAM))
                                                             (* Need some space for disk to run)

			      (SETQ NBUFS (LRSH NBUFS 1))
			      (SETQ BUFBASE (\ADDBASE BUFBASE (UNFOLD NBUFS WORDSPERPAGE)))
			      NBUFS)
			    (T 0)))
	       (SETQ DAS (ARRAY (IPLUS NBUFS 2)
				(QUOTE WORD)
				NIL 0))
	       (SETQ BUFFERS (to
 NBUFS as
 (BUF ← BUFBASE) by
 (\ADDBASE BUF WORDSPERPAGE)
				collect
 BUF))
	       [SETQ CURSORINC (SETQ CURSORNEXT (FOLDLO LASTPAGE (ITIMES 16 16]
                                                             (* How often to do something to the cursor)

	       (COND
		 ((ZEROP DOMINOPAGE)                         (* First page to write is the ISF map page, which should

							     be blank in a sysout)

		   (\ZEROPAGE (fetch
 (POINTER PAGE#) of
 BUFBASE))
		   (SETA DAS 1 (fetch
 ISFDA2 of
 \ISFMAP)))
		 ((EQ \MACHINETYPE \DANDELION)
		   (\DL.ACTONVMEMFILE DOMINOPAGE BUFBASE 1))
		 (T (SETA DAS 1 (\LOOKUPFMAP DOMINOPAGE))    (* Copy the first domino page, stashed at the end of the

							     Domino area, into page 1 for a good Dandelion boot 

							     image)

		    (\ACTONDISKPAGES \MAINDISK BUFBASE (fetch
 (ARRAYP BASE) of
 DAS)
				     (SUB1 DOMINOPAGE)
				     \ISFMAP DOMINOPAGE DOMINOPAGE \DC.READD)
		    (SETA DAS 1 (fetch
 ISFDA2 of
 \ISFMAP))   (* Prepare DAS to start reading at page 2)

		    ))
	       (COND
		 (PAGEMAPPED (replace
 EPAGE of
 STREAM with
 LASTPAGE)
                                                             (* Set up end of file correctly.

							     LASTPAGE is last alto page (full), which is last Lisp 

							     page plus 1)

			     (replace
 EOFFSET of
 STREAM with
 0)
			     (\WRITEPAGES STREAM 0 (CAR BUFFERS)))
		 (T (\BOUTS STREAM (CAR BUFFERS)
			    0 BYTESPERPAGE)))
	       (while
 (ILEQ FIRSTPAGE LASTPAGE)
		  do
 [COND
		       ((IGEQ FIRSTPAGE CURSORNEXT)          (* Gradually complement the cursor)

			 (\PUTBASE CURSORBAR 0 (LOGXOR (\GETBASE CURSORBAR 0)
						       CURSORMASK))
			 (add
 CURSORNEXT CURSORINC)
			 (COND
			   ((ZEROP (SETQ CURSORMASK (LRSH CURSORMASK 1)))
			     (SETQ CURSORBAR (\ADDBASE CURSORBAR 1))
			     (SETQ CURSORMASK (LLSH 1 (SUB1 BITSPERWORD]
		     [COND
		       ((EQ \MACHINETYPE \DANDELION)
			 [\DL.ACTONVMEMFILE FIRSTPAGE BUFBASE (SETQ NPAGES
					      (IMIN NBUFS (ADD1 (IDIFFERENCE LASTPAGE FIRSTPAGE]
			 (SETQ LASTPAGESEEN (IPLUS FIRSTPAGE NPAGES -1)))
		       (T (for
 I from
 2 to
 (ADD1 NBUFS) do
 (SETA DAS I \FILLINDA))
			  (SETQ LASTPAGESEEN (\ACTONDISKPAGES \MAINDISK BUFFERS (fetch
 (ARRAYP BASE)
										   of
 DAS)
							      (SUB1 FIRSTPAGE)
							      \ISFMAP FIRSTPAGE
							      (IMIN (IPLUS FIRSTPAGE NBUFS -1)
								    LASTPAGE)
							      \DC.READD))
			  (SETQ NPAGES (ADD1 (IDIFFERENCE LASTPAGESEEN FIRSTPAGE)))
			  (SETA DAS 1 (ELT DAS (ADD1 NPAGES]
                                                             (* Read NBUFS pages from vmem)

		     [COND
		       ((NOT PAGEMAPPED)                     (* Have to just ship the bits)

			 (\BOUTS STREAM BUFBASE 0 (UNFOLD NPAGES BYTESPERPAGE)))
		       (T (\WRITEPAGES STREAM (SUB1 FIRSTPAGE)
				       (COND
					 ((IGEQ LASTPAGESEEN LASTPAGE)
					   BUFFERS)
					 (T                  (* Don't write too many pages on the last pass if NPAGES

							     is less than length of BUFFERS)

					    (to
 NPAGES as
 BUF in
 BUFFERS collect
 BUF]
                                                             (* Write them to output)

		     (SETQ FIRSTPAGE (ADD1 LASTPAGESEEN)))
	       (RETURN NIL])
)



(* Stats code. On MOD44IO because it writes on the disk and uses records not exported from 
MOD44IO)


(DEFINEQ

(GATHERSTATS

  [LAMBDA (FILENAME)                                         (* bvm: "26-DEC-81 23:57")


          (* Enables and disables statistics gathering. Uses low level file operations to avoid stats file being visible 

	  from Lisp b/c the file position is not updated as it is written)



    (DECLARE
 (GLOBALVARS \STATSON))
    (COND
      [FILENAME (AND \STATSON (GATHERSTATS
))
		(SELECTQ (FILENAMEFIELD FILENAME (QUOTE HOST))
			 (DSK)
			 (NIL (SETQ FILENAME (PACKFILENAME (QUOTE HOST)
							   (QUOTE DSK)
							   (QUOTE BODY)
							   FILENAME)))
			 (ERROR "STATS FILE MUST BE ON DSK" FILENAME))
		(SETQ \STATSON T)
		(\GATHERSTATS (PROG [(STREAM (\OPENFILE FILENAME (QUOTE OUTPUT)
							(QUOTE NEW]
                                                             (* CLose before doing stats, cause file isn't really 

							     open from Lisp's point of view.)

				    (RETURN (fetch
 (ARRAYP BASE) of
 (fetch
 FID
								       of
 (PROG1 STREAM (\CLOSEFILE
										   STREAM]
      (\STATSON (\GATHERSTATS)
		(SETQ \STATSON NIL])
)

(RPAQQ \STATSON
 NIL)
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)

(FILESLOAD (LOADCOMP)
	   LLBFS)
)
(PUTPROPS MOD44IO COPYRIGHT ("Xerox Corporation" 1981 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2622 38139 (\M44AddDiskPages 2632 . 3613) (\M44AllocFilePageMap 3615 . 4062) (
\M44CloseFile 4064 . 4525) (\M44CompleteFH 4527 . 7320) (\M44CREATEFILE 7322 . 10619) (\M44DeleteFile 
10621 . 11711) (\M44EVENTFN 11713 . 12584) (\M44ExtendFilePageMap 12586 . 13871) (\M44FillInMap 13873
 . 14326) (\M44GENERATEFILES 14328 . 16584) (\M44GetAccessTime 16586 . 17212) (\M44GetFileHandle 17214
 . 18893) (\M44GetFileInfo 18895 . 20481) (\M44GetFileName 20483 . 20696) (\M44GetPageLoc 20698 . 
21410) (\M44KillFilePageMap 21412 . 21742) (\M44MAKEDIRENTRY 21744 . 23257) (\M44NEXTFILEFN 23259 . 
25528) (\M44OpenFile 25530 . 27996) (\M44OPENFILEFROMFP 27998 . 28652) (\M44ReadDiskPage 28654 . 29857
) (\M44ReadLeaderPage 29859 . 30672) (\M44ReadPages 30674 . 31005) (\M44ReleasePages 31007 . 31648) (
\M44SetAccessTimes 31650 . 32560) (\M44SetEndOfFile 32562 . 33610) (\M44SetFileInfo 33612 . 33939) (
\M44TruncateFile 33941 . 34949) (\M44WriteDiskPage 34951 . 37131) (\M44WriteLeaderPage 37133 . 37605) 
(\M44WritePages 37607 . 38137)) (38140 51407 (\ADDDISKPAGES 38150 . 39541) (\GETPAGEHINT 39543 . 40701
) (\M44DELETEPAGES 40703 . 43551) (\ASSIGNDISKPAGE 43553 . 45827) (\COUNTDISKFREEPAGES 45829 . 46561) 
(\M44MARKPAGEFREE 46563 . 47474) (\M44FLUSHDISKDESCRIPTOR 47476 . 48241) (\MAKELEADERDAS 48243 . 48855
) (\CREATE.FID.FOR.DD 48857 . 49493) (\OPENDISK 49495 . 50435) (DISKFREEPAGES 50437 . 51237) (VMEMSIZE
 51239 . 51405)) (52493 70744 (\FILESPEC 52503 . 54641) (\FINDDIRHOLE 54643 . 55736) (\LISPFILENAME 
55738 . 56456) (\LOOKUPVERSIONS 56458 . 61122) (\OPENDISKDESCRIPTOR 61124 . 62787) (\READDIRFPTR 62789
 . 63232) (\SEARCHDIR1 63234 . 65576) (\UNPACKFILENAME 65578 . 70390) (\WRITEDIRFPTR 70392 . 70742)) (
70745 71339 (ALTOFILENAME 70755 . 71337)) (71928 78048 (\OPENDISKDEVICE 71938 . 74224) (\OPENDIR 74226
 . 75982) (\M44CHECKPASSWORD 75984 . 77670) (\M44HOSTNAMEP 77672 . 78046)) (78411 85608 (\COPYSYS 
78421 . 80385) (\COPYSYS1 80387 . 85606)) (85718 86824 (GATHERSTATS 85728 . 86822)))))
STOP