(FILECREATED "12-Sep-85 21:42:03" {ERIS}<LISPNEW>INTERMEZZO>PATCHES>LOCALFILEPATCH.;2 17786
changes to: (FNS SCAVENGEDSKDIRECTORY \LFOpenFile)
previous date: " 9-Sep-85 14:35:32" {ERIS}<LISP>INTERMEZZO>PATCHES>LOCALFILEPATCH.;3)
(* 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) (* amd "12-Sep-85 21:40")
(* 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))
(\LFMakeDirEntry stream UNAME (\LFGetDirectory vol))
(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) (* amd "12-Sep-85 21:23")
(* * 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 WON'T 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 (1373 3037 (\PFFindDirectoryID 1383 . 1869) (\PFInsertDirectoryID 1871 . 2514) (
\PFRemoveDirectoryID 2516 . 3035)) (3038 5744 (\PFFindRootDirEntry 3048 . 3598) (\PFAddRootDirEntry
3600 . 4158) (\PFRemoveRootDirEntry 4160 . 4842) (\PFFindRootDirEntryNum 4844 . 5425) (
\PFPatchRootDirEntries 5427 . 5742)) (5745 8383 (\PFGetRootDirectory 5755 . 6625) (\PFPutRootDirectory
6627 . 7313) (\PFCreateRootDirectory 7315 . 7932) (\PFPurgeRootDirectory 7934 . 8381)) (8384 9180 (
\GetRootDirectoryType 8394 . 8618) (\PFPutRootDirectoryType 8620 . 9178)) (9240 14739 (
SCAVENGEDSKDIRECTORY 9250 . 12290) (\LFScavVersion 12292 . 12888) (\LFScavFileName 12890 . 13787) (
\VFMGenerateFileIDs 13789 . 14737)) (14779 17701 (\LFOpenFile 14789 . 17699)))))
STOP