(FILECREATED " 9-Sep-85 14:35:32" {ERIS}<LISP>INTERMEZZO>PATCHES>LOCALFILEPATCH.;3
 17985  

      previous date: " 7-Sep-85 18:11:45" {ERIS}<LISP>INTERMEZZO>PATCHES>LOCALFILEPATCH.;2)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LOCALFILEPATCHCOMS)

(RPAQQ LOCALFILEPATCHCOMS
 ((* * check)
			   (P (OR (EQ MAKESYSNAME (QUOTE INTERMEZZO))
				  (ERROR "WRONG PATCH FOR THIS SYSOUT")))
			   (* * Fixes SETFILEPTR bug.)
			   (FILES LFSETFILEPTRPATCH)
			   (* * Root directory management)
			   (FNS \PFFindDirectoryID \PFInsertDirectoryID \PFRemoveDirectoryID)
			   (FNS \PFFindRootDirEntry \PFAddRootDirEntry \PFRemoveRootDirEntry 
				\PFFindRootDirEntryNum \PFPatchRootDirEntries)
			   (FNS \PFGetRootDirectory \PFPutRootDirectory \PFCreateRootDirectory 
				\PFPurgeRootDirectory)
			   (FNS \GetRootDirectoryType \PFPutRootDirectoryType)
			   (* * Scavenger should create device when necessary.)
			   (FNS SCAVENGEDSKDIRECTORY \LFScavVersion \LFScavFileName 
				\VFMGenerateFileIDs)
			   (* * Fix multiple opens problem)
			   (FNS \LFOpenFile)))
(* * check)


(OR (EQ MAKESYSNAME (QUOTE INTERMEZZO))
    (ERROR "WRONG PATCH FOR THIS SYSOUT"))
(* * Fixes SETFILEPTR bug.)


(FILESLOAD LFSETFILEPTRPATCH)
(* * Root directory management)


(DEFINEQ

(\PFFindDirectoryID

  (LAMBDA (vol type)                                         (* hts: "18-Dec-84 16:45")


          (* * If on vol there is a directory associated with the specified file type, returns the fileID associated with that

	  directory; else returns NIL)



    (
PROG
 ((rootDir (create
 RootDirectory)))
          (
RETURN
 (if
 (\PFGetRootDirectory
 vol rootDir)
		      then
 (\PFFindRootDirEntry
 type rootDir)
		    else
 NIL)))))

(\PFInsertDirectoryID

  (LAMBDA (vol type directoryID)                             (* hts: "18-Dec-84 16:43")


          (* * comment)



    (
PROG
 ((rootDir (create
 RootDirectory)))

          (* * get root directory page if there is one. Else make place for one.)



          (if
 (
NOT
 (\PFGetRootDirectory
 vol rootDir))
	      then
 (\PFCreateRootDirectory
 vol rootDir))

          (* * Add specified (type directoryID) pair)



          (\PFAddRootDirEntry
 type directoryID rootDir)

          (* * write out modified root directory)



          (\PFPutRootDirectory
 vol rootDir))))

(\PFRemoveDirectoryID

  (LAMBDA (vol type)                                         (* hts: " 2-Jan-85 20:52")


          (* * comment)



    (
PROG
 ((rootDir (create
 RootDirectory)))
          (if
 (\PFGetRootDirectory
 vol rootDir)
	      then
 (if
 (
LEQ
 (fetch
 (RootDirectory countEntries) of
 rootDir)
			    1)
		       then
 (\PFPurgeRootDirectory
 vol rootDir)
		     else
 (\PFRemoveRootDirEntry
 type rootDir)
			  (\PFPutRootDirectory
 vol rootDir))))))
)
(DEFINEQ

(\PFFindRootDirEntry

  (LAMBDA (type rootDir)                                     (* hts: " 4-Jul-85 18:58")


          (* * look through registered directories to find the desired one. Stored as an array of (type directoryFileID) 

	  pairs.)



    (\PFPatchRootDirEntries
 type rootDir)
    (LET ((entryNum (\PFFindRootDirEntryNum
 type rootDir)))
         (
AND
 entryNum (fetch
 (RootDirEntry file) of
 (MESAELT (fetch
 (RootDirectory entries)
								 of
 rootDir)
							      RootDirEntryArray entryNum))))))

(\PFAddRootDirEntry

  (LAMBDA (type directoryID rootDir)                         (* hts: " 4-Jul-85 18:41")


          (* * Add specified (type directoryID) pair)



    (UNINTERRUPTABLY
        (
PROG
 ((entryNum (fetch
 (RootDirectory countEntries) of
 rootDir)))
	      (MESASETA (fetch
 (RootDirectory entries) of
 rootDir)
			RootDirEntryArray entryNum (create
 RootDirEntry
							   type _ type
							   file _ directoryID))
	      (replace
 (RootDirectory countEntries) of
 rootDir with
 (
ADD1
 entryNum))))))

(\PFRemoveRootDirEntry

  (LAMBDA (type rootDir)                                     (* hts: " 4-Jul-85 18:58")


          (* * comment)



    (UNINTERRUPTABLY
        (
PROG
 ((nuke (\PFFindRootDirEntryNum
 type rootDir)))
	      (if
 nuke
		  then
 (bind
 (directories _(fetch
 (RootDirectory entries) of
 rootDir)) for
 entryNum
			  from
 (
ADD1
 nuke) to
 (fetch
 (RootDirectory countEntries) of
 rootDir)
			  do
 (MESASETA directories RootDirEntryArray (
SUB1
 entryNum)
				       (MESAELT directories RootDirEntryArray entryNum)))
		       (add
 (fetch
 (RootDirectory countEntries) of
 rootDir)
			    -1))))))

(\PFFindRootDirEntryNum

  (LAMBDA (type rootDir)                                     (* hts: " 9-Aug-85 18:11")


          (* * look through registered directories to find the desired one. Stored as an array of (type directoryFileID) 

	  pairs.)



    (bind
 (directories _(fetch
 (RootDirectory entries) of
 rootDir)) for
 entryNum from
 0
       to
 (
SUB1
 (fetch
 (RootDirectory countEntries) of
 rootDir))
       thereis
 (
EQ
 (fetch
 (RootDirEntry type) of
 (MESAELT directories RootDirEntryArray entryNum))
		   type))))

(\PFPatchRootDirEntries

  (LAMBDA (type rootDir)                                     (* hts: " 4-Jul-85 18:58")


          (* * Quietly patch up an off-by-one that was in Intermezzo.)



    (\PFRemoveRootDirEntry
 0 rootDir)
    (add
 (fetch
 (RootDirectory countEntries) of
 rootDir)
	 1)))
)
(DEFINEQ

(\PFGetRootDirectory

  (LAMBDA (vol rootDir)                                      (* hts: " 5-Jan-85 16:26")


          (* * Reads in and returns the root directory for the specified volume, provided that it is there;

	  else returns NIL)



    (if
 (
NEQ
 (\GetRootDirectoryType
 vol)
	     tRootDirectory)
	then
 NIL
      else
 (
PROG
 ((fileD (create
 FileDescriptor
				 fileID _ tRootDirectory
				 volNum _(
\PFVolumeNumber
 vol)
				 type _ tRootDirectory
				 size _ 1))
		  where)

          (* * find location of root directory page)



	         (
SETQ
 where (
\VFMGetPageGroup
 vol fileD 0))
	         (
OR
 where (
RETURN
 NIL))

          (* * read in root directory page)



	         (
\PFGetPage
 fileD 0 (fetch
 (PageGroup volumePage) of
 where)
			     rootDir)
	         (
RETURN
 T)))))

(\PFPutRootDirectory

  (LAMBDA (vol rootDir)                                      (* edited: "20-Jan-85 16:01")


          (* * comment)



    (
PROG
 ((fileD (create
 FileDescriptor
			  fileID _ tRootDirectory
			  volNum _(
\PFVolumeNumber
 vol)
			  type _ tRootDirectory
			  size _ 1))
	   where)

          (* * find location of root directory page)



          (
SETQ
 where (
\VFMGetPageGroup
 vol fileD 0))
          (
OR
 where (DiskError "HARD DISK ERROR" "Can't find volume root directory"))

          (* * read in root directory page)



          (
\PFPutPage
 fileD 0 (fetch
 (PageGroup volumePage) of
 where)
		      rootDir))))

(\PFCreateRootDirectory

  (LAMBDA (vol rootDir)                                      (* hts: " 9-Aug-85 12:25")


          (* * comment)



    (UNINTERRUPTABLY
        (
PROG
 ((fileD (create
 FileDescriptor
			      fileID _ tRootDirectory
			      volNum _(
\PFVolumeNumber
 vol)
			      type _ tRootDirectory
			      size _ 0)))
	      (
OR
 (
\PFNewPages
 vol fileD (create
 PageGroup
						 filePage _ 0
						 nextFilePage _ 1))
		  (DiskError "FILE SYSTEM RESOURCES EXCEEDED"))
	      (\PFPutRootDirectory
 vol rootDir)
	      (\PFPutRootDirectoryType
 vol tRootDirectory)))))

(\PFPurgeRootDirectory

  (LAMBDA (vol rootDir)                                      (* hts: " 5-Jan-85 16:15")


          (* * comment)



    (UNINTERRUPTABLY
        (
PROG
 ((fileD (create
 FileDescriptor
			      fileID _ tRootDirectory
			      volNum _(
\PFVolumeNumber
 vol)
			      type _ tRootDirectory
			      size _ 1)))
	      (\PFPutRootDirectoryType
 vol tUnassigned)
	      (
\PFTrimHelper
 vol fileD 0)))))
)
(DEFINEQ

(\GetRootDirectoryType

  (LAMBDA (vol)                                              (* hts: "18-Dec-84 21:55")


          (* * comment)



    (fetch
 (LogicalVolumeDescriptor volumeRootDirectory) of
 vol)))

(\PFPutRootDirectoryType

  (LAMBDA (vol directoryID)                                  (* hts: "18-Dec-84 19:16")


          (* * comment)



    (replace
 (LogicalVolumeDescriptor volumeRootDirectory) of
 vol with
 directoryID)
    (
\PFPutLogicalVolumePage
 vol vol)
    (
PROG
 ((markerPage (create
 SubVolumeMarkerPage)))
          (
\PFGetMarkerPage
 vol markerPage)
          (replace
 (LogicalSubVolumeMarker volumeRootDirectory) of
 markerPage with
 directoryID)
          (
\PFPutMarkerPage
 vol markerPage))))
)
(* * Scavenger should create device when necessary.)


(DEFINEQ

(SCAVENGEDSKDIRECTORY

  (LAMBDA (volName SILENT)                                   (* edited: "28-Aug-85 14:21")


          (* If your BTree is intact but your directory is smashed, this routine will scavenge your volume by building a new 

	  directory which associates all fileIDs in the BTree with a gensym filename)



    (WITH.MONITOR \LFtopMonitor
		  (
PROG
 ((vol (
\LFEntryPoint
 volName))
			 DIRECTORY LISPDIRECTORY LISPFILES)
		        (if
 (
NOT
 (
\PFPilotVolumeP
 vol))
			    then
 (
ERROR
 "Non-pilot volume"))

          (* * Find the file ID's of the Lisp directory and all the Lisp files on the specified volume.)



		        (
SETQ
 LISPDIRECTORY (\VFMGenerateFileIDs
 vol tLispDirectory))
		        (
SETQ
 LISPFILES (\VFMGenerateFileIDs
 vol tLispFile))

          (* * If there are no Lisp files of any sort on the volume, abort)



		        (if
 (
AND
 (
NULL
 LISPDIRECTORY)
				 (
NULL
 LISPFILES))
			    then
 (
RETURN
 NIL))

          (* * This block throws away the old directory and builds a new one. It must be atomic.)



		        (UNINTERRUPTABLY

          (* * If there is an old directory, get rid of it.)



			    (
\LFPurgeDirectory
 vol)
			    (if
 (
NOT
 SILENT)
				then
 (printout NIL "Deleted old directory." T))

          (* * Create a fresh directory)



			    (if
 (type?
 LFDEV (
\GETDEVICEFROMNAME
 (
QUOTE
 DSK)))
				then
 (
\LFMakeVolumeDirectory
 vol)
			      else
 (
\LFMakeVolumeDirectory
 vol T)
				   (
\LFOpenDevice
))
			    (
\PFDsplyVolumes
)
			    (if
 (
NOT
 SILENT)
				then
 (printout NIL "Created new directory." T))

          (* * For each file in volume file map, enter this fileID into the new directory)



			    (for
 fileID in
 LISPFILES
			       do
 (
PROG
 ((stream (
\LFOpenOldFile
 (create
 FileDescriptor
									 fileID _ fileID
									 volNum _(
\PFVolumeNumber

									   vol)
									 type _ tLispFile)
								 NIL NIL))
					 DIRINDEX UNAME NAME&VERSION NAME VERSION)
				        (
SETQ
 NAME&VERSION (fetch
 (LeaderPage fileName)
							      of
 (fetch
 (DLIONSTREAM LEADERPAGE)
								    of
 stream)))
				        (
SETQ
 NAME (\LFScavFileName
 NAME&VERSION))
				        (
SETQ
 VERSION (\LFScavVersion
 NAME&VERSION fileID))
				        (
SETQ
 UNAME (create
 ExpandedName
							    VOLNUM _(
\PFVolumeNumber
 vol)
							    CHARLIST _ NAME
							    VERSION _ VERSION))
				        (
SETQ
 DIRINDEX (
\LFFindDirHole
 stream UNAME (
\LFGetDirectory

									 vol)))
				        (if
 (
NULL
 DIRINDEX)
					    then
 (
LISPERROR
 "HARD DISK ERROR" 
							    "Can't rebuild directory"))
				        (
\LFMakeDirEntry
 stream UNAME (
\LFGetDirectory
 vol)
							 DIRINDEX)
				        (if
 (
NOT
 SILENT)
					    then
 (PRINTOUT NIL "Added " (
PACKC
 NAME)
							   ";" VERSION " to directory." T)))))

          (* * Return the name of the new directory)



		        (
RETURN
 (
PACKFILENAME.STRING
 (
QUOTE
 HOST)
						     (
QUOTE
 DSK)
						     (
QUOTE
 DIRECTORY)
						     (
U-CASE
 (fetch
 (LogicalVolumeDescriptor LVlabel)
								of
 vol))))))))

(\LFScavVersion

  (DLAMBDA ((NAME&VERSION (ONEOF ATOM STRINGP))
            (FILEID FIXP)
            (RETURNS SMALLP))
                                                             (* hts: " 4-Mar-85 17:27")


          (* * Fetch the version number from NAME&VERSION. If it's garbled (ie, isn't a fixp) use the fileID as a version 

	  number instead (the fileID will at least give the file a unique version number and so avoid version number clashes))



    (
OR
 (
SMALLP
 (
FILENAMEFIELD
 NAME&VERSION (
QUOTE
 VERSION)))
	(
SMALLP
 FILEID)
	(
RAND
 1 MAX.SMALLP))))

(\LFScavFileName

  (DLAMBDA ((NAME&VERSION (ONEOF ATOM STRINGP))
            (RETURNS (
LISTP
 OF SMALLP)))
                                                             (* mjs "28-Feb-85 20:15")


          (* * Extract the filename part of NAME&VERSION (ignore version number) and return it as a list of charcode)



    (
PROG
 ((NAME (for
 C instring
 (
MKSTRING
 NAME&VERSION) until
 (
EQ
 C (
CHARCODE
 ;)) collect
 C)))
          (
RETURN
 (if
 (
OR
 (
NULL
 NAME)
			  (for
 C in
 NAME thereis
 (
EQ
 (
\LFCASEARRAYFETCH
 C)
						     0)))
		      then
 

          (* * If there is an illegal char in the filename, or the filename is the empty string, gin up a random filename)



			   (
CHCON
 (
GENSYM
 (
QUOTE
 TRASHEDFILENAME)))
		    else
 

          (* * Otherwise return the filename found)



			 NAME)))))

(\VFMGenerateFileIDs

  (DLAMBDA ((vol LogicalVolumeDescriptor)
            (desiredType SMALLP)
            (RETURNS (LST OF FIXP)))
                                                             (* hts: "16-Feb-85 21:40")


          (* * Returns a list of the fileIDs of all the keys in the BTree with type = desiredType)



    (WITH.MONITOR \VFMmonitor (UNINTERRUPTABLY
                                  (
\VFMContextSet
 vol)
				  (bind
 (currentKey _(create
 Key))
				     until
 (
PROGN
 (replace
 (Key filePage) of
 currentKey with
 MAX.FIXP)
						  (MESASETQ currentKey (fetch
 (Interval nextKey)
									  of
 (
\VFMGet
 currentKey 0))
							    Key)
						  (
EQP
 (fetch
 (Key fileID) of
 currentKey)
						       \VFMmaxID))
				     when
 (
EQ
 (fetch
 (Key type) of
 currentKey)
					      desiredType)
				     collect
 (fetch
 (Key fileID) of
 currentKey))))))
)
(* * Fix multiple opens problem)


(DEFINEQ

(\LFOpenFile

  (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)       (* hts: " 7-Sep-85 18:05")


          (* * Open a Model44 file. Gets the physical end of file and sets up ofd)



    (WITH.MONITOR \LFtopMonitor (
PROG
 ((
DATE
 (
FASSOC
 (
QUOTE
 CREATIONDATE)
						     OTHERINFO)))

          (* * Normalize creationdate. User can supply a bad creationdate. If normalization is done at a lower level in 

	  uninterruptable code, and if IDATE signals an error, the result will be a 9318 crash rather than an error break.)



				      (if
 DATE
					  then
 (
RPLACA
 (
CDR
 DATE)
						       (
IDATE
 (
CADR
 DATE))))

          (* * Force everything through GetStreamForFile to (even if it was already a stream) to force the file system to 

	  check the directory and rebuild the stream and all info cached in it.)



				      (if
 (type?
 DLIONSTREAM FILE)
					  then
 (
SETQ
 FILE (fetch
 (DLIONSTREAM FULLFILENAME)
							     of
 FILE)))
				      (
SETQ
 FILE (
\LFGetStreamForFile
 FILE RECOG ACCESS
								      (
NEQ
 ACCESS (
QUOTE
 INPUT))
								      OTHERINFO))

          (* * If GetStreamForFile returned NIL, then the file didn't exist; return NIL instead of a stream.)



				      (if
 (
NOT
 (type?
 DLIONSTREAM FILE))
					  then
 (
RETURN
 NIL))

          (* * If this file is already open in a conflicting way, cause an error and throw the stream away.

	  This should not be necessary: it should be handled by the generic openfile code, and it is in releases subsequent to

	  Intermezzo.)



				      (if
 (for
 S in
 \OPENFILES
					     thereis
 (
AND
 (
EQ
 (fetch
 (DLIONSTREAM FULLFILENAME)
								 of
 FILE)
							      (fetch
 (STREAM FULLFILENAME)
								 of
 S))
							  (
OR
 (
EQ
 (
QUOTE
 BOTH)
								  (fetch
 (STREAM ACCESS)
								     of
 S))
							      (
EQ
 (
QUOTE
 OUTPUT)
								  (fetch
 (STREAM ACCESS)
								     of
 S)))))
					  then
 (
LISPERROR
 "FILE WONT OPEN" (fetch
 (DLIONSTREAM 
										     FULLFILENAME)
									      of
 FILE))
					       (
RETURN
 NIL))

          (* * Output stream is empty even if it is old.)



				      (if
 (
EQ
 ACCESS (
QUOTE
 OUTPUT))
					  then
               (* File is EMPTY even if it is old)

					       (replace
 EPAGE of
 FILE
						  with
 (replace
 EOFFSET of
 FILE with
 0)))

          (* * Update access dates. For REOPENFILE op, don't change dates)



				      (
\LFUpdateLeaderPage
 FILE
							   (if
 (
AND
 (
NOT
 OLDSTREAM)
								    (
NOT
 (
FMEMB
 (
QUOTE
 
										DON'T.CHANGE.DATE)
										OTHERINFO)))
							       then
 ACCESS
							     else
 NIL))

          (* * Return the stream you've just built.)



				      (
RETURN
 FILE)))))
)
(PUTPROPS LOCALFILEPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1311 2975 (\PFFindDirectoryID 1321 . 1807) (\PFInsertDirectoryID 1809 . 2452) (
\PFRemoveDirectoryID 2454 . 2973)) (2976 5682 (\PFFindRootDirEntry 2986 . 3536) (\PFAddRootDirEntry 
3538 . 4096) (\PFRemoveRootDirEntry 4098 . 4780) (\PFFindRootDirEntryNum 4782 . 5363) (
\PFPatchRootDirEntries 5365 . 5680)) (5683 8321 (\PFGetRootDirectory 5693 . 6563) (\PFPutRootDirectory
 6565 . 7251) (\PFCreateRootDirectory 7253 . 7870) (\PFPurgeRootDirectory 7872 . 8319)) (8322 9118 (
\GetRootDirectoryType 8332 . 8556) (\PFPutRootDirectoryType 8558 . 9116)) (9178 14928 (
SCAVENGEDSKDIRECTORY 9188 . 12479) (\LFScavVersion 12481 . 13077) (\LFScavFileName 13079 . 13976) (
\VFMGenerateFileIDs 13978 . 14926)) (14968 17900 (\LFOpenFile 14978 . 17898)))))
STOP