(FILECREATED "28-Aug-85 14:23:19" {ERIS}<LISP>JCAI>SOURCES>LOCALFILE.;3 217469
changes to: (FNS SCAVENGEDSKDIRECTORY)
previous date: "14-Aug-85 17:20:22" {ERIS}<LISP>JCAI>SOURCES>LOCALFILE.;2)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LOCALFILECOMS)
(RPAQQ LOCALFILECOMS ((* * This is the Dandelion/Dove local hard disk file system.)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES DECL MESATYPES)
(LOCALVARS . T)
(IGNOREDECL . T))
(* * Declare low-level data types on which all file system modules depend.)
(FNS \PFFetchString \PFReplaceString)
(DECLARE: EVAL@COMPILE DONTCOPY (COMS * PILOTFILECOMPILECOMS))
(INITRECORDS PageGroup FileDescriptor)
(* * Define the various modules of the file system.)
(COMS * LFCOMS)
(COMS * LFDIRECTORYCOMS)
(COMS * SCAVENGEDSKDIRECTORYCOMS)
(COMS * LFPILOTFILECOMS)
(COMS * LFALLOCATIONMAPCOMS)
(COMS * LFFILEMAPCOMS)))
(* * This is the Dandelion/Dove local hard disk file system.)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD DECL MESATYPES)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(RESETSAVE COMPILEIGNOREDECL (QUOTE T))
)
)
(* * Declare low-level data types on which all file system modules depend.)
(DEFINEQ
(\PFFetchString
(DLAMBDA (startLoc lengthLoc
(maxLength SMALLP)
(RETURNS STRINGP))
(* hts: "10-Jan-85 23:18")
(* * Returns a string containing lengthLoc characters read starting from startLoc and capitalized.)
(PROG ((STR (ALLOCSTRING (MIN (\GETBASE lengthLoc 0)
maxLength))))
(for POS from 1 to (NCHARS STR) do (RPLCHARCODE STR POS (\GETBASEBYTE startLoc
(SUB1 POS))))
(RETURN STR))))
(\PFReplaceString
(DLAMBDA (startLoc lengthLoc
(maxLength SMALLP)
(newString (ONEOF STRINGP ATOM))
(RETURNS STRINGP))
(* hts: "10-Jan-85 23:16")
(* * Writes out newString beginning at startLoc, and indicates the length in the word beginning at lengthLoc.)
(SETQ newString (MKSTRING newString))
(PROG ((LENGTH (MIN (NCHARS newString)
maxLength)))
(* * First write out characters)
(for POS from 0 to (SUB1 LENGTH) as CHAR instring newString do (\PUTBASEBYTE startLoc POS
CHAR))
(* * Then write out length of string)
(\PUTBASE lengthLoc 0 LENGTH)
(RETURN newString))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ PILOTFILECOMPILECOMS ((* * Assorted system constants)
(CONSTANTS (pilotVersion 8))
(CONSTANTS (maxPagesPerFile 8388607)
(lastPageNumber (SUB1 maxPagesPerFile))
(nullVolumePage 0)
(maxLogicalVolumes 10))
(CONSTANTS (hardMicrocode 0))
(* * File types. Interlisp has been assigned the file types in the
closed-open interval 10048..10078 (see AR 3112))
(CONSTANTS (tUnassigned 0)
(tPhysicalVolumeRootPage 1)
(tSubVolumeMarkerPage 4)
(tLogicalVolumeRootPage 5)
(tFreePage 6)
(tVolumeAllocationMap 7)
(tVolumeFileMap 8)
(tRootDirectory 18)
(tLispDirectory 10048)
(tLispFile 10049)
(tDiagnosticMicrocode 65535)
(pilotVolume 0)
(nonPilotVolume 3))
(* * Logical volume page, physical volume page, and marker page types)
(CONSTANTS (logicalVolumeSeal 45771))
(RECORDS Page RandomPage FileID VolumeID DiskFileID LVBootFiles
RootFileArray LogicalVolumeDescriptor)
(CONSTANTS (physicalVolumeSeal 41610))
(RECORDS PVBootFiles SubVolumeDesc SubVolumeArray
PhysicalVolumeDescriptor)
(RECORDS LogicalSubVolumeMarker SubVolumeMarkerPage)
(MACROS LVEqual SwapIn&Dirty LvBasePageAddr MarkerPageAddr)
(* * Root directory stuff)
(CONSTANTS (rootDirSeal 30167)
(rootDirVersion 2)
(rootDirMaxEntries 84))
(RECORDS RootDirEntry RootDirEntryArray RootDirectory)
(* * Miscellaneous records)
(RECORDS PageGroup FileDescriptor)
(RECORDS Label)
(* * The following are for diagnostic purposes.)
(MACROS DISPLAYWORDS DISPLAYLABEL DISPLAYPAGE)))
(* * Assorted system constants)
(DECLARE: EVAL@COMPILE
(RPAQQ pilotVersion 8)
(CONSTANTS (pilotVersion 8))
)
(DECLARE: EVAL@COMPILE
(RPAQQ maxPagesPerFile 8388607)
(RPAQ lastPageNumber (SUB1 maxPagesPerFile))
(RPAQQ nullVolumePage 0)
(RPAQQ maxLogicalVolumes 10)
(CONSTANTS (maxPagesPerFile 8388607)
(lastPageNumber (SUB1 maxPagesPerFile))
(nullVolumePage 0)
(maxLogicalVolumes 10))
)
(DECLARE: EVAL@COMPILE
(RPAQQ hardMicrocode 0)
(CONSTANTS (hardMicrocode 0))
)
(* * File types. Interlisp has been assigned the file types in the closed-open interval
10048..10078 (see AR 3112))
(DECLARE: EVAL@COMPILE
(RPAQQ tUnassigned 0)
(RPAQQ tPhysicalVolumeRootPage 1)
(RPAQQ tSubVolumeMarkerPage 4)
(RPAQQ tLogicalVolumeRootPage 5)
(RPAQQ tFreePage 6)
(RPAQQ tVolumeAllocationMap 7)
(RPAQQ tVolumeFileMap 8)
(RPAQQ tRootDirectory 18)
(RPAQQ tLispDirectory 10048)
(RPAQQ tLispFile 10049)
(RPAQQ tDiagnosticMicrocode 65535)
(RPAQQ pilotVolume 0)
(RPAQQ nonPilotVolume 3)
(CONSTANTS (tUnassigned 0)
(tPhysicalVolumeRootPage 1)
(tSubVolumeMarkerPage 4)
(tLogicalVolumeRootPage 5)
(tFreePage 6)
(tVolumeAllocationMap 7)
(tVolumeFileMap 8)
(tRootDirectory 18)
(tLispDirectory 10048)
(tLispFile 10049)
(tDiagnosticMicrocode 65535)
(pilotVolume 0)
(nonPilotVolume 3))
)
(* * Logical volume page, physical volume page, and marker page types)
(DECLARE: EVAL@COMPILE
(RPAQQ logicalVolumeSeal 45771)
(CONSTANTS (logicalVolumeSeal 45771))
)
[DECLARE: EVAL@COMPILE
(RECORD Page NIL (CREATE (NCREATE (QUOTE VMEMPAGEP)))
(TYPE? (TYPENAMEP DATUM (QUOTE VMEMPAGEP))))
(RECORD RandomPage NIL (TYPE? (EQ (fetch (POINTER WORDINPAGE) of DATUM)
0)))
(MESATYPE FileID (2 WORD))
(MESATYPE VolumeID (5 WORD))
(MESARECORD DiskFileID ((fID VolumeID)
(firstPage SWAPPEDFIXP)
(da SWAPPEDFIXP)) (* Booting information)
)
(MESAARRAY LVBootFiles ((0 5))
DiskFileID (* Booting information)
)
(MESAARRAY RootFileArray ((6 14))
FileID)
(MESARECORD LogicalVolumeDescriptor ((seal WORD) (* Validation ; absolutely must be first field)
(version WORD) (* must be 2nd field)
(vID VolumeID) (* ID of This Volume)
(labelLength WORD) (* Length of th ASCII name of this volume)
(label 40 BYTE) (* Volume name in AScII)
(type WORD)
(volumeSize SWAPPEDFIXP)
(* Number of pages in this volume)
(bootingInfo LVBootFiles)
(* Defines 6 PILOT file types)
(NIL WORD)
(NIL BITS 15)
(changing FLAG) (* Change field decls from here on only)
(* boolean ← T)
(freePageCount SWAPPEDFIXP)
(* Number of free pages remaining)
(vamStart SWAPPEDFIXP)
(vfmStart SWAPPEDFIXP)
(* Relative address of the start of the volume file
map)
(lowerBound SWAPPEDFIXP)
(volumeRootDirectory SWAPPEDFIXP)
(rootFileID RootFileArray)
(lastIDAllocated SWAPPEDFIXP)
(* Highest numbered File.ID given out on this volume. We reserve the first set of IDs for Pilot's own use.
In particular, files of type IN PilotRootFileType may have their ID the same as their File.Type.)
(scavengerLogVolume VolumeID)
(lastTimeOpendForWrite SWAPPEDFIXP)
(NIL 131 WORD)
(checksum WORD) (* Must be the last field)
)
(ACCESSFNS (LVlabel (\PFFetchString (LOCF (fetch (
LogicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
LogicalVolumeDescriptor labelLength) of DATUM))
40)
(\PFReplaceString (LOCF (fetch (
LogicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
LogicalVolumeDescriptor labelLength) of DATUM))
40 NEWVALUE)))
(CREATE (PROG ((lv (create Page)))
(replace (LogicalVolumeDescriptor seal)
of lv with logicalVolumeSeal)
(RETURN lv)))
(TYPE? (AND (type? Page DATUM)
(EQ (fetch (LogicalVolumeDescriptor seal)
of DATUM)
logicalVolumeSeal))))
]
(DECLARE: EVAL@COMPILE
(RPAQQ physicalVolumeSeal 41610)
(CONSTANTS (physicalVolumeSeal 41610))
)
[DECLARE: EVAL@COMPILE
(MESAARRAY PVBootFiles ((0 3))
DiskFileID)
(MESARECORD SubVolumeDesc ((lvID VolumeID)
(lvSize SWAPPEDFIXP)
(lvPage SWAPPEDFIXP)
(pvPage SWAPPEDFIXP)
(nPages SWAPPEDFIXP)))
(MESAARRAY SubVolumeArray ((0 9))
SubVolumeDesc)
(MESARECORD PhysicalVolumeDescriptor ((seal WORD) (* Validation)
(version WORD)
(labelLength WORD)
(pvID VolumeID)
(bootingInfo PVBootFiles)
(* Defines 4 PILOT file types)
(label 40 BYTE) (* Ascii name of the volume)
(subVolumeCount WORD)
(subVolumeMarkerID VolumeID)
(* Marker pages belong to this Pseudo File)
(badPageCount SWAPPEDFIXP)
(maxBadPages SWAPPEDFIXP)
(onLineCount WORD)
(subVolumes SubVolumeArray)
(* See SubVolumeDesc record for description of each of
six entries stored here)
(NIL 47 WORD)
(localTimeParametersValid WORD)
(localTimeParameters 2 WORD)
(checksum WORD))
(ACCESSFNS (PVlabel (\PFFetchString (LOCF (fetch (
PhysicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
PhysicalVolumeDescriptor labelLength) of DATUM))
40)
(\PFReplaceString
(LOCF (fetch (PhysicalVolumeDescriptor
label)
of DATUM))
(LOCF (fetch (PhysicalVolumeDescriptor
labelLength)
of DATUM))
40 NEWVALUE)))
(CREATE (PROG ((physicalVol (create Page)))
(replace (PhysicalVolumeDescriptor seal)
of physicalVol with physicalVolumeSeal)
(RETURN physicalVol)))
(TYPE? (AND (type? Page DATUM)
(EQ (fetch (PhysicalVolumeDescriptor seal)
of DATUM)
physicalVolumeSeal))))
]
[DECLARE: EVAL@COMPILE
(MESARECORD LogicalSubVolumeMarker ((seal WORD)
(version WORD)
(labelLength BITS 6)
(type BITS 2)
(NIL BITS 8)
(label 20 WORD)
(bootingInfo LVBootFiles)
(volumeRootDirectory SWAPPEDFIXP)))
(MESARECORD SubVolumeMarkerPage ((logical LogicalSubVolumeMarker)
(* Incomplete)
)
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS LVEqual MACRO ((a b)
(MESAEQUAL (fetch (LogicalVolumeDescriptor vID)
of a)
(fetch (LogicalVolumeDescriptor vID)
of b)
VolumeID)))
(PUTPROPS SwapIn&Dirty MACRO (OPENLAMBDA (page)
(\PUTBASE page 0 (\GETBASE page 0))))
(PUTPROPS LvBasePageAddr MACRO ((vol)
(fetch (SubVolumeDesc pvPage)
of
(FMESAELT (fetch (PhysicalVolumeDescriptor subVolumes)
of \PhysVolumePage)
SubVolumeArray vol))))
(PUTPROPS MarkerPageAddr MACRO ((vol)
(fetch (SubVolumeDesc nPages)
of
(FMESAELT (fetch (PhysicalVolumeDescriptor subVolumes)
of \PhysVolumePage)
SubVolumeArray
(OR (FIXP vol)
(\PFVolumeNumber vol))))))
)
(* * Root directory stuff)
(DECLARE: EVAL@COMPILE
(RPAQQ rootDirSeal 30167)
(RPAQQ rootDirVersion 2)
(RPAQQ rootDirMaxEntries 84)
(CONSTANTS (rootDirSeal 30167)
(rootDirVersion 2)
(rootDirMaxEntries 84))
)
[DECLARE: EVAL@COMPILE
(MESARECORD RootDirEntry ((type WORD)
(file SWAPPEDFIXP)))
(MESAARRAY RootDirEntryArray ((0 rootDirMaxEntries))
RootDirEntry)
(MESARECORD RootDirectory ((seal WORD)
(version WORD)
(maxEntries WORD)
(countEntries WORD)
(entries RootDirEntryArray))
(CREATE (PROG ((rootDir (create Page)))
(replace (RootDirectory seal) of rootDir with rootDirSeal)
(replace (RootDirectory version) of rootDir with
rootDirVersion)
(replace (RootDirectory maxEntries) of rootDir with
rootDirMaxEntries)
(RETURN rootDir)))
(TYPE? (AND (type? Page DATUM)
(EQ (fetch (RootDirectory seal) of DATUM)
rootDirSeal))))
]
(* * Miscellaneous records)
[DECLARE: EVAL@COMPILE
(DATATYPE PageGroup ((filePage SWAPPEDFIXP)
(volumePage SWAPPEDFIXP)
(nextFilePage SWAPPEDFIXP)))
(DATATYPE FileDescriptor (fileID (* Can be either a FIXP or a pointer to a VolumeID)
(volNum FIXP) (* 0..9)
(type WORD) (* Pilot file type)
(size FIXP) (* Current number of (Pilot) pages allocated to this
file)
(PAGEGROUP POINTER) (* Caches the last PageGroup found for this file)
))
]
(/DECLAREDATATYPE (QUOTE PageGroup)
(QUOTE (SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP))
(QUOTE ((PageGroup 0 SWAPPEDFIXP)
(PageGroup 2 SWAPPEDFIXP)
(PageGroup 4 SWAPPEDFIXP)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE FileDescriptor)
(QUOTE (POINTER FIXP WORD FIXP POINTER))
(QUOTE ((FileDescriptor 0 POINTER)
(FileDescriptor 2 FIXP)
(FileDescriptor 4 (BITS . 15))
(FileDescriptor 5 FIXP)
(FileDescriptor 8 POINTER)))
(QUOTE 10))
[DECLARE: EVAL@COMPILE
(MESARECORD Label ((fileID SWAPPEDFIXP) (* valid in label of every page)
(NIL 3 WORD)
(filePageLo WORD)
(filePageHi BITS 7) (* 23 bit page number, valid in label of every page)
(* always zero)
(pageZeroAttributes BITS 9) (* valid only in label of page 0)
(attributesInAllPages WORD) (* valid in label of every page)
(dontCare 2 WORD))
(ACCESSFNS (filePage (\MAKENUMBER (fetch (Label filePageHi) of DATUM)
(fetch (Label filePageLo) of DATUM))
(PROGN (replace (Label filePageHi) of DATUM
with (\HINUM NEWVALUE))
(replace (Label filePageLo) of DATUM
with (\LONUM NEWVALUE))
NEWVALUE)))
(TYPE? (OR (type? ARRAYBLOCK DATUM)
(AND (GETD (QUOTE \BLOCKDATAP))
(\BLOCKDATAP DATUM)))))
]
(* * The following are for diagnostic purposes.)
(DECLARE: EVAL@COMPILE
(PUTPROPS DISPLAYWORDS MACRO (LAMBDA (Start Number)
(* bvm: "12-Jun-85 12:24")
(* * Prints out the first Number words of the object Start)
(for I from 0 to (SUB1 Number)
do
(PRIN1 (\GETBASE Start I))
(PRIN1 " ")
(COND ((EQ (IREMAINDER (ADD1 I)
14)
0)
(TERPRI))))
(TERPRI)))
(PUTPROPS DISPLAYLABEL MACRO (LAMBDA (vol volumePageNumber)
(* hts: " 5-Jan-85 16:14")
(* * Prints the label of the given page.)
(PROG ((L (create Label)))
(if (type? LogicalVolumeDescriptor vol)
then
(SETQ vol (\PFVolumeNumber vol)))
(\PFTransferPage (IPLUS (LvBasePageAddr vol)
volumePageNumber)
(create Page)
(QUOTE VRR)
L)
(DISPLAYWORDS L 10))))
(PUTPROPS DISPLAYPAGE MACRO (LAMBDA (vol volumePageNumber)
(* hts: " 5-Jan-85 16:14")
(* * Prints out the specified page of the disk.)
(PROG ((P (create Page)))
(if (type? LogicalVolumeDescriptor vol)
then
(SETQ vol (\PFVolumeNumber vol)))
(\PFTransferPage (IPLUS (LvBasePageAddr vol)
volumePageNumber)
P
(QUOTE VRR)
(create Label))
(DISPLAYWORDS P WORDSPERPAGE))))
)
)
(/DECLAREDATATYPE (QUOTE PageGroup)
(QUOTE (SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP))
(QUOTE ((PageGroup 0 SWAPPEDFIXP)
(PageGroup 2 SWAPPEDFIXP)
(PageGroup 4 SWAPPEDFIXP)))
(QUOTE 6))
(/DECLAREDATATYPE (QUOTE FileDescriptor)
(QUOTE (POINTER FIXP WORD FIXP POINTER))
(QUOTE ((FileDescriptor 0 POINTER)
(FileDescriptor 2 FIXP)
(FileDescriptor 4 (BITS . 15))
(FileDescriptor 5 FIXP)
(FileDescriptor 8 POINTER)))
(QUOTE 10))
(* * Define the various modules of the file system.)
(RPAQQ LFCOMS ((* * This module handles the interface to the device-independent part of the file
system: it provides a vector of standard device-specific file system operations.
This used to be the sole contents of the file LOCALFILE.)
(DECLARE: EVAL@COMPILE DONTCOPY (* * File system datatypes)
(CONSTANTS (lispFileVersion 2)
(leaderPageSeal 54321))
(RECORDS LFDEV DLIONSTREAM LeaderPage)
(* * Error mechanism)
(MACROS DiskError))
(* * Public entry)
(FNS CREATEDSKDIRECTORY PURGEDSKDIRECTORY LISPDIRECTORYP VOLUMES VOLUMESIZE)
(FNS DFSCREATEDIRECTORY MKDIR DFSPURGEDIRECTORY DFSVOLUMES)
(FNS \DFSCurrentVolume \DFSFreeDiskPages)
(FNS \LFEntryPoint \LFNormalizeVolumeName)
(* * Device management)
(FNS \LFCreateDevice \LFOpenDevice \LFCloseDevice)
(GLOBALVARS \LFdevice \LFtopMonitor \LFrunSize)
(P (\LFCreateDevice))
(INITVARS (\LFtopMonitor (CREATE.MONITORLOCK (QUOTE topMonitor)))
(\LFrunSize 20))
(* * Device methods)
(FNS \LFOpenFile \LFGetStreamForFile \LFOpenOldFile \LFGenFileID \LFCreateFile
\LFMakeLeaderPage \LFUpdateLeaderPage \LFWriteLeaderPage)
(FNS \LFCloseFile)
(FNS \LFDeleteFile)
(FNS \LFReadPages)
(FNS \LFWritePages \LFExtendFileIfNecessary \LFExtendFile)
(FNS \LFGetFileInfo)
(FNS \LFGetFileName)
(FNS \LFEventFn)
(FNS \LFDirectoryNameP)
(FNS \LFTruncateFile)))
(* * This module handles the interface to the device-independent part of the file system: it
provides a vector of standard device-specific file system operations. This used to be the sole
contents of the file LOCALFILE.)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ lispFileVersion 2)
(RPAQQ leaderPageSeal 54321)
(CONSTANTS (lispFileVersion 2)
(leaderPageSeal 54321))
)
[DECLARE: EVAL@COMPILE
(RECORD LFDEV FDEV (SUBRECORD FDEV)
(TYPE? (AND (type? FDEV DATUM)
(EQ (fetch (FDEV CLOSEFILE) of DATUM)
(FUNCTION \LFCloseFile))
(EQ (fetch (FDEV HOSTNAMEP) of DATUM)
(FUNCTION NILL)))))
(RECORD DLIONSTREAM STREAM (SUBRECORD STREAM)
(ACCESSFNS ((FILEDESC (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(LEADERPAGE (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(DIRINFO (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(DIRHOLEPTR (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE))
(VOLUME (\PFGetVol (fetch (FileDescriptor volNum)
of (fetch (DLIONSTREAM FILEDESC)
of DATUM))))))
(TYPE? (AND (type? STREAM DATUM)
(type? FileDescriptor (fetch (DLIONSTREAM FILEDESC)
of DATUM)))))
(MESARECORD LeaderPage ((seal WORD)
(version WORD)
(TimeCreate FIXP)
(TimeWrite FIXP)
(TimeRead FIXP)
(FileID FIXP)
(AllocatedPages FIXP)
(EofPage FIXP)
(EOffSet WORD)
(NameLength WORD)
(FileName 256 BYTE)
(AuthorLength WORD)
(AuthorName 64 BYTE)
(typeHolder WORD))
(ACCESSFNS (TYPE (SELECTQ (fetch (LeaderPage typeHolder) of DATUM)
(0 (QUOTE TEXT))
(QUOTE BINARY))
(PROGN (replace (LeaderPage typeHolder) of DATUM
with (SELECTQ NEWVALUE
(TEXT 0)
1))
NEWVALUE)))
(ACCESSFNS (fileName (\PFFetchString (LOCF (fetch (LeaderPage FileName)
of DATUM))
(LOCF (fetch (LeaderPage NameLength)
of DATUM))
256)
(\PFReplaceString (LOCF (fetch (LeaderPage FileName)
of DATUM))
(LOCF (fetch (LeaderPage NameLength)
of DATUM))
256 NEWVALUE)))
(ACCESSFNS (author (\PFFetchString (LOCF (fetch (LeaderPage AuthorName)
of DATUM))
(LOCF (fetch (LeaderPage AuthorLength)
of DATUM))
64)
(\PFReplaceString (LOCF (fetch (LeaderPage AuthorName)
of DATUM))
(LOCF (fetch (LeaderPage AuthorLength)
of DATUM))
64 NEWVALUE)))
(CREATE (PROG ((leader (create Page)))
(replace (LeaderPage seal) of leader with leaderPageSeal)
(RETURN leader)))
(TYPE? (AND (type? Page DATUM)
(EQ (fetch (LeaderPage seal) of DATUM)
leaderPageSeal))))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS DiskError MACRO ((errorType fileName CONTINUEOKFLG)
(PROG ((\INTERRUPTABLE T))
(* * Gross hack to allow the error to show up as a break rather than a 9318)
(LISPERROR errorType fileName CONTINUEOKFLG))))
)
)
(* * Public entry)
(DEFINEQ
(CREATEDSKDIRECTORY
(DLAMBDA ((volName (ONEOF ATOM STRINGP))
(smashDirectory BOOL)
(RETURNS STRINGP))
(* hts: " 9-Aug-85 18:14")
(* * Creates a directory on the specified volume, if possible. If this constitutes the first Lisp directory on the
disk, creates the local disk device to run this directory (and any subsequent ones). If smashDirectory, it will
smash any old Lisp directory on the volume. If smashVFM, it will smash the old volume file map for the volume;
otherwise (normally) it will reuse it.)
(WITH.MONITOR \LFtopMonitor (PROG ((vol (\LFEntryPoint volName NIL T))
markerPage)
(if (NOT (\PFPilotVolumeP vol))
then (ERROR "Non-pilot volume"))
(if smashDirectory
then (\LFPurgeDirectory vol))
(if (\LFDirectoryP vol)
then (ERROR "Directory already created"))
(UNINTERRUPTABLY
(if (NOT (type? LFDEV (\GETDEVICEFROMNAME (QUOTE DSK))))
then (\LFCreateDevice))
(if (type? LFDEV (\GETDEVICEFROMNAME (QUOTE DSK)))
then (\LFMakeVolumeDirectory vol)
else (\LFMakeVolumeDirectory vol T)
(\LFOpenDevice)))
(\PFDsplyVolumes))
(PACKFILENAME.STRING (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(U-CASE volName)))))
(PURGEDSKDIRECTORY
(DLAMBDA ((volName (ONEOF ATOM STRINGP))
(dontDeleteFiles BOOL)
(RETURNS NIL))
(* hts: "16-Feb-85 20:01")
(* * Purges the Lisp directory on the specified volume. If this is the last valid Lisp directory on the disk, shuts
down the local disk device.)
(WITH.MONITOR \LFtopMonitor (PROG ((vol (\LFEntryPoint volName NIL T))
device)
(if (NOT (\PFPilotVolumeP vol))
then (ERROR "Non-pilot volume"))
(UNINTERRUPTABLY
(* * CLose all files open on that directory)
(for S in \OPENFILES
when (AND (type? DLIONSTREAM S)
(EQ (fetch (DLIONSTREAM VOLUME) of S)
vol))
do (printout PROMPTWINDOW T "Closing " (CLOSEF S)))
(* * Delete all files on that directory.)
(if (NOT dontDeleteFiles)
then (for F in (FILDIR (PACKFILENAME
(QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(fetch (LogicalVolumeDescriptor
LVlabel)
of vol)))
do (printout PROMPTWINDOW T "Deleting "
(DELFILE F))))
(* * Remove the directory)
(\LFPurgeDirectory vol)
(* * If this was the last Lisp directory, replace the dandelion disk device with a coredevice.
Actually, all you need to do is kill the dlion disk device and VANILLADISK will take care of the rest)
(OR (\LFFindDirectoryVol)
(\LFCloseDevice)))))))
(LISPDIRECTORYP
(DLAMBDA ((volumeName (ONEOF ATOM STRINGP))
(RETURNS BOOL))
(* hts: "13-Feb-85 22:43")
(* * Returns T if volumeName has a valid Lisp directory on it, NIL otherwise.)
(WITH.MONITOR \LFtopMonitor (SELECTQ (MACHINETYPE)
((DANDELION DOVE)
(PROG ((vol (\LFEntryPoint volumeName NIL T)))
(RETURN (NOT (NOT (AND vol (\LFDirectoryP vol)))))))
NIL))))
(VOLUMES
(DLAMBDA ((RETURNS (LISTP OF ATOM)))
(* hts: "13-Feb-85 22:44")
(* * Returns a list of the names of the logical volumes on this machine.)
(SELECTQ (MACHINETYPE)
((DANDELION DOVE)
(\LFEntryPoint NIL T)
(for vol in (\PFGetVols) collect (MKATOM (U-CASE (fetch (LogicalVolumeDescriptor
LVlabel)
of vol)))))
NIL)))
(VOLUMESIZE
(DLAMBDA ((volName (ONEOF NIL ATOM STRINGP))
(recompute BOOL)
(RETURNS FIXP))
(* hts: "13-Feb-85 22:51")
(* * Returns the size of the specified volume.)
(PROG ((vol (\LFEntryPoint volName)))
(RETURN (fetch (LogicalVolumeDescriptor volumeSize) of vol)))))
)
(DEFINEQ
(DFSCREATEDIRECTORY
(LAMBDA (volName smashDirectory) (* hts: " 4-Jul-85 18:23")
(* * For backward compatibility)
(CREATEDSKDIRECTORY volName smashDirectory)))
(MKDIR
(LAMBDA (volName smashDirectory) (* hts: " 4-Jul-85 18:20")
(* * For backward compatibility)
(CREATEDSKDIRECTORY volName smashDirectory)))
(DFSPURGEDIRECTORY
(LAMBDA (volName dontDeleteFiles) (* hts: " 8-Aug-85 14:41")
(* * For backward compatibility)
(PURGEDSKDIRECTORY volName dontDeleteFiles)))
(DFSVOLUMES
(LAMBDA NIL (* hts: " 4-Jul-85 18:23")
(* * For backward compatibility)
(VOLUMES)))
)
(DEFINEQ
(\DFSCurrentVolume
(LAMBDA NIL (* hts: "13-Feb-85 22:47")
(* * Returns as an atom the name of the volume which contains the currently running virtual memory.
Called by DISKPARTITION.)
(\LFEntryPoint NIL T)
(MKATOM (U-CASE (fetch (LogicalVolumeDescriptor LVlabel) of (\PFCurrentVol))))))
(\DFSFreeDiskPages
(DLAMBDA ((volName (ONEOF NIL ATOM STRINGP))
(recompute BOOL)
(RETURNS FIXP))
(* hts: "13-Feb-85 22:48")
(* * Returns the number of free pages left on the specified volume. Called by DISKFREEPAGES.)
(WITH.MONITOR \LFtopMonitor (PROG ((vol (\LFEntryPoint volName)))
(RETURN (\PFFreeDiskPages vol recompute))))))
)
(DEFINEQ
(\LFEntryPoint
(DLAMBDA ((volName ANY)
(noVolName BOOL)
(dontDefault BOOL)
(RETURNS (ONEOF NIL LogicalVolumeDescriptor)))
(* hts: "13-Aug-85 16:17")
(* * Run at every entry point to the file system. Makes sure everything is set up ok, and makes all entry points
share some common code.)
(OR (ATOM volName)
(STRINGP volName)
(\ILLEGAL.ARG volName))
(SELECTQ (MACHINETYPE)
((DANDELION DOVE)
NIL)
(ERROR "Wrong machinetype"))
(\PFEnsureInitialized)
(if (NOT (\PFVersionOK))
then (ERROR "Wrong Pilot version on disk"))
(if (NOT noVolName)
then (PROG ((vol (OR (\PFGetLVPage (\LFNormalizeVolumeName volName))
(AND (NOT volName)
(NOT dontDefault)
(\LFFindDirectoryVol NIL)))))
(if (NULL vol)
then (ERROR "Volume not on local disk"))
(RETURN vol)))))
(\LFNormalizeVolumeName
(DLAMBDA ((volName (ONEOF NIL ATOM STRINGP))
(RETURNS (ONEOF NIL ATOM STRINGP)))
(* hts: "16-Jan-85 16:35")
(* * If the volume name given is a valid one, returns that; else assumes it is a full file name of some sort, and
extracts the volume name from it.)
(if (STRPOS "{" volName)
then (fetch (PARSEDFILENAME VOL) of (the PARSEDFILENAME (\LFParseFileName volName)))
else volName)))
)
(* * Device management)
(DEFINEQ
(\LFCreateDevice
(DLAMBDA ((RETURNS LFDEV))
(* hts: "25-Jan-85 16:33")
(* * Creates and remembers the local hard disk file device, but does not open the device or any of its associated
directories.)
(if (AND (BOUNDP (QUOTE \LFdevice))
(type? LFDEV \LFdevice))
then \LFdevice
else (SETQ \LFdevice (\MAKE.PMAP.DEVICE (create FDEV
NODIRECTORIES ← T
DEVICENAME ←(QUOTE DSK)
CLOSEFILE ←(FUNCTION \LFCloseFile)
DELETEFILE ←(FUNCTION \LFDeleteFile)
TRUNCATEFILE ←(FUNCTION \LFTruncateFile)
GETFILEINFO ←(FUNCTION \LFGetFileInfo)
GETFILENAME ←(FUNCTION \LFGetFileName)
OPENFILE ←(FUNCTION \LFOpenFile)
READPAGES ←(FUNCTION \LFReadPages)
SETFILEINFO ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \LFWritePages)
REOPENFILE ←(FUNCTION \LFOpenFile)
GENERATEFILES ←(FUNCTION \LFGenerateFiles)
EVENTFN ←(FUNCTION \LFEventFn)
DIRECTORYNAMEP ←(FUNCTION \LFDirectoryNameP)
HOSTNAMEP ←(FUNCTION NILL)))))))
(\LFOpenDevice
(DLAMBDA ((RETURNS (ONEOF NIL LFDEV)))
(* hts: " 9-Aug-85 18:05")
(* * Opens the local hard disk file system device and returns it if it can be opened; otherwise returns NIL.
Device can be opened iff Pilot version is OK and there is at least one valid Lisp directory of the appropriate
version on the disk.)
(WITH.MONITOR \LFtopMonitor (SELECTQ (MACHINETYPE)
((DANDELION DOVE)
(\PFEnsureInitialized)
(AND (\PFVersionOK)
(for VOL in (\PFGetVols)
thereis (\LFCloseDirectory VOL)
(AND (\LFDirectoryP VOL)))
(\GETDEVICEFROMNAME (\DEFINEDEVICE (QUOTE DSK)
(the LFDEV
\LFdevice)))))
NIL))))
(\LFCloseDevice
(LAMBDA NIL (* hts: " 7-Jan-85 15:17")
(* * comment)
(WITH.MONITOR \LFtopMonitor (\PFEnsureInitialized T)
(\REMOVEDEVICE (the LFDEV \LFdevice))
(AND (\PFVersionOK)
(for VOL in (\PFGetVols) do (\LFCloseDirectory VOL)))
NIL)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LFdevice \LFtopMonitor \LFrunSize)
)
(\LFCreateDevice)
(RPAQ? \LFtopMonitor (CREATE.MONITORLOCK (QUOTE topMonitor)))
(RPAQ? \LFrunSize 20)
(* * Device methods)
(DEFINEQ
(\LFOpenFile
(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hts: "13-Aug-85 12:27")
(* * Open a file.)
(LET ((STREAM (WITH.MONITOR \LFtopMonitor (PROG ((DATE (FASSOC (QUOTE CREATIONDATE)
OTHERINFO))
STREAM)
(* * 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 STREAM)))
(SETQ STREAM (\LFGetStreamForFile
FILE RECOG ACCESS (NEQ ACCESS (QUOTE INPUT))
OTHERINFO))
(* * If GetStreamForFile returned something other than a stream, there was some error; abort.)
(if (NOT (type? DLIONSTREAM STREAM))
then (RETURN STREAM))
(* * 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 STREAM
with (replace EOFFSET of STREAM
with 0)))
(* * Update access dates. For REOPENFILE op, don't change dates)
(\LFUpdateLeaderPage
STREAM
(if (AND (NOT OLDSTREAM)
(NOT (FMEMB (QUOTE DON'T.CHANGE.DATE)
OTHERINFO)))
then ACCESS
else NIL))
(* * Return the stream you've just built.)
(RETURN STREAM)))))
(COND
((type? DLIONSTREAM STREAM)
STREAM)
((NULL STREAM)
NIL)
((STREQUAL STREAM "FILE SYSTEM RESOURCES EXCEEDED")
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" FILE T)
(\LFOpenFile FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM))))))
(\LFGetStreamForFile
(DLAMBDA ((NAME (ONEOF ATOM STRINGP))
(RECOG LITATOM)
(ACCESS LITATOM)
(CREATEFLG BOOL)
(OTHERINFO LST)
(RETURNS (ONEOF NIL DLIONSTREAM STRINGP)))
(* hts: " 8-Aug-85 16:06")
(* * Creates a STREAM for dsk file NAME, creating it if necessary when CREATEFLG is true.)
(DPROG ((FILESPEC (\LFFileSpec NAME RECOG) (ONEOF NIL DFSFileSpec))
(volNum NIL (ONEOF NIL SMALLP))
(DIRPTR NIL (ONEOF NIL FIXP)))
(RETURN (COND
((NULL FILESPEC)
(* * If the file does not have a valid file specification, don't create a stream; just return NIL.)
NIL)
((SETQ DIRPTR (fetch (DFSFileSpec FSDIRPTR) of FILESPEC))
(* * If the directory code found a pointer into the directory, then the file already exists;
just open it up)
(\LFOpenOldFile (create FileDescriptor
fileID ←(\LFReadFileID
(\LFGetDirectory (SETQ volNum
(fetch (ExpandedName VOLNUM)
of (fetch (DFSFileSpec
EXPANDEDNAME)
of FILESPEC))))
DIRPTR)
volNum ← volNum
type ← tLispFile)
(\LFFullFileName (fetch (DFSFileSpec EXPANDEDNAME) of FILESPEC))
DIRPTR))
((NULL (fetch (ExpandedName VERSION) of (fetch (DFSFileSpec EXPANDEDNAME)
of FILESPEC)))
NIL)
((IGREATERP (fetch (ExpandedName VERSION) of (fetch (DFSFileSpec EXPANDEDNAME)
of FILESPEC))
MAX.SMALLP)
(printout PROMPTWINDOW T "Version number too high")
"FILE SYSTEM RESOURCES EXCEEDED")
(CREATEFLG (\LFCreateFile (fetch (DFSFileSpec EXPANDEDNAME) of FILESPEC)
OTHERINFO)))))))
(\LFOpenOldFile
(DLAMBDA ((fileDesc FileDescriptor)
(fullFileName LITATOM)
(directoryPointer (ONEOF NIL FIXP))
(RETURNS DLIONSTREAM))
(* hts: "25-Jan-85 17:16")
(* * Open an old (existing) file and return the resultant stream)
(DPROG ((leaderPage (create LeaderPage) LeaderPage)
THEN (STREAM (create DLIONSTREAM
FULLFILENAME ← fullFileName
FILEDESC ← fileDesc
DIRINFO ← directoryPointer
DEVICE ← \LFdevice
LEADERPAGE ← leaderPage) DLIONSTREAM)
(SIZE NIL (ONEOF NIL FIXP))
(LASTPAGE NIL (ONEOF NIL FIXP))
(OFFSET NIL (ONEOF NIL SMALLP)))
(* * Use the volume file map to find out what size the file is; record this in the stream you are building.)
(SETQ SIZE (\PFFindFileSize fileDesc))
(replace (FileDescriptor size) of fileDesc with SIZE)
(* * Read in the leader page for the file. The leader page has stream-level eof information on it.
It also has backing file length info on it. If this latter matches the length found from the vfm, then believe the
leader page and use its eof info for the stream; else, the leader page is probably screwed up, so just make the
stream's eof be the entire backing file. (This means you won't lose any info, but might gain about half a page of
nulls.))
(\PFGetPage fileDesc 0 (\PFFindPageAddr fileDesc 0)
leaderPage)
(if (EQP (fetch (LeaderPage AllocatedPages) of leaderPage)
SIZE)
then (SETQ LASTPAGE (fetch EofPage of leaderPage))
(SETQ OFFSET (fetch EOffSet of leaderPage))
else (SETQ LASTPAGE (SUB1 SIZE))
(SETQ OFFSET BYTESPERPAGE))
(replace (DLIONSTREAM EPAGE) of STREAM with LASTPAGE)
(replace (DLIONSTREAM EOFFSET) of STREAM with OFFSET)
(* * Finally return the stream you've just built)
(RETURN STREAM))))
(\LFGenFileID
(DLAMBDA ((vol LogicalVolumeDescriptor)
(RETURNS FIXP))
(* hts: " 8-Jan-85 14:50")
(* * Generates and returns a new file ID and updates the ID count for the logical volume)
(add (fetch (LogicalVolumeDescriptor lastIDAllocated) of vol)
1)))
(\LFCreateFile
(LAMBDA (fileName info) (* hts: " 8-Aug-85 15:58")
(* * fileName: UNAME, pages: FIXP (estimated length of file; currently not taken advantage of), info: PLIST)
(* * Creates a file by allocating the pages for it and returning a stream to it.)
(UNINTERRUPTABLY
(PROG ((vol (\PFGetVol (fetch (ExpandedName VOLNUM) of fileName)))
stream DIRINDEX)
(SETQ stream (create DLIONSTREAM
FULLFILENAME ←(\LFFullFileName fileName)
FILEDESC ←(create FileDescriptor
fileID ←(\LFGenFileID vol)
volNum ←(\PFVolumeNumber vol)
type ← tLispFile)
DEVICE ← \LFdevice))
(* * Make sure there's enough space for the directory entry.)
(if (NULL (SETQ DIRINDEX (\LFFindDirHole stream fileName (\LFGetDirectory vol))))
then (RETURN "FILE SYSTEM RESOURCES EXCEEDED"))
(* * Allocate pages for file; this will update size field of FileDescriptor)
(if (NULL (\PFNewPages vol (fetch (DLIONSTREAM FILEDESC) of stream)
(create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← \LFrunSize)))
then (RETURN "FILE SYSTEM RESOURCES EXCEEDED"))
(* * Create leader page for the new file and put it and cache it)
(replace (DLIONSTREAM LEADERPAGE) of stream with (\LFMakeLeaderPage
(fetch (DLIONSTREAM FILEDESC)
of stream)
(\LFFileName fileName)
info))
(* * Enter the new file in the directory)
(\LFMakeDirEntry stream fileName (\LFGetDirectory vol)
DIRINDEX)
(RETURN stream)))))
(\LFMakeLeaderPage
(DLAMBDA ((file FileDescriptor)
(fileName (ONEOF ATOM STRINGP))
(Info LST)
(RETURNS LeaderPage))
(* hts: " 8-Jan-85 16:12")
(* * Make, put, and return leader page for file)
(DECLARE (GLOBALVARS DEFAULTFILETYPE))
(PROG ((TYPE (OR (CADR (FASSOC (QUOTE TYPE)
Info))
DEFAULTFILETYPE))
(CurrentTime (OR (FIXP (CADR (FASSOC (QUOTE CREATIONDATE)
Info)))
(IDATE)))
(Author (OR (CADR (FASSOC (QUOTE AUTHOR)
Info))
(USERNAME)))
(LeaderPage (create LeaderPage)))
(replace (LeaderPage TYPE) of LeaderPage with TYPE)
(replace (LeaderPage TimeCreate) of LeaderPage with CurrentTime)
(replace (LeaderPage TimeWrite) of LeaderPage with CurrentTime)
(replace (LeaderPage FileID) of LeaderPage with (fetch (FileDescriptor fileID)
of file))
(replace (LeaderPage AllocatedPages) of LeaderPage with (fetch (FileDescriptor size)
of file))
(replace (LeaderPage EofPage) of LeaderPage with 0)
(replace (LeaderPage EOffSet) of LeaderPage with 0)
(replace (LeaderPage fileName) of LeaderPage with fileName)
(replace (LeaderPage author) of LeaderPage with Author)
(replace (LeaderPage version) of LeaderPage with lispFileVersion)
(\PFPutPage file 0 (\PFFindPageAddr file 0)
LeaderPage)
(RETURN LeaderPage))))
(\LFUpdateLeaderPage
(LAMBDA (stream access) (* hts: " 9-Jan-85 16:52")
(UNINTERRUPTABLY
(PROG ((leaderPage (fetch (DLIONSTREAM LEADERPAGE) of stream))
(time (DAYTIME)))
(* * Update end of file info)
(replace (LeaderPage EofPage) of leaderPage with (fetch (STREAM EPAGE) of stream))
(replace (LeaderPage EOffSet) of leaderPage with (fetch (STREAM EOFFSET) of stream))
(replace (LeaderPage AllocatedPages) of leaderPage with (fetch (FileDescriptor size)
of (fetch (DLIONSTREAM
FILEDESC)
of stream)))
(* * Update info saying how many pages have been allocated to the file)
(replace (LeaderPage AllocatedPages) of leaderPage with (fetch (FileDescriptor size)
of (fetch (DLIONSTREAM
FILEDESC)
of stream)))
(* * Update access times)
(SELECTQ access
((OUTPUT BOTH APPEND)
(replace (LeaderPage TimeWrite) of leaderPage with time))
NIL)
(SELECTQ access
((INPUT BOTH)
(replace (LeaderPage TimeRead) of leaderPage with time))
NIL)
(* * and write out the refreshed leader page)
(\LFWriteLeaderPage stream)))))
(\LFWriteLeaderPage
(LAMBDA (stream) (* hts: " 5-Jan-85 16:15")
(PROG ((vol (fetch (DLIONSTREAM VOLUME) of stream))
(fileDesc (fetch (DLIONSTREAM FILEDESC) of stream)))
(\PFPutPage fileDesc 0 (\PFFindPageAddr fileDesc 0)
(fetch (DLIONSTREAM LEADERPAGE) of stream)))))
)
(DEFINEQ
(\LFCloseFile
(LAMBDA (STREAM) (* mjs " 6-Mar-85 22:41")
(* * Closes the specified stream.)
(WITH.MONITOR \LFtopMonitor
(* * Write out and dispense with buffers for this stream.)
(\CLEARMAP STREAM)
(if (NEQ (fetch ACCESS of STREAM)
(QUOTE INPUT))
then
(* * Update the stream eof info, trim the backing file so that it is just big enough to hold the stream, and record
all the eof info on the stream's leader page. Minimum backing file length for the stream is computed as follows: 1
page for leader page; 1 page because stream pages (in particular EPAGE) are numbered from 0, not 1;
EPAGE of stream pages; less 1 page if the EOFFSET is 0)
(UNINTERRUPTABLY
(\LFTruncateFile STREAM)
(\PFTrimHelper (fetch (DLIONSTREAM VOLUME) of STREAM)
(fetch (DLIONSTREAM FILEDESC) of STREAM)
(PLUS 1 1 (fetch EPAGE of STREAM)
(if (EQ (fetch EOFFSET of STREAM)
0)
then -1
else 0)))
(\LFUpdateLeaderPage STREAM)))
(\PFSaveBuffers (fetch (DLIONSTREAM VOLUME) of STREAM))
STREAM)))
)
(DEFINEQ
(\LFDeleteFile
(LAMBDA (fileName dev) (* hts: " 8-Aug-85 16:14")
(WITH.MONITOR \LFtopMonitor (PROG ((stream (\LFGetStreamForFile fileName (QUOTE OLDEST)
(QUOTE BOTH)
NIL NIL)))
(DECLARE (GLOBALVARS \OPENFILES))
(if (OR (NOT (type? DLIONSTREAM stream))
(bind (NAME ←(fetch FULLFILENAME of stream))
thereis stream in \OPENFILES
suchthat (EQ (fetch FULLFILENAME of stream)
NAME)))
then (RETURN))
(UNINTERRUPTABLY
(\LFRemoveDirEntry stream (\LFGetDirectory
(fetch (DLIONSTREAM VOLUME)
of stream)))
(* * Take the entire file out of the BTree and out of the allocation map)
(\PFTrimHelper (fetch (DLIONSTREAM VOLUME) of stream)
(fetch (DLIONSTREAM FILEDESC) of stream)
0)
(* * save buffers)
(\PFSaveBuffers (fetch (DLIONSTREAM VOLUME) of stream)))
(RETURN (fetch (DLIONSTREAM FULLFILENAME) of stream))))))
)
(DEFINEQ
(\LFReadPages
(LAMBDA (stream streamFirstPage buffers) (* hts: "13-Aug-85 15:28")
(* * Reads a bunch of pages from stream, starting at firstPage. Returns number of bytes read.)
(* * Modified " 4-Jul-85 04:47:22" by HTS to extend the backing file whenever it tries to read past the end of the
backing file. This generally ensures that data subsequently written on these buffer pages will not be lost if you
run out of disk space)
(* * If asked to read a page which is off the end of the stream, it will zero the page. Odd though it may seem,
reading off the end of the file is reasonable behavior for copybytes: buffer pages must come from somewhere, and
copybytes may not have to write the whole page, and in general copybytes does not know whether a page is actually in
a file or off the end of it. Seems inefficient, but since reading past eof does not actually require disk access,
its not that bad.)
(* * Extend backing file if necessary to accomodate buffers.)
(\LFExtendFileIfNecessary stream streamFirstPage buffers)
(* * Write out the buffers to the backing file.)
(for buffer inside buffers as streamPageNumber from streamFirstPage as backingFilePageNumber
from (ADD1 streamFirstPage) bind (file ←(fetch (DLIONSTREAM FILEDESC) of stream))
lastStreamPage offset
first (\UPDATEOF stream)
(SETQ lastStreamPage (PLUS (fetch (DLIONSTREAM EPAGE) of stream)
(if (EQ 0 (fetch (DLIONSTREAM EOFFSET) of stream))
then -1
else 0)))
sum (if (LEQ streamPageNumber lastStreamPage)
then
(* * If page inside stream, then it has presumably already been written; read it in.)
(\PFGetPage file backingFilePageNumber (\PFFindPageAddr file
backingFilePageNumber)
buffer)
(* * If this was the last page in the file, then fill in the trailing bytes with nulls.)
(if (EQ streamPageNumber lastStreamPage)
then (SETQ offset (fetch (DLIONSTREAM EOFFSET) of stream))
(if (EQ offset 0)
then (SETQ offset BYTESPERPAGE)
else (\CLEARBYTES buffer offset (DIFFERENCE BYTESPERPAGE offset)))
offset
else BYTESPERPAGE)
else
(* * If this was outside the stream, clear the buffer.)
(\CLEARWORDS buffer WORDSPERPAGE)
0))))
)
(DEFINEQ
(\LFWritePages
(LAMBDA (stream streamFirstPage buffers) (* hts: "13-Aug-85 14:47")
(* * Writes a bunch of pages to stream, starting at streamFirstPage)
(* * Extend backing file if necessary to accomodate buffers.)
(\LFExtendFileIfNecessary stream streamFirstPage buffers)
(* * Write out the buffers to the backing file.)
(for buffer inside buffers as backingFilePageNumber from (ADD1 streamFirstPage)
bind (file ←(fetch (DLIONSTREAM FILEDESC) of stream)) do (\PFPutPage file
backingFilePageNumber
(\PFFindPageAddr file
backingFilePageNumber)
buffer))
NIL))
(\LFExtendFileIfNecessary
(LAMBDA (stream streamFirstPage buffers) (* hts: "13-Aug-85 14:21")
(* * Extends the backing file for stream to make space for buffers. Must not be called from uninterruptable or
monitorlocked code. Causes a continuable error if there are not enough free pages for the extension.)
(PROG ((runLength (if (NLISTP buffers)
then 1
else (LENGTH buffers)))
minBackingFileSize)
(* * Backing file (Pilot file) enumeration starts with leader page of file, Lisp stream page enumeration does not
include the leader page; hence the first 1.0 Pages are enumerated from 0 but size is enumerated from 1;
hence the second 1.0)
(SETQ minBackingFileSize (PLUS 1 1 streamFirstPage (SUB1 runLength)))
(* * Extend backing file if necessary.)
(until (WITH.MONITOR \LFtopMonitor (if (GREATERP minBackingFileSize
(fetch (FileDescriptor size)
of (fetch (DLIONSTREAM FILEDESC)
of stream)))
then (\LFExtendFile stream minBackingFileSize)
else T))
do (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" (fetch (DLIONSTREAM FULLFILENAME)
of stream)
T)))))
(\LFExtendFile
(LAMBDA (stream minBackingFileSize) (* hts: "13-Aug-85 13:07")
(* * Extends the backing file for stream so that its backing file is at least minBackingFileSize.)
(PROG ((vol (fetch (DLIONSTREAM VOLUME) of stream))
(fileDesc (fetch (DLIONSTREAM FILEDESC) of stream)))
(UNINTERRUPTABLY
(OR (\PFNewPages vol fileDesc (create PageGroup
filePage ←(fetch (FileDescriptor size)
of fileDesc)
volumePage ← 0
nextFilePage ←(MAX minBackingFileSize
(IPLUS (fetch (FileDescriptor
size)
of fileDesc)
\LFrunSize))))
(RETURN NIL))
(\UPDATEOF stream)
(\LFUpdateLeaderPage stream))
(RETURN stream))))
)
(DEFINEQ
(\LFGetFileInfo
(DLAMBDA ((stream (ONEOF ATOM STRINGP DLIONSTREAM))
(attribute (ONEOF ATOM STRINGP))
(device (ONEOF NIL LFDEV))
(RETURNS (ONEOF ATOM STRINGP)))
(* hts: "14-Feb-85 23:17")
(* * Get the value of the attribute for a file. If stream is a filename, then the file is not open.
If stream is a STREAM, then it is open and has valid information in it.)
(WITH.MONITOR \LFtopMonitor (AND (OR (type? DLIONSTREAM stream)
(type? DLIONSTREAM (SETQ stream (\LFGetStreamForFile
stream
(QUOTE OLD)
(QUOTE INPUT)
NIL NIL))))
(PROG ((infoPage (fetch (DLIONSTREAM LEADERPAGE) of stream)))
(RETURN (SELECTQ (MKATOM (U-CASE attribute))
(LENGTH
(\UPDATEOF stream)
(IPLUS (ITIMES (fetch (STREAM EPAGE)
of stream)
BYTESPERPAGE)
(fetch (STREAM EOFFSET)
of stream)))
(SIZE (\UPDATEOF stream)
(IPLUS (fetch (STREAM EPAGE)
of stream)
(FOLDHI (fetch (STREAM
EOFFSET)
of stream)
BYTESPERPAGE)))
(TYPE (fetch (LeaderPage TYPE)
of infoPage))
(WRITEDATE (GDATE (fetch (LeaderPage
TimeWrite)
of infoPage)))
(READDATE (GDATE (fetch (LeaderPage
TimeRead)
of infoPage)))
(CREATIONDATE (GDATE (fetch (LeaderPage
TimeCreate)
of infoPage)))
(IWRITEDATE (fetch (LeaderPage TimeWrite)
of infoPage))
(IREADDATE (fetch (LeaderPage TimeRead)
of infoPage))
(ICREATIONDATE (fetch (LeaderPage
TimeCreate)
of infoPage))
(AUTHOR (fetch (LeaderPage author)
of infoPage))
NIL)))))))
)
(DEFINEQ
(\LFGetFileName
(DLAMBDA ((FileName (ONEOF ATOM STRINGP))
(Recog LITATOM)
(Dev LFDEV)
(RETURNS (ONEOF NIL LITATOM)))
(* hts: "13-Feb-85 16:50")
(* * Maps a filename onto a fully specified filename if it exists, or onto NIL if it doesn't exist.)
(WITH.MONITOR \LFtopMonitor (DPROG ((fileSpec (\LFFileSpec FileName Recog) (ONEOF NIL DFSFileSpec)))
(RETURN (AND fileSpec (\LFFullFileName (fetch (DFSFileSpec
EXPANDEDNAME)
of fileSpec))))))))
)
(DEFINEQ
(\LFEventFn
(DLAMBDA ((Dev LFDEV)
(Event ATOM))
(* hts: "14-Aug-85 17:19")
(* * Determines dliondisk fdev behaviour across major system events. Must make the file system wake up properly on
different machines, or even on the same machine with a different disk partitioning.)
(WITH.MONITOR \LFtopMonitor (SELECTQ Event
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(* * Close down the device)
(\LFCloseDevice)
(* * Force Pilot reinitialization)
(\PFEnsureInitialized T)
(* * Reopen the device if possible.)
(\LFOpenDevice)
(* * take down and replace the DSKDISPLAY window, if you have one open. This reshapes the window if you move to a
DLion with a different number of volumes, and flushes the window if you move from a Dlion to a Dorado)
(if (DEFINEDP (QUOTE DSKDISPLAY))
then (DSKDISPLAY (DSKDISPLAY (QUOTE CLOSED))))
(* * If on an alien machine, make sure you won't attempt to reopen files. Note that if you're still on a dlion or
dove, the reopenfile method will not break, but will simply return NIL if the file isn't there
(say if someone deleted it since this Lisp image was last run, or if the disk changed).)
(SELECTQ (MACHINETYPE)
((DANDELION DOVE)
NIL)
(replace (FDEV REOPENFILE) of Dev
with (FUNCTION NILL))))
((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS BEFORESAVEVM)
(* * BVM claims you should flush open streams associated with this device only before logout)
(if (EQ Event (QUOTE BEFORELOGOUT))
then (\FLUSH.OPEN.STREAMS Dev))
(* * Save out buffers.)
(for vol in (\PFGetVols) when (\LFDirectoryP vol)
do (\PFSaveBuffers vol)))
NIL))))
)
(DEFINEQ
(\LFDirectoryNameP
(DLAMBDA ((DirSpec (ONEOF ATOM STRINGP))
(RETURNS (ONEOF NIL STRINGP)))
(* hts: " 6-Aug-85 14:24")
(* * Implements the DIRECTORYNAMEP method for the dlionfs. If DirSpec is a reasonable directory specification,
returns the canonical form of that directory; otherwise returns NIL)
(* * DirSpec (a) must parse correctly, (b) must have a proper directory associated with it, and
(c) might have a subdirectory nestled in it.)
(WITH.MONITOR \LFtopMonitor
(DPROG ((PARSED NIL (ONEOF NIL PARSEDFILENAME))
(DIR NIL (ONEOF NIL LogicalVolumeDescriptor))
(SUBDIREND NIL (ONEOF NIL FIXP)))
(RETURN (AND (SETQ PARSED (\LFParseFileName DirSpec))
(SETQ DIR (\LFFindDirectoryVol (fetch (PARSEDFILENAME VOL)
of PARSED)))
(PACKFILENAME.STRING (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(U-CASE (fetch (LogicalVolumeDescriptor
LVlabel)
of DIR))
(QUOTE NAME)
(AND (SETQ SUBDIREND
(FIXP (LASTCHPOS (CHARCODE >)
(fetch (
PARSEDFILENAME NAME) of PARSED)
1)))
(U-CASE (SUBSTRING (fetch (
PARSEDFILENAME NAME) of PARSED)
1 SUBDIREND))))))))))
)
(DEFINEQ
(\LFTruncateFile
(DLAMBDA ((STREAM DLIONSTREAM)
(PAGE# (ONEOF NIL FIXP))
(OFFSET (ONEOF NIL SMALLP))
(RETURNS NIL))
(* hts: "16-Feb-85 18:20")
(* * Used to shorten or lengthen STREAM. If lengthening, pad the file with nulls. Used by SETEOFPTR and
FORCEOUTPUT.)
(* * Normalize arguments)
(\UPDATEOF STREAM)
(OR (FIXP PAGE#)
(SETQ PAGE# (fetch (DLIONSTREAM EPAGE) of STREAM)))
(OR (FIXP OFFSET)
(SETQ OFFSET (fetch (DLIONSTREAM EOFFSET) of STREAM)))
(* * If lengthening stream, pad it with nulls.)
(UNINTERRUPTABLY
(PROG ((FILEPTR (\GETFILEPTR STREAM)))
(to (DIFFERENCE (PLUS (TIMES PAGE# BYTESPERPAGE)
OFFSET)
(PLUS (TIMES (fetch (DLIONSTREAM EPAGE) of STREAM)
BYTESPERPAGE)
(fetch (DLIONSTREAM EOFFSET) of STREAM)))
do (\BOUT STREAM 0))
(\SETFILEPTR STREAM FILEPTR)))
(* * Record the new file length)
(replace (DLIONSTREAM EPAGE) of STREAM with PAGE#)
(replace (DLIONSTREAM EOFFSET) of STREAM with OFFSET)
(\LFUpdateLeaderPage STREAM)
(\PFSaveBuffers (fetch (DLIONSTREAM VOLUME) of STREAM))
NIL))
)
(RPAQQ LFDIRECTORYCOMS ((* * This module handles the Lisp directory part of the file system. The Lisp
directory maps literal file names onto Pilot file ID numbers
(which can then be looked up in the volume file map)
%. This module used to be in the file LFDIRECTORY.)
(* * Known problem: the directory is currently stored as a list rather than a
tree, so searches in a large directory take quite some time.)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (directorySize 50))
(RECORDS GenerateFileState GeneratedFile DIRSEARCHSTATE
PARSEDFILENAME ExpandedName DFSFileSpec)
(MACROS CONDCONCAT)
(MACROS PRINTDIRECTORY))
(* * Format of a directory entry is - bang (check ; should always contain !)
- type (0 = hole, 1 = file)
- entryLength - fileID (4 bytes)
- version# (2 bytes)
- filenameLength - filename (filenameLength bytes))
(* * Routines for mapping file names onto volumes and directories)
(FNS \LFFindDirectory \LFFindDirectoryVol \LFParseFileName)
(* * Creating and opening directories)
(FNS \LFMakeVolumeDirectory \LFDirectoryP \LFPurgeDirectory \LFCloseDirectory)
(* * Functions for making, deleting, and finding entries in a directory.)
(FNS \LFMakeDirEntry \LFRemoveDirEntry \LFReadFileID \LFFindDirHole
\LFMakeDirHole \LFCheckBang)
(FNS \LFDirectorySearch \LFVersions)
(FNS \LFFileSpec \LFUnpackName \LFFullFileName \LFFileName)
(FNS \LFDirectoryScrambled)
(FNS \LFDWIN \LFDWOUT)
(* * Directory enumeration)
(FNS \LFGenerateFiles \LFFindNextFile \LFSortFiles \LFHighestVersions
\LFFindInfo \LFReturnNextFile \LFReturnInfo)
(GLOBALVARS \LFtopMonitor)
(* * Holding onto directory streams)
(FNS \LFGetDirectory \LFPutDirectory \LFCreateDirectories)
(GLOBALVARS \LFdirectories)
(P (\LFCreateDirectories))
(* * Case array manipulation)
(FNS \LFINITCASEARRAY \LFCASEARRAYFETCH)
(GLOBALVARS \LFCASEARRAY \DISKNAMECASEARRAY)
(INITVARS (\LFCASEARRAY (\LFINITCASEARRAY)))))
(* * This module handles the Lisp directory part of the file system. The Lisp directory maps
literal file names onto Pilot file ID numbers (which can then be looked up in the volume file
map) %. This module used to be in the file LFDIRECTORY.)
(* * Known problem: the directory is currently stored as a list rather than a tree, so searches
in a large directory take quite some time.)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ directorySize 50)
(CONSTANTS (directorySize 50))
)
[DECLARE: EVAL@COMPILE
(TYPERECORD GenerateFileState (CURRENTFILE RESTOFFILES ATTRIBUTES))
(TYPERECORD GeneratedFile (FULLNAME NAME VERSION INFO))
(TYPERECORD DIRSEARCHSTATE (DIRPTR CHARLIST))
(TYPERECORD PARSEDFILENAME (VOL NAME VERSION))
(TYPERECORD ExpandedName (VOLNUM CHARLIST VERSION)
(* VERSION is the version indicator (either a positive integer or one of OLD, OLDEST, NEW) -
VOLNUM is the logical volume number, -
and the CHARLIST is a list of characters in the name.)
)
(TYPERECORD DFSFileSpec (EXPANDEDNAME FSDIRPTR))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS CONDCONCAT MACRO (ARGS (BQUOTE (CONCATLIST (for STR in , (CONS (QUOTE LIST)
ARGS)
when STR collect STR)))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS PRINTDIRECTORY MACRO (LAMBDA (STREAM)
(* hts: " 6-Aug-85 12:19")
(* * Prints the contents of a Lisp directory -- for debugging.)
(SETFILEPTR (\DTEST STREAM (QUOTE STREAM))
0)
(bind TYPE LENGTH START until (\EOFP STREAM)
do
(SETQ START (GETFILEPTR STREAM))
(\LFCheckBang STREAM)
(SETQ TYPE (BIN STREAM))
(SETQ LENGTH (BIN STREAM))
(if (EQ TYPE 1)
then
(printout NIL (\WIN STREAM)
" "
(\WIN STREAM)
" "
(\WIN STREAM)
" "
(PACKC (to (BIN STREAM)
collect
(BIN STREAM)))
T))
(SETFILEPTR STREAM (PLUS START (TIMES LENGTH
BYTESPERWORD))))))
)
)
(* * Format of a directory entry is - bang (check ; should always contain !) - type (0 = hole,
1 = file) - entryLength - fileID (4 bytes) - version# (2 bytes) - filenameLength - filename (
filenameLength bytes))
(* * Routines for mapping file names onto volumes and directories)
(DEFINEQ
(\LFFindDirectory
(DLAMBDA ((VOL (ONEOF NIL LogicalVolumeDescriptor ATOM STRINGP))
(RETURNS (ONEOF NIL DLIONSTREAM)))
(* hts: "29-Jan-85 20:43")
(* * Maps a volume name, descriptor, or number onto the directory stream for that volume. If the volume name is NIL,
finds the default directory stream. Opens the directory if it is not already open. If there is no appropriate
directory stream, returns NIL.)
(SETQ VOL (\LFFindDirectoryVol VOL))
(AND VOL (\LFDirectoryP VOL))))
(\LFFindDirectoryVol
(DLAMBDA ((VOL (ONEOF NIL LogicalVolumeDescriptor ATOM STRINGP))
(RETURNS (ONEOF NIL LogicalVolumeDescriptor)))
(* hts: "30-Jan-85 15:45")
(* * Maps a volume name, descriptor, or number into the descriptor for that volume provided the volume has a proper
Lisp directory on it. If VOL is NIL, finds the descriptor of the volume containing the default Lisp directory.
If there is no appropriate volume, returns NIL.)
(if VOL
then
(* * Normalize argument)
(COND
((type? LogicalVolumeDescriptor VOL))
((FIXP VOL)
(SETQ VOL (\PFGetVol VOL)))
((OR (ATOM VOL)
(STRINGP VOL))
(SETQ VOL (\PFGetLVPage VOL)))
(T (SHOULDNT)))
(* * Tell whether the specified volume has a proper Lisp directory on it.)
(AND VOL (\LFDirectoryP VOL)
VOL)
else
(* * Find the descriptor for the volume with the default Lisp directory on it.)
(PROG ((volumes (\PFGetVols))
(currentVol (\PFCurrentVol))
nextVolumes defaultVol)
(SETQ nextVolumes (for vols on volumes do (if (EQ currentVol (CAR vols))
then (RETURN (APPEND vols volumes)))))
(RETURN (for vol in nextVolumes thereis (\LFDirectoryP vol)))))))
(\LFParseFileName
(DLAMBDA ((FULLNAME (ONEOF ATOM STRINGP))
(RETURNS (ONEOF NIL PARSEDFILENAME)))
(* hts: "15-Feb-85 12:21")
(* * Returns the parse of a filename)
(PROG (DIRECTORY NAME EXT VERSION ENDVOLNAME)
(if (for TAIL on (UNPACKFILENAME.STRING FULLNAME) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(HOST NIL)
(DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
(EXTENSION (SETQ EXT (CADR TAIL)))
(VERSION (SETQ VERSION (CADR TAIL)))
(RETURN T)))
then (RETURN))
(SETQ ENDVOLNAME (STRPOS ">" DIRECTORY))
(RETURN (create PARSEDFILENAME
VOL ←(AND DIRECTORY (SUBSTRING DIRECTORY 1 (AND ENDVOLNAME (SUB1 ENDVOLNAME)
)))
NAME ←(CONDCONCAT (AND ENDVOLNAME (SUBSTRING DIRECTORY (ADD1 ENDVOLNAME)))
(AND ENDVOLNAME ">")
NAME "." EXT)
VERSION ←(if (EQ (NCHARS VERSION)
0)
then NIL
else (MKATOM VERSION)))))))
)
(* * Creating and opening directories)
(DEFINEQ
(\LFMakeVolumeDirectory
(DLAMBDA ((vol LogicalVolumeDescriptor)
(DONTOPEN BOOL)
(RETURNS (ONEOF NIL DLIONSTREAM)))
(* hts: " 9-Aug-85 18:06")
(* * Creates a Lisp directory for vol)
(* * First make sure there isn't already a directory)
(ASSERT (NULL (\LFDirectoryP vol)))
(UNINTERRUPTABLY
(PROG ((directoryID (\LFGenFileID vol))
file)
(* * Allocate and record pages for the directory file)
(SETQ file (create FileDescriptor
fileID ← directoryID
volNum ←(\PFVolumeNumber vol)
type ← tLispDirectory
size ← 0))
(OR (\PFNewPages vol file (create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← directorySize))
(DiskError "FILE SYSTEM RESOURCES EXCEEDED"))
(\PFSaveBuffers vol)
(* * Make and put a leader page for the directory file; dlionstream created here is just a throwaway)
(\LFMakeLeaderPage file (PACKFILENAME.STRING (QUOTE NAME)
(QUOTE DIRECTORY)
(QUOTE VERSION)
1)
NIL)
(* * Put pointer to this directory in the volume root directory)
(\PFInsertDirectoryID vol tLispDirectory directoryID))
(* * Open up the new directory)
(if DONTOPEN
then NIL
else (\LFDirectoryP vol)))))
(\LFDirectoryP
(DLAMBDA ((vol LogicalVolumeDescriptor)
(RETURNS (ONEOF NIL DLIONSTREAM)))
(* edited: "11-Mar-85 15:24")
(* * If there is a valid Lisp directory on volume vol, opens it (if it isn't already open) and returns it;
otherwise returns NIL. For there to be a valid directory, the volume must be a Pilot volume, there must be a root
directory on it with a Lisp directory entry, there must be an openable Lisp directory file, and the leader page of
that file must have the correct file system version number on it.)
(PROG (directoryID stream)
(RETURN (OR (AND (type? DLIONSTREAM (\LFGetDirectory vol))
(\LFGetDirectory vol))
(AND (\PFPilotVolumeP vol)
(SETQ directoryID (\PFFindDirectoryID vol tLispDirectory))
(SETQ stream (\LFOpenOldFile (create FileDescriptor
fileID ←(\PFFindDirectoryID vol
tLispDirectory)
volNum ←(\PFVolumeNumber vol)
type ← tLispDirectory)
(PACKFILENAME (QUOTE NAME)
(QUOTE DIRECTORY)
(QUOTE VERSION)
1)
NIL))
(EQ (fetch (LeaderPage version) of (fetch (DLIONSTREAM LEADERPAGE)
of stream))
lispFileVersion)
(PROGN (replace ACCESS of stream with (QUOTE BOTH))
(replace MAXBUFFERS of stream with MAX.SMALLP)
(\OPENFILE stream)
(\LFPutDirectory vol stream))))))))
(\LFPurgeDirectory
(DLAMBDA ((vol LogicalVolumeDescriptor)
(RETURNS NIL))
(* hts: "16-Feb-85 22:03")
(* * CLose the directory if it is open)
(\LFCloseDirectory vol)
(* * Take directory off disk if it is there)
(PROG ((directoryID (\PFFindDirectoryID vol tLispDirectory))
file)
(if directoryID
then (\PFRemoveDirectoryID vol tLispDirectory)
(SETQ file (create FileDescriptor
fileID ← directoryID
volNum ←(\PFVolumeNumber vol)
type ← tLispDirectory))
(replace (FileDescriptor size) of file with (\PFFindFileSize file))
(\PFTrimHelper vol file 0)))))
(\LFCloseDirectory
(DLAMBDA ((vol LogicalVolumeDescriptor)
(RETURNS NIL))
(* hts: " 7-Jan-85 18:11")
(* * Remove internal record of directory)
(if (\LFGetDirectory vol)
then (FORGETPAGES (\LFGetDirectory vol))
(\LFPutDirectory vol NIL))))
)
(* * Functions for making, deleting, and finding entries in a directory.)
(DEFINEQ
(\LFMakeDirEntry
(DLAMBDA ((stream DLIONSTREAM)
(UNAME ExpandedName)
(DirStream DLIONSTREAM)
(POS FIXP)
(RETURNS NIL))
(* hts: " 8-Aug-85 15:37")
(* * Makes a directory entry for a new file)
(PROG ((NC (LENGTH (fetch (ExpandedName CHARLIST) of UNAME)))
SIZE)
(* SIZE is how big the directory entry must be. The 10 is 1 byte !, 1 byte type, 1 byte entry length, 4 bytes
fileID, 2 bytes version, 1 byte string length (for filename))
(SETQ SIZE (IPLUS NC 10))
(* * Check entry and move to fileID field)
(\SETFILEPTR DirStream POS)
(\LFCheckBang DirStream)
(OR (EQ (\BIN DirStream)
0)
(\LFDirectoryScrambled DirStream))
(OR (GEQ (\BIN DirStream)
SIZE)
(\LFDirectoryScrambled DirStream))
(UNINTERRUPTABLY
(* * Write out fileID)
(\LFDWOUT DirStream (fetch (FileDescriptor fileID) of (fetch (DLIONSTREAM FILEDESC)
of stream)))
(* * Write out version number)
(\WOUT DirStream (fetch (ExpandedName VERSION) of UNAME))
(* * Write out filename preceded by number of chars in it (ie, as a bcpl string))
(\BOUT DirStream NC)
(for C in (fetch (ExpandedName CHARLIST) of UNAME) do (\BOUT DirStream C))
(* * When everything is ready, finally change the type from hole to file.)
(\SETFILEPTR DirStream (ADD1 POS))
(\BOUT DirStream 1))
(* * Remember where file is in directory)
(replace (DLIONSTREAM DIRINFO) of stream with POS)
(* * Write changes to directory file out to disk)
(FORCEOUTPUT DirStream))))
(\LFRemoveDirEntry
(LAMBDA (stream dirStream) (* hts: " 5-Jan-85 15:01")
(* * Change type of dir entry to hole and write changed directory pages out to disk)
(UNINTERRUPTABLY
(\SETFILEPTR dirStream (fetch (DLIONSTREAM DIRINFO) of stream))
(\LFCheckBang dirStream)
(\BOUT dirStream 0))
(* * Merge with following hole, if there is one)
(UNINTERRUPTABLY
(PROG ((ENTRYSIZE (\BIN dirStream))
NEXTENTRYSIZE)
(\SETFILEPTR dirStream (PLUS (fetch (DLIONSTREAM DIRINFO) of stream)
ENTRYSIZE))
(if (NOT (\EOFP dirStream))
then (\LFCheckBang dirStream)
(if (EQ (\BIN dirStream)
0)
then (SETQ NEXTENTRYSIZE (\BIN dirStream))
(\SETFILEPTR dirStream (PLUS (fetch (DLIONSTREAM DIRINFO)
of stream)
2))
(\BOUT dirStream (PLUS ENTRYSIZE NEXTENTRYSIZE))))))
(* * Force the altered directory out to disk)
(FORCEOUTPUT dirStream)))
(\LFReadFileID
(LAMBDA (directory position) (* hts: "11-Jan-85 02:05")
(* * Returns the file ID recorded in the entry beginning at position)
(\SETFILEPTR directory position)
(* * bang)
(\LFCheckBang directory)
(* * Make sure its not a hole)
(if (NEQ (BIN directory)
1)
then (\LFDirectoryScrambled))
(* * Entry length)
(\BIN directory)
(* * Finally read in the file id)
(\LFDWIN directory)))
(\LFFindDirHole
(LAMBDA (STREAM UNAME DIRSTREAM) (* hts: " 8-Aug-85 15:36")
(* * Finds or creates a hole in the directory large enough to fit the entry represented by UNAME.
Returns the byte address of the hole if sucessful, NIL otherwise. BYTES is how big the entry must be.
The 10 is 1 byte !, 1 byte type, 1 byte entry length, 4 bytes fileID, 2 bytes version, 1 byte string length
(for filename))
(the ExpandedName UNAME)
(bind (BYTES ←(PLUS 10 (LENGTH (fetch (ExpandedName CHARLIST) of UNAME))))
(PTR ←(OR (fetch (DLIONSTREAM DIRHOLEPTR) of DIRSTREAM)
0))
ENTRYLENGTH TYPE
do (\SETFILEPTR DIRSTREAM PTR)
(if (\EOFP DIRSTREAM)
then
(* * Make a new entry at the end of the file)
(RETURN (if (\LFMakeDirHole DIRSTREAM PTR BYTES)
then PTR
else NIL))
else (\LFCheckBang DIRSTREAM)
(SETQ TYPE (\BIN DIRSTREAM))
(SETQ ENTRYLENGTH (\BIN DIRSTREAM))
(if (AND (EQ TYPE 0)
(LEQ BYTES ENTRYLENGTH))
then
(* * Entry big enough)
(if (GEQ ENTRYLENGTH (PLUS BYTES 14))
then
(* * Too large, so break it apart. (Too large if there is room for another entry with filename of 3 or more chars.))
(UNINTERRUPTABLY
(\LFMakeDirHole DIRSTREAM (PLUS PTR BYTES)
(DIFFERENCE ENTRYLENGTH BYTES))
(\LFMakeDirHole DIRSTREAM PTR BYTES)))
(RETURN PTR)))
(SETQ PTR (IPLUS PTR ENTRYLENGTH)))))
(\LFMakeDirHole
(LAMBDA (DIRSTREAM WHERE HOLESIZE) (* hts: "10-Aug-85 08:17")
(* * Makes an empty slot in the directory; this slot will soon be used to hold a directory entry.
Returns DIRSTREAM if successful, NIL otherwise.)
(PROG ((DIRSIZE (fetch (FileDescriptor size) of (fetch (DLIONSTREAM FILEDESC) of DIRSTREAM))))
(* * Extends the directory if necessary.)
(if (LEQ (TIMES BYTESPERPAGE (SUB1 DIRSIZE))
(PLUS WHERE HOLESIZE))
then (if (NULL (\LFExtendFile DIRSTREAM (ADD1 DIRSIZE)))
then (RETURN NIL)))
(UNINTERRUPTABLY
(\SETFILEPTR DIRSTREAM WHERE)
(* * Mark beginning of entry)
(\BOUT DIRSTREAM (CHARCODE !))
(* * Mark as hole)
(\BOUT DIRSTREAM 0)
(* * Note size of hole)
(\BOUT DIRSTREAM HOLESIZE)
(* * Pad rest with nulls.)
(to (DIFFERENCE HOLESIZE 3) do (\BOUT DIRSTREAM 0)))
(* * FLush to disk.)
(FORCEOUTPUT DIRSTREAM)
(RETURN DIRSTREAM))))
(\LFCheckBang
(DLAMBDA ((DIRSTREAM DLIONSTREAM))
(* hts: "11-Jan-85 02:05")
(* * comment)
(OR (EQ (BIN DIRSTREAM)
(CHARCODE !))
(\LFDirectoryScrambled DIRSTREAM))))
)
(DEFINEQ
(\LFDirectorySearch
(DLAMBDA ((DIRSTREAM DLIONSTREAM)
(TLIST DIRSEARCHSTATE)
HMIN
(KINDOFMATCH (MEMQ EXACT PARTIAL)))
(* hts: " 6-Aug-85 12:15")
(* * Finds next directory entry for which (CDR TLIST) 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 -
DIRSTREAM 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.)
(bind (MATCH ← NIL)
(NEXT ←(fetch (DIRSEARCHSTATE DIRPTR) of TLIST))
(CHARLIST ←(fetch (DIRSEARCHSTATE CHARLIST) of TLIST))
THISNAMELENGTH TARGETLENGTH PTR TYP ENTRYLENGTH FILEID VERSION
first (if HMIN
then (replace (DLIONSTREAM DIRHOLEPTR) of DIRSTREAM with NIL))
(SETQ TARGETLENGTH (LENGTH CHARLIST))
until MATCH
do (\SETFILEPTR DIRSTREAM (SETQ PTR NEXT))
(if (\EOFP DIRSTREAM)
then (RETURN))
(* * Format of a directory entry is -
bang (check ; should always contain !) -
type (0 = hole, 1 = file) -
entryLength -
fileID (4 bytes) -
version# (2 bytes) -
filenameLength -
filename (filenameLength bytes))
(* * Old format was -
Type (0 = hole, 1 = file), 6 bits -
Length of entry in words, 10 bits -
FP 2 words -
Name as a bcpl string -- length in first byte)
(\LFCheckBang DIRSTREAM)
(SETQ TYP (\BIN DIRSTREAM))
(SETQ ENTRYLENGTH (\BIN DIRSTREAM))
(SETQ NEXT (IPLUS PTR ENTRYLENGTH))
(if (EQ TYP 0)
then
(* * Not a file; if hole is of right length etc., cache its position)
(if (AND HMIN (ILEQ HMIN ENTRYLENGTH))
then (replace (DLIONSTREAM DIRHOLEPTR) of DIRSTREAM with PTR)
(SETQ HMIN NIL))
else (SETQ FILEID (\LFDWIN DIRSTREAM))
(SETQ VERSION (\WIN DIRSTREAM))
(SETQ THISNAMELENGTH (\BIN DIRSTREAM))
(if (OR (AND (EQ KINDOFMATCH (QUOTE EXACT))
(EQ THISNAMELENGTH TARGETLENGTH))
(AND (EQ KINDOFMATCH (QUOTE PARTIAL))
(GEQ THISNAMELENGTH TARGETLENGTH)))
then (SETQ MATCH (for C in CHARLIST always (EQ C (\LFCASEARRAYFETCH
(\BIN DIRSTREAM)))))))
finally
(* * Leave directory file pointer at beginning of entry)
(\SETFILEPTR DIRSTREAM PTR)
(* * Remember where next entry is)
(replace (DIRSEARCHSTATE DIRPTR) of TLIST with NEXT)
(* * Return the number of unmatched chars)
(RETURN (IDIFFERENCE THISNAMELENGTH TARGETLENGTH)))))
(\LFVersions
(DLAMBDA ((UNPACKEDNAME ExpandedName)
(STREAM DLIONSTREAM)
HMIN
(RETURNS LST))
(* hts: "13-Feb-85 16:40")
(* UNPACKEDNAME 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.)
(bind (TLIST ←(create DIRSEARCHSTATE
DIRPTR ← 0
CHARLIST ←(fetch (ExpandedName CHARLIST) of UNPACKEDNAME)))
(FIXEDVERSION ←(FIXP (fetch (ExpandedName VERSION) of UNPACKEDNAME)))
PTR RESULT version
first (OR (NULL FIXEDVERSION)
(GREATERP FIXEDVERSION 0)
(SETQ FIXEDVERSION NIL))
(if (EQ HMIN T)
then (SETQ HMIN 20))
do (if (NULL (\LFDirectorySearch STREAM TLIST HMIN (QUOTE EXACT)))
then (RETURN (SORT RESULT (FUNCTION (LAMBDA (A B)
(LESSP (CAR A)
(CAR B)))))))
(* * DirectorySearch leaves directory file ptr at beginning of entry. Record beginning of entry)
(SETQ PTR (\GETFILEPTR STREAM))
(* * Read up to version number)
(\LFCheckBang STREAM) (* Bang!)
(OR (EQ (\BIN STREAM)
1)
(\LFDirectoryScrambled)) (* type = file)
(\BIN STREAM) (* Entry length)
(\LFDWIN STREAM) (* file ID)
(* * Read version number)
(SETQ version (\WIN STREAM))
(* * Name matches. version is the version number. Cons up a piece of the result. If UNPACKEDNAME has an explicit
version, insist on it now)
(if FIXEDVERSION
then (if (EQ version FIXEDVERSION)
then (RETURN (LIST (CONS version PTR))))
else (* Merge new element into RESULT)
(push RESULT (CONS version PTR)))
(* * Stop looking if found a hole)
(if (AND HMIN (fetch (DLIONSTREAM DIRHOLEPTR) of STREAM))
then (SETQ HMIN NIL)))))
)
(DEFINEQ
(\LFFileSpec
(DLAMBDA ((NAME (ONEOF ATOM STRINGP))
(RECOG ATOM)
(RETURNS (ONEOF NIL DFSFileSpec)))
(* hts: "13-Feb-85 16:54")
(* * 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 (dirPtr version versionList (UNPACKEDNAME (\LFUnpackName NAME))
DIRSTREAM)
(* * If name didn't unpack properly, return NIL)
(OR UNPACKEDNAME (RETURN))
(* * If there is no directory for the specified name, return NIL)
(OR DIRSTREAM (SETQ DIRSTREAM (\LFFindDirectory (fetch (ExpandedName VOLNUM) of
UNPACKEDNAME)))
(RETURN))
(* * Build file specification)
(COND
((AND (SETQ versionList (\LFVersions UNPACKEDNAME DIRSTREAM (SELECTQ RECOG
((NEW OLD/NEW)
T)
NIL)))
(SETQ version (SELECTQ (OR (fetch (ExpandedName VERSION) of UNPACKEDNAME)
RECOG)
((OLD OLD/NEW)
(CAR (LAST versionList)))
(NEW (* A new version, so the DIRPTR is NIL)
(LIST (ADD1 (CAAR (LAST versionList)))))
(OLDEST (CAR versionList))
(ASSOC (fetch (ExpandedName VERSION) of UNPACKEDNAME)
versionList))))
(SETQ dirPtr (CDR version))
(SETQ version (CAR version)))
(T (SETQ dirPtr NIL) (* Since file doesnt exist, recognition mode takes
precedence over version number)
(SETQ version (SELECTQ (OR RECOG (fetch (ExpandedName VERSION) of UNPACKEDNAME))
((NEW OLD/NEW)
(OR (FIXP (fetch (ExpandedName VERSION) of UNPACKEDNAME))
1))
((OLD OLDEST)
NIL)
(FIXP (fetch (ExpandedName VERSION) of UNPACKEDNAME))))))
(* We may have to zap a version number that was
specified but not found)
(replace (ExpandedName VERSION) of UNPACKEDNAME with version)
(RETURN (create DFSFileSpec
EXPANDEDNAME ← UNPACKEDNAME
FSDIRPTR ← dirPtr)))))
(\LFUnpackName
(DLAMBDA ((name (ONEOF ATOM STRINGP))
(RETURNS (ONEOF NIL ExpandedName)))
(* mjs "18-Mar-85 16:37")
(* * Unpacks file name into a UNAME of the form ((VERSION . VOLNUM) . CHARLIST) where VERSION is the version
indicator (either a positive integer or one of OLD, OLDEST, NEW) VOLNUM is the logical volume number, and the
CHARLIST is a list of characters in the name. Returns NIL if the given name is not valid.)
(DPROG ((PARSEDNAME (\LFParseFileName name) PARSEDFILENAME)
VOL charList version)
(OR PARSEDNAME (RETURN))
(SETQ VOL (\LFFindDirectoryVol (fetch (PARSEDFILENAME VOL) of PARSEDNAME)))
(OR VOL (RETURN))
(SETQ charList (for char instring (fetch (PARSEDFILENAME NAME) of PARSEDNAME)
collect (* check for illegal chars)
(SETQ char (\LFCASEARRAYFETCH char))
(if (FMEMB char (LIST 0 (\LFCASEARRAYFETCH (CHARCODE *))
(\LFCASEARRAYFETCH (CHARCODE ?))))
then (RETURN NIL))
char))
(OR charList (RETURN))
(SETQ version (fetch (PARSEDFILENAME VERSION) of PARSEDNAME))
(SETQ version (OR (FIXP version)
(SELECTQ version
(H (QUOTE OLD))
(L (QUOTE OLDEST))
(N (QUOTE NEW))
NIL)))
(RETURN (create ExpandedName
VOLNUM ←(\PFVolumeNumber VOL)
CHARLIST ← charList
VERSION ← version)))))
(\LFFullFileName
(DLAMBDA ((UNPACKEDNAME ExpandedName)
(RETURNS (ONEOF NIL LITATOM)))
(* hts: "13-Feb-85 16:41")
(* * Puts together a full file name (including host, directory, subdirectory, name, and version) from a uname)
(AND (fetch (ExpandedName VERSION) of UNPACKEDNAME)
(PACKFILENAME (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(U-CASE (fetch (LogicalVolumeDescriptor LVlabel)
of (\PFGetVol (fetch (ExpandedName VOLNUM) of UNPACKEDNAME))))
(QUOTE NAME)
(\LFFileName UNPACKEDNAME)))))
(\LFFileName
(DLAMBDA ((UNPACKEDNAME ExpandedName)
(RETURNS STRINGP))
(* hts: "13-Feb-85 16:43")
(* * Puts together the subdirectory, filename, and version of a file from its uname)
(PROG ((CHARLIST (fetch (ExpandedName CHARLIST) of UNPACKEDNAME))
(VERSION (CHCON (OR (FIXP (fetch (ExpandedName VERSION) of UNPACKEDNAME))
1)))
CHARLISTLENGTH NAME)
(SETQ CHARLISTLENGTH (LENGTH CHARLIST))
(SETQ NAME (ALLOCSTRING (PLUS CHARLISTLENGTH 1 (LENGTH VERSION))))
(for I from 1 as CHAR in CHARLIST do (RPLCHARCODE NAME I CHAR))
(RPLCHARCODE NAME (ADD1 CHARLISTLENGTH)
(CHARCODE ;))
(for I from (PLUS CHARLISTLENGTH 2) as CHAR in VERSION do (RPLCHARCODE NAME I CHAR))
(RETURN NAME))))
)
(DEFINEQ
(\LFDirectoryScrambled
(LAMBDA (DIRSTREAM) (* hts: "16-Jan-85 17:01")
(* * comment)
(printout PROMPTWINDOW "Local directory scrambled: " T (PACKFILENAME.STRING
(QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(U-CASE (fetch (LogicalVolumeDescriptor LVlabel) of (fetch (DLIONSTREAM VOLUME)
of DIRSTREAM))))
T "Try scavenging the directory.")
(DiskError "HARD DISK ERROR")))
)
(DEFINEQ
(\LFDWIN
(LAMBDA (FILE) (* jds " 3-JAN-83 16:08")
(IPLUS (LLSH (\BIN FILE)
24)
(LLSH (\BIN FILE)
16)
(LLSH (\BIN FILE)
8)
(\BIN FILE))))
(\LFDWOUT
(LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30")
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 24)))
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 16)))
(\BOUT FILE (LOGAND 255 (LRSH NUMBER 8)))
(\BOUT FILE (LOGAND 255 NUMBER))))
)
(* * Directory enumeration)
(DEFINEQ
(\LFGenerateFiles
(DLAMBDA ((FDEV LFDEV)
(PATTERN (ONEOF ATOM STRINGP))
(DESIREDPROPS (LST OF (ONEOF ATOM STRINGP)))
(RETURNS LISTP))
(* hts: "15-Feb-85 12:31")
(* * Returns a file-generator object that will generate exactly those files in the sys-dir of FDEV whose names match
PATTERN.)
(WITH.MONITOR \LFtopMonitor
(DPROG ((PARSED NIL PARSEDFILENAME)
(DIRECTORYSTREAM NIL DLIONSTREAM)
(SEARCHSTATE NIL DIRSEARCHSTATE)
(GENFILTER NIL)
(HOST&DIRNAME NIL STRINGP)
(NEXTFILE NIL (ONEOF NIL GeneratedFile))
(FILELIST NIL (LST OF GeneratedFile)))
(SETQ PARSED (OR (\LFParseFileName PATTERN)
(RETURN (\NULLFILEGENERATOR))))
(SETQ DIRECTORYSTREAM (OR (\LFFindDirectory (fetch (PARSEDFILENAME VOL)
of PARSED))
(RETURN (\NULLFILEGENERATOR))))
(SETQ SEARCHSTATE (create DIRSEARCHSTATE
DIRPTR ← 0
CHARLIST ←(the (LST OF SMALLP)
(for C instring (fetch (PARSEDFILENAME
NAME)
of PARSED)
until (SELCHARQ (SETQ C
(
\LFCASEARRAYFETCH C))
((# *)
(* \LFDirectorySearch currently only checks prefixes,
so we truncate at the first * or escape.
Also ignore version specifications,)
T)
NIL)
collect C))))
(SETQ GENFILTER (DIRECTORY.MATCH.SETUP (CONDCONCAT (fetch (PARSEDFILENAME
NAME)
of PARSED)
";"
(fetch (PARSEDFILENAME
VERSION)
of PARSED))))
(SETQ HOST&DIRNAME (PACKFILENAME.STRING (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(U-CASE (fetch (LogicalVolumeDescriptor
LVlabel)
of (fetch (DLIONSTREAM
VOLUME)
of DIRECTORYSTREAM))))
)
(* * Generate a list of all the files that match the spec.)
(while (SETQ NEXTFILE (\LFFindNextFile DIRECTORYSTREAM SEARCHSTATE GENFILTER
HOST&DIRNAME))
do (push FILELIST NEXTFILE))
(* * Sort the list of files. Not all directory enumeration requests require sorting, but almost all do, so I just
sort them all for simplicity.)
(\LFSortFiles FILELIST)
(* * Highest version enumeration: if the pattern does not have a version, then should return only the highest
version of each file. \LFHighestVersions requires that the file list be sorted first.)
(if (OR (EQ (NCHARS (fetch (PARSEDFILENAME VERSION) of PARSED))
0)
(NULL (fetch (PARSEDFILENAME VERSION) of PARSED)))
then (SETQ FILELIST (\LFHighestVersions FILELIST)))
(* * Dig up any file info that the caller has indicated he will request. (During the enumeration, the user can ask
for any of the file properties in DESIREDPROPS.) This is done here and stored (rather than later when it is actually
requested) to avoid the problem of a file having been deleted by another process before its properties could be dug
up. Here that is safe, since this is being done under the top-level file system monitorlock.)
(\LFFindInfo FILELIST DESIREDPROPS DIRECTORYSTREAM)
(* * Finally return the file generator object.)
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \LFReturnNextFile)
FILEINFOFN ←(FUNCTION \LFReturnInfo)
GENFILESTATE ←(create GenerateFileState
CURRENTFILE ← NIL
RESTOFFILES ← FILELIST
ATTRIBUTES ← DESIREDPROPS)))))))
(\LFFindNextFile
(DLAMBDA ((directory DLIONSTREAM)
(SEARCHSTATE DIRSEARCHSTATE)
(FILTER ANY)
(HOST&DIRNAME STRINGP)
(RETURNS (ONEOF NIL GeneratedFile)))
(* mjs "20-Feb-85 21:05")
(* * Finds the next file in directory that matches the specified filter, and returns its name, version, directory
position, etc., if there is one.)
(bind (ANOTHERENTRY ← NIL)
ENTRYSTART VERSION FILENAME CHARS NAMELEN
do (SETQ ANOTHERENTRY (\LFDirectorySearch directory SEARCHSTATE NIL (QUOTE PARTIAL)))
(if ANOTHERENTRY
then
(* * \LFDirectorySearch leaves directory file ptr at beginning of entry. Read name and version.)
(SETQ ENTRYSTART (\GETFILEPTR directory))
(\LFCheckBang directory) (* bang)
(OR (EQ (\BIN directory)
1)
(\LFDirectoryScrambled)) (* type)
(\BIN directory) (* entry length)
(\LFDWIN directory) (* file ID)
(SETQ VERSION (\WIN directory)) (* version)
(SETQ NAMELEN (\BIN directory))
(SETQ CHARS (to NAMELEN collect (\BIN directory)))
(* name)
(* * Construct the name of the file)
(SETQ FILENAME (\LFFileName (create ExpandedName
CHARLIST ← CHARS
VERSION ← VERSION))))
repeatuntil (OR (NOT ANOTHERENTRY)
(NOT FILTER)
(DIRECTORY.MATCH FILTER FILENAME))
finally (RETURN (if ANOTHERENTRY
then (create GeneratedFile
FULLNAME ←(CONCAT HOST&DIRNAME FILENAME)
NAME ←(SUBSTRING FILENAME 1 NAMELEN)
VERSION ← VERSION
INFO ← ENTRYSTART)
else NIL)))))
(\LFSortFiles
(DLAMBDA ((FILES (LST OF GeneratedFile))
(RETURNS NIL))
(* hts: "15-Feb-85 12:45")
(* * Sorts the list of generated files. Not all requests for directory enumeration require that the files be sorted,
but most do, so I just sort them all. Note that in comparing names, you must not compare the version part of the
name (hence the SUBSTRING stuff), since ALPHORDER does not get versions in the right order.)
(SORT FILES (FUNCTION (DLAMBDA ((A GeneratedFile)
(B GeneratedFile)
(RETURNS BOOL))
(SELECTQ (UALPHORDER (fetch (GeneratedFile NAME) of A)
(fetch (GeneratedFile NAME) of B))
(LESSP T)
(EQUAL (LESSP (fetch (GeneratedFile VERSION) of A)
(fetch (GeneratedFile VERSION) of B)))
NIL))))
NIL))
(\LFHighestVersions
(DLAMBDA ((FILELIST (LST OF GeneratedFile))
(RETURNS (LST OF GeneratedFile)))
(* hts: "15-Feb-85 12:45")
(* * Extracts the highest version files from a list of sorted files.)
(for FILES on FILELIST when (NOT (AND (LISTP (CDR FILES))
(type? GeneratedFile (CADR FILES))
(STREQUAL (fetch (GeneratedFile NAME) of (CAR FILES))
(fetch (GeneratedFile NAME) of (CADR FILES)))))
collect (CAR FILES))))
(\LFFindInfo
(DLAMBDA ((FILES (LST OF GeneratedFile))
(PROPS (LST OF (ONEOF ATOM STRINGP)))
(DIRECTORY DLIONSTREAM)
(RETURNS NIL))
(* hts: "16-Feb-85 17:07")
(* * Digs up any file info that the caller has indicated he will request. (During the enumeration, the user can ask
for any of the file properties in DESIREDPROPS.) This is done here and stored (rather than later when it is actually
requested) to avoid the problem of a file having been deleted by another process before its properties could be dug
up. Here that is safe, since this is being done under the top-level file system monitorlock.
This info is later read and returned to the user by \LFReturnInfo.)
(if (LISTP PROPS)
then (bind ENTRYSTART STREAM (BACKWARDPROPS ←(REVERSE PROPS)) for FILE in FILES
do
(* * Build a stream for the current file; this stream will be used and reused for getting the file attributes.
Kind of a weird entry to the OpenFile stuff, but that's because you already have your finger on the directory entry
and don't have to bother looking it up again.)
(SETQ ENTRYSTART (fetch (GeneratedFile INFO) of FILE))
(replace (GeneratedFile INFO) of FILE with NIL)
(SETQ STREAM (\LFOpenOldFile (create FileDescriptor
fileID ←(\LFReadFileID DIRECTORY ENTRYSTART)
volNum ←(fetch (FileDescriptor volNum)
of (fetch (DLIONSTREAM FILEDESC)
of DIRECTORY))
type ← tLispFile)
NIL ENTRYSTART))
(replace ACCESS of STREAM with (QUOTE INPUT))
(* * Now get all the info and save it.)
(for ATTRIBUTE in BACKWARDPROPS do (push (fetch (GeneratedFile INFO) of FILE)
(GETFILEINFO STREAM ATTRIBUTE)))))))
(\LFReturnNextFile
(DLAMBDA ((GENERATED GenerateFileState)
(RETURNS (ONEOF NIL STRINGP)))
(* hts: "15-Feb-85 12:36")
(* * comment)
(if (NULL (fetch (GenerateFileState RESTOFFILES) of GENERATED))
then NIL
else (replace (GenerateFileState CURRENTFILE) of GENERATED with (pop (fetch (GenerateFileState
RESTOFFILES)
of GENERATED)))
(fetch (GeneratedFile FULLNAME) of (fetch (GenerateFileState CURRENTFILE) of GENERATED)))))
(\LFReturnInfo
(DLAMBDA ((GENERATED GenerateFileState)
(PROP (ONEOF ATOM STRINGP))
(RETURNS (ONEOF ATOM STRINGP)))
(* edited: "11-Mar-85 18:41")
(* * comment)
(for ATTRIB in (fetch (GenerateFileState ATTRIBUTES) of GENERATED) as INFOVAL
in (fetch (GeneratedFile INFO) of (fetch (GenerateFileState CURRENTFILE) of GENERATED))
do (if (EQ (MKATOM (U-CASE ATTRIB))
(MKATOM (U-CASE PROP)))
then (RETURN INFOVAL)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LFtopMonitor)
)
(* * Holding onto directory streams)
(DEFINEQ
(\LFGetDirectory
(LAMBDA (vol) (* hts: " 5-Jan-85 15:49")
(ELT \LFdirectories (OR (FIXP vol)
(\PFVolumeNumber vol)))))
(\LFPutDirectory
(DLAMBDA ((vol (ONEOF FIXP LogicalVolumeDescriptor))
(directory (ONEOF NIL DLIONSTREAM))
(RETURNS (ONEOF NIL DLIONSTREAM)))
(* hts: " 7-Jan-85 15:38")
(SETA \LFdirectories (OR (FIXP vol)
(\PFVolumeNumber vol))
directory)))
(\LFCreateDirectories
(LAMBDA NIL (* hts: " 7-Jan-85 15:15")
(if (NOT (AND (BOUNDP (QUOTE \LFdirectories))
(type? ARRAYP \LFdirectories)
(ZEROP (ARRAYORIG \LFdirectories))
(EQ maxLogicalVolumes (ARRAYSIZE \LFdirectories))))
then (SETQ \LFdirectories (ARRAY maxLogicalVolumes NIL NIL 0))
(SETQ \PFInitialized NIL))
NIL))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LFdirectories)
)
(\LFCreateDirectories)
(* * Case array manipulation)
(DEFINEQ
(\LFINITCASEARRAY
(LAMBDA NIL (* hts: "26-Oct-84 12:51")
(* * \DISKNAMECASEARRAY is a case array set up by mod44io. Unfortunately,it counts > as an illegal filename char, so
we need to make a copy with that fixed.)
(PROG ((CASEARRAY (COPYARRAY \DISKNAMECASEARRAY)))
(\PUTBASEBYTE (fetch (ARRAYP BASE) of CASEARRAY)
(CHARCODE >)
(CHARCODE >))
(RETURN CASEARRAY))))
(\LFCASEARRAYFETCH
(LAMBDA (CHARCODE) (* hts: " 5-Jan-85 15:48")
(* * comment)
(\GETBASEBYTE (fetch (ARRAYP BASE) of \LFCASEARRAY)
CHARCODE)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LFCASEARRAY \DISKNAMECASEARRAY)
)
(RPAQ? \LFCASEARRAY (\LFINITCASEARRAY))
(RPAQQ SCAVENGEDSKDIRECTORYCOMS ((* * This module contains routines for scavenging the Lisp directory
in the event that it should become smashed. It used to be in the
file SCAVENGEDSKDIRECTORY.)
(* * Directory (LFDIRECTORY)
level stuff)
(FNS SCAVENGEDSKDIRECTORY SCAVENGEVOLUME \LFScavFileName
\LFScavVersion)
(GLOBALVARS \LFtopMonitor)
(* * Volume file map (LFFILEMAP)
level stuff)
(FNS \VFMGenerateFileIDs)))
(* * This module contains routines for scavenging the Lisp directory in the event that it
should become smashed. It used to be in the file SCAVENGEDSKDIRECTORY.)
(* * Directory (LFDIRECTORY) level stuff)
(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))))))))
(SCAVENGEVOLUME
(LAMBDA (volName) (* hts: " 4-Jul-85 18:30")
(* * for backward compatibility)
(SCAVENGEDSKDIRECTORY volName)))
(\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)))))
(\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))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LFtopMonitor)
)
(* * Volume file map (LFFILEMAP) level stuff)
(DEFINEQ
(\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))))))
)
(RPAQQ LFPILOTFILECOMS ((* * This module (together with its two sub-modules, FILEMAP and
ALLOCATIONMAP)
define the necessary subset of the Pilot file system. This used to be
contained in the file LFPILOTFILE.)
(* * These functions transfer pages to and from the disk)
(FNS \PFGetPhysicalVolumePage)
(FNS \PFGetLogicalVolumePage \PFPutLogicalVolumePage)
(FNS \PFGetMarkerPage \PFPutMarkerPage)
(FNS \PFGetFreePage \PFCreateFreePage)
(FNS \PFGetAllocationMapPage \PFPutAllocationMapPage)
(FNS \PFGetFileMapPage \PFPutFileMapPage)
(FNS \PFGetPage \PFPutPage \PFCreatePage)
(FNS \PFTransferFilePage)
(FNS \PFTransferPage)
(DECLARE: DONTEVAL@LOAD (P (\LOCKFN (QUOTE \PFTransferPage))))
(RESOURCES label)
(* * File Descriptor pool for system files)
(FNS \PFCreateFileDescriptors \PFInitFileDescriptors)
(GLOBALVARS \PFLogicalVolumeFileD \PFMarkerFileD \PFFreeFileD
\PFAllocationMapFileD \PFFileMapFileD)
(P (\PFCreateFileDescriptors))
(* * Physical volume interface)
(FNS \PFCreatePhysicalVolume)
(GLOBALVARS \PhysVolumePage)
(P (\PFCreatePhysicalVolume))
(* * Interface to logical volumes,)
(FNS \PFCreateVols \PFInitializeVols \PFGetVols \PFGetVol \PFVolumeNumber)
(GLOBALVARS \DFSLogicalVolumes \DFSLogicalVolumeHash)
(P (\PFCreateVols))
(FNS \PFGetLVPage)
(* * Pilot integrity)
(FNS \PFVersionOK \PFPilotVolumeP)
(* * Pilot initialization)
(FNS \PFEnsureInitialized)
(GLOBALVARS \PFInitialized)
(INITVARS (\PFInitialized NIL))
(P (ADDTOVAR \SYSTEMCACHEVARS \PFInitialized))
(P (\PFEnsureInitialized))
(* * Root directory management)
(FNS \PFFindDirectoryID \PFInsertDirectoryID \PFRemoveDirectoryID)
(FNS \PFFindRootDirEntry \PFAddRootDirEntry \PFRemoveRootDirEntry
\PFFindRootDirEntryNum \PFPatchRootDirEntries)
(FNS \PFGetRootDirectory \PFPutRootDirectory \PFCreateRootDirectory
\PFPurgeRootDirectory)
(FNS \GetRootDirectoryType \PFPutRootDirectoryType)
(* * Pilot file management)
(FNS \PFNewPages \PFTrimHelper \PFFindPageAddr \PFFindFileSize
\PFFreeDiskPages \PFRoomForFile \PFSaveBuffers)
(* * Lisp vmem)
(FNS \PFCurrentVol)
(* * Display stub; real volume display stuff is implemented on a library
package called VOLUMEDISPLAY.)
(FNS \PFDsplyVolumes)))
(* * This module (together with its two sub-modules, FILEMAP and ALLOCATIONMAP) define the
necessary subset of the Pilot file system. This used to be contained in the file LFPILOTFILE.)
(* * These functions transfer pages to and from the disk)
(DEFINEQ
(\PFGetPhysicalVolumePage
(LAMBDA (buffer) (* hts: " 5-Jan-85 16:14")
(\PFTransferPage 0 buffer (QUOTE VRR)
(create Label))))
)
(DEFINEQ
(\PFGetLogicalVolumePage
(LAMBDA (vol frame) (* hts: "28-Nov-84 16:41")
(* * comment)
(\PFGetPage (ELT \PFLogicalVolumeFileD (OR (FIXP vol)
(\PFVolumeNumber vol)))
0 0 frame)))
(\PFPutLogicalVolumePage
(LAMBDA (vol frame) (* hts: "28-Nov-84 16:41")
(* * comment)
(\PFPutPage (ELT \PFLogicalVolumeFileD (OR (FIXP vol)
(\PFVolumeNumber vol)))
0 0 frame)))
)
(DEFINEQ
(\PFGetMarkerPage
(LAMBDA (vol frame) (* hts: "29-Nov-84 12:26")
(* * comment)
(OR (FIXP vol)
(SETQ vol (\PFVolumeNumber vol)))
(\PFGetPage (ELT \PFMarkerFileD vol)
(IPLUS (LvBasePageAddr vol)
(MarkerPageAddr vol))
(MarkerPageAddr vol)
frame)))
(\PFPutMarkerPage
(LAMBDA (vol frame) (* hts: "29-Nov-84 12:27")
(* * comment)
(OR (FIXP vol)
(SETQ vol (\PFVolumeNumber vol)))
(\PFPutPage (ELT \PFMarkerFileD vol)
(IPLUS (LvBasePageAddr vol)
(MarkerPageAddr vol))
(MarkerPageAddr vol)
frame)))
)
(DEFINEQ
(\PFGetFreePage
(LAMBDA (vol volumePageNumber frame runLength noBreak) (* edited: " 4-Jul-85 04:34")
(* * Read a free page (or bunch of them) presumably to check their labels.)
(\PFGetPage (ELT \PFFreeFileD (OR (FIXP vol)
(\PFVolumeNumber vol)))
volumePageNumber volumePageNumber frame runLength noBreak)))
(\PFCreateFreePage
(LAMBDA (vol volumePageNumber frame runLength noBreak) (* edited: " 3-Jul-85 22:10")
(* * Write a label on a page that says its free)
(\PFCreatePage (ELT \PFFreeFileD (OR (FIXP vol)
(\PFVolumeNumber vol)))
volumePageNumber volumePageNumber frame runLength noBreak)))
)
(DEFINEQ
(\PFGetAllocationMapPage
(LAMBDA (vol volumePageNumber frame) (* hts: "29-Nov-84 12:39")
(* * comment)
(\PFGetPage (ELT \PFAllocationMapFileD (OR (FIXP vol)
(\PFVolumeNumber vol)))
volumePageNumber volumePageNumber frame)))
(\PFPutAllocationMapPage
(LAMBDA (vol volumePageNumber frame) (* hts: "29-Nov-84 12:29")
(* * comment)
(OR (FIXP vol)
(SETQ vol (\PFVolumeNumber vol)))
(\PFPutPage (ELT \PFAllocationMapFileD vol)
volumePageNumber volumePageNumber frame)))
)
(DEFINEQ
(\PFGetFileMapPage
(LAMBDA (vol volumePageNumber frame) (* hts: "29-Nov-84 12:32")
(* * comment)
(OR (FIXP vol)
(SETQ vol (\PFVolumeNumber vol)))
(\PFGetPage (ELT \PFFileMapFileD vol)
volumePageNumber volumePageNumber frame)))
(\PFPutFileMapPage
(LAMBDA (vol volumePageNumber frame) (* hts: "29-Nov-84 12:32")
(* * comment)
(OR (FIXP vol)
(SETQ vol (\PFVolumeNumber vol)))
(\PFPutPage (ELT \PFFileMapFileD vol)
volumePageNumber volumePageNumber frame)))
)
(DEFINEQ
(\PFGetPage
(LAMBDA (file filePageNumber volumePageNumber frame runLength noBreak)
(* edited: " 4-Jul-85 03:45")
(* * file: FileDescriptor, filePageNumber: FIXP, volumePageNumber: FIXP, frame: Page)
(* * Reads a page from the disk into frame)
(\PFTransferFilePage file filePageNumber volumePageNumber frame (QUOTE VVR)
runLength noBreak)))
(\PFPutPage
(LAMBDA (file filePageNumber volumePageNumber frame) (* hts: "28-Nov-84 15:10")
(* * file: FileDescriptor, filePageNumber: FIXP, volumePageNumber: FIXP, frame: Page)
(* * Writes the page in frame onto the disk and checks the label of the disk page)
(\PFTransferFilePage file filePageNumber volumePageNumber frame (QUOTE VVW))))
(\PFCreatePage
(LAMBDA (file filePageNumber volumePageNumber frame runLength noBreak)
(* edited: " 3-Jul-85 22:04")
(* * file: FileDescriptor, filePageNumber: FIXP, volumePageNumber: FIXP, frame: Page)
(* * Writes the page in frame onto the disk and writes a new label for it)
(\PFTransferFilePage file filePageNumber volumePageNumber frame (QUOTE VWW)
runLength noBreak)))
)
(DEFINEQ
(\PFTransferFilePage
(LAMBDA (file filePageNumber volumePageNumber frame operation runLength noBreak)
(* edited: " 3-Jul-85 22:03")
(* * file: FileDescriptor, filePageNumber: FIXP, volumePageNumber: FIXP, frame: Page, operation:
(VVR VVW VWW))
(* * Transfers a page to or from the disk as necessary.)
(WITH-RESOURCE label
(* * Build label)
(if (FIXP (fetch (FileDescriptor fileID) of file))
then (replace (Label fileID) of label with (fetch (FileDescriptor fileID)
of file))
else
(* * Logical volume pages, marker pages, and physical volume pages have a 5-word volume ID for their fileID in a
label. This is essentially a loophole to get around the normal declaration of the Label datatype, which expects a
2-word ID)
(MESASETQ label (fetch (FileDescriptor fileID) of file)
VolumeID))
(replace (Label attributesInAllPages) of label with (fetch (FileDescriptor type)
of file))
(replace (Label filePage) of label with filePageNumber)
(* * Transfer page)
(\PFTransferPage (IPLUS (LvBasePageAddr (fetch (FileDescriptor volNum)
of file))
volumePageNumber)
frame operation label runLength noBreak))
NIL))
)
(DEFINEQ
(\PFTransferPage
(DLAMBDA ((absoluteDiskAddress FIXP)
(buffer (ONEOF Page RandomPage))
(mode (MEMQ VRR VVR VVW VWW VRW))
(label Label)
(runLength (ONEOF NIL SMALLP))
(noBreak BOOL)
(RETURNS LITATOM))
(* hts: "12-Aug-85 19:04")
(* * Transfers a page and label to or from the disk.)
(if (NULL runLength)
then (SETQ runLength 1))
(* * Make sure everything is swapped in to prevent page faulting in low-level disk routines.
In addition, buffer must be dirty for disk microcode to treat it right.)
(SwapIn&Dirty buffer)
(SwapIn&Dirty label)
(* * Do the transfer)
(LET (DOB STATUS)
(UNINTERRUPTABLY
(SETQ DOB (\DL.OBTAINNEWDOB))
(with DLION.DOB DOB (SETQ DISKADDRESS absoluteDiskAddress)
(SETQ BUFFER buffer)
(SETQ RUNLENGTH runLength)
(SETQ LABEL label)
(SETQ MODE mode))
(\MISCAPPLY* (FUNCTION \DLDISK.EXECUTE)
DOB)
(SETQ STATUS (fetch (DLION.DOB STATUS) of DOB))
(SETQ DOB (\DL.RELEASEDOB DOB)))
(if (AND (NOT noBreak)
(NEQ STATUS (QUOTE OK)))
then (DiskError "HARD DISK ERROR" STATUS))
STATUS)))
)
(DECLARE: DONTEVAL@LOAD
(\LOCKFN (QUOTE \PFTransferPage))
)
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE label)
(QUOTE RESOURCES)
(QUOTE (NEW (create Label)
GET
(if \label.GLOBALRESOURCE then (PROG1 \label.GLOBALRESOURCE (\CLEARWORDS
\label.GLOBALRESOURCE
(MESASIZE Label))
(SETQ \label.GLOBALRESOURCE NIL))
else
(NEWRESOURCE label)))))
)
(* * File Descriptor pool for system files)
(DEFINEQ
(\PFCreateFileDescriptors
(LAMBDA NIL (* hts: " 7-Jan-85 15:15")
(* * Sets up the file descriptors for system files. Should be run at load time (or at least the first time you wake
up on a dlion, and before running \PFInitFileDescriptors))
(if (NOT (AND (BOUNDP (QUOTE \PFLogicalVolumeFileD))
(BOUNDP (QUOTE \PFMarkerFileD))
(BOUNDP (QUOTE \PFFreeFileD))
(BOUNDP (QUOTE \PFAllocationMapFileD))
(BOUNDP (QUOTE \PFFileMapFileD))))
then (SETQ \PFInitialized NIL)
(* * Logical volume descriptors)
(SETQ \PFLogicalVolumeFileD (ARRAY maxLogicalVolumes NIL NIL 0))
(for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETA \PFLogicalVolumeFileD volNum
(create FileDescriptor
volNum ← volNum
type ← tLogicalVolumeRootPage
size ← 1)))
(* * Marker pages)
(SETQ \PFMarkerFileD (ARRAY maxLogicalVolumes NIL NIL 0))
(for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETA \PFMarkerFileD volNum
(create FileDescriptor
volNum ← volNum
type ← tSubVolumeMarkerPage
size ← 1)))
(* * Free pages)
(SETQ \PFFreeFileD (ARRAY maxLogicalVolumes NIL NIL 0))
(for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETA \PFFreeFileD volNum
(create FileDescriptor
fileID ← tFreePage
volNum ← volNum
type ← tFreePage)))
(* * Volume allocation map pages)
(SETQ \PFAllocationMapFileD (ARRAY maxLogicalVolumes NIL NIL 0))
(for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETA \PFAllocationMapFileD volNum
(create FileDescriptor
fileID ← tVolumeAllocationMap
volNum ← volNum
type ← tVolumeAllocationMap)))
(* * Volume file map pages)
(SETQ \PFFileMapFileD (ARRAY maxLogicalVolumes NIL NIL 0))
(for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETA \PFFileMapFileD volNum
(create FileDescriptor
fileID ← tVolumeFileMap
volNum ← volNum
type ← tVolumeFileMap))))))
(\PFInitFileDescriptors
(LAMBDA NIL (* hts: "30-Nov-84 13:44")
(* * Fills in the fileID for the system file descriptors whose fileID changes depending on what disk you're running
on. This routine should be run every time you wake up on a DLion, but run after you've read in the physical volume
page.)
(PROG ((lastVolNum (SUB1 (fetch (PhysicalVolumeDescriptor subVolumeCount) of \PhysVolumePage))))
(* * Logical volume descriptors)
(for volNum from 0 to lastVolNum do (replace (FileDescriptor fileID)
of (ELT \PFLogicalVolumeFileD volNum)
with (MESASETQ (create VolumeID)
(fetch (SubVolumeDesc lvID)
of (FMESAELT (fetch (
PhysicalVolumeDescriptor subVolumes) of \PhysVolumePage)
SubVolumeArray volNum)
)
VolumeID)))
(* * Marker pages)
(for volNum from 0 to lastVolNum do (replace (FileDescriptor fileID)
of (ELT \PFMarkerFileD volNum)
with (MESASETQ (create VolumeID)
(fetch (PhysicalVolumeDescriptor
subVolumeMarkerID)
of \PhysVolumePage)
VolumeID))))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \PFLogicalVolumeFileD \PFMarkerFileD \PFFreeFileD \PFAllocationMapFileD \PFFileMapFileD)
)
(\PFCreateFileDescriptors)
(* * Physical volume interface)
(DEFINEQ
(\PFCreatePhysicalVolume
(LAMBDA NIL (* hts: " 7-Jan-85 15:15")
(if (NOT (AND (BOUNDP (QUOTE \PhysVolumePage))
(type? PhysicalVolumeDescriptor \PhysVolumePage)))
then (SETQ \PFInitialized NIL)
(SETQ \PhysVolumePage (create PhysicalVolumeDescriptor)))
NIL))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \PhysVolumePage)
)
(\PFCreatePhysicalVolume)
(* * Interface to logical volumes,)
(DEFINEQ
(\PFCreateVols
(LAMBDA NIL (* hts: " 7-Jan-85 15:15")
(* * Creates an array of logical volume page frames. Also creates a hash table which maps logical volumes
descriptors onto volume numbers. Both these data structures share logical volume page frames, so only one
(the array) need be updated. The conditional ensures that loading a new version of the file system will not smash
the logical volume information, unless the data structures are incompatible.)
(if (NOT (AND (BOUNDP (QUOTE \DFSLogicalVolumes))
(type? ARRAYP \DFSLogicalVolumes)
(ZEROP (ARRAYORIG \DFSLogicalVolumes))
(EQ maxLogicalVolumes (ARRAYSIZE \DFSLogicalVolumes))
(BOUNDP (QUOTE \DFSLogicalVolumeHash))
(HASHARRAYP \DFSLogicalVolumeHash)))
then (SETQ \DFSLogicalVolumes (ARRAY maxLogicalVolumes NIL NIL 0))
(SETQ \DFSLogicalVolumeHash (HASHARRAY maxLogicalVolumes))
(bind vol for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETQ vol (create LogicalVolumeDescriptor))
(SETA \DFSLogicalVolumes volNum vol)
(PUTHASH vol volNum \DFSLogicalVolumeHash))
(SETQ \PFInitialized NIL))
NIL))
(\PFInitializeVols
(LAMBDA NIL (* hts: "29-Nov-84 12:19")
(for volNum from 0 to (SUB1 (fetch (PhysicalVolumeDescriptor subVolumeCount) of \PhysVolumePage))
do (\PFGetLogicalVolumePage volNum (\PFGetVol volNum)))))
(\PFGetVols
(LAMBDA NIL (* hts: "11-Oct-84 17:19")
(for volNum from 0 to (SUB1 (fetch (PhysicalVolumeDescriptor subVolumeCount) of \PhysVolumePage))
collect (\PFGetVol volNum))))
(\PFGetVol
(LAMBDA (volNum) (* hts: "11-Oct-84 15:12")
(ELT \DFSLogicalVolumes volNum)))
(\PFVolumeNumber
(LAMBDA (vol) (* hts: "26-Nov-84 11:52")
(* * vol: LogicalVolumeDescriptor; RETURNS: FIXP in 0..9)
(* Converts vol into a logical volume number, becuase the page reading and writing routines expect a logical volume
number rather than the logical volume itself.)
(GETHASH vol \DFSLogicalVolumeHash)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DFSLogicalVolumes \DFSLogicalVolumeHash)
)
(\PFCreateVols)
(DEFINEQ
(\PFGetLVPage
(LAMBDA (lvName) (* hts: " 9-Jan-85 16:28")
(* * Returns the logical volume page for the volume whose name is lvName. Returns NIL if there is no such volume.)
(SETQ lvName (MKATOM (U-CASE lvName)))
(for vol in (\PFGetVols) thereis (EQ lvName (MKATOM (U-CASE (fetch (LogicalVolumeDescriptor
LVlabel)
of vol)))))))
)
(* * Pilot integrity)
(DEFINEQ
(\PFVersionOK
(LAMBDA NIL (* hts: " 6-Jan-85 18:49")
(* * Checks to see that the disk you are attempting to run on is partitioned in a way the file system can
understand)
(for vol in (\PFGetVols) always (EQ pilotVersion (fetch (LogicalVolumeDescriptor version)
of vol)))))
(\PFPilotVolumeP
(DLAMBDA ((vol LogicalVolumeDescriptor)
(RETURNS BOOL))
(* mjs " 6-Mar-85 22:54")
(* * Tells whether the volume in question is a pilot or non-pilot volume.)
(* * any volume which is not of type non-Pilot is considered a Pilot volume <normal, debugger, debuggerdebugger,
etc.>)
(NEQ (fetch (LogicalVolumeDescriptor type) of vol)
nonPilotVolume)))
)
(* * Pilot initialization)
(DEFINEQ
(\PFEnsureInitialized
(DLAMBDA ((FORCEINITIALIZATION BOOL)
(RETURNS BOOL))
(* hts: "13-Aug-85 23:08")
(* * Caches enough of the state of the disk so that the file system can run. Doesn't access the disk unless
necessary.)
(SELECTQ (MACHINETYPE)
((DANDELION DOVE)
(if (OR FORCEINITIALIZATION (NOT \PFInitialized))
then
(* * initialize physical volume page cache)
(\PFGetPhysicalVolumePage \PhysVolumePage)
(* * Use physical volume page to set up disk-specific system file descriptors (for logical volume pages and marker
pages))
(\PFInitFileDescriptors)
(* * initialize logical volume page cache;)
(\PFInitializeVols)
(if (\PFVersionOK)
then
(* * Initialize volume file map and volume allocation map)
(\VAMInit)
(\VFMInit)
(* * Note that this routine has been run)
(SETQ \PFInitialized T)
(\PFDsplyVolumes)
T
else (SETQ \PFInitialized NIL))
else (SETQ \PFInitialized T)))
(SETQ \PFInitialized T))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \PFInitialized)
)
(RPAQ? \PFInitialized NIL)
(ADDTOVAR \SYSTEMCACHEVARS \PFInitialized)
(\PFEnsureInitialized)
(* * 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))))
)
(* * Pilot file management)
(DEFINEQ
(\PFNewPages
(LAMBDA (vol file group) (* hts: "12-Aug-85 18:09")
(* * Allocates the specified group of pages for file and records them in the volume file map.
Returns file if successful, NIL otherwise.)
(bind (startSize ←(fetch (FileDescriptor size) of file))
(currentGroup ←(create PageGroup)) until (EQP (fetch (FileDescriptor size) of file)
(fetch (PageGroup nextFilePage) of group))
do
(* * Build the group to attempt to allocate next)
(replace (PageGroup filePage) of currentGroup with (fetch (FileDescriptor size)
of file))
(replace (PageGroup volumePage) of currentGroup with 0)
(replace (PageGroup nextFilePage) of currentGroup with (fetch (PageGroup nextFilePage)
of group))
(* * Allocate as many pages of the desired group as possible)
(if (NOT (\VAMAllocPageGroup vol file currentGroup))
then (\PFTrimHelper vol file startSize)
(RETURN NIL))
(* * Stick the newly allocated group into the volume file map BTree)
(\VFMInsertPageGroup vol file currentGroup)
(* * Record the newly-increased size of the file)
(replace (FileDescriptor size) of file with (fetch (PageGroup nextFilePage) of currentGroup)
)
(BLOCK)
finally (\PFDsplyVolumes)
(RETURN file))))
(\PFTrimHelper
(LAMBDA (vol filePtr targetFileSize) (* hts: " 9-Jan-85 22:08")
(* * Shortens or deletes a file by taking entries out of the BTree and out of the allocation map Removes the pages
of the file between targetFileSize & actualFileSize)
(if (NOT (EQP targetFileSize (fetch (FileDescriptor size) of filePtr)))
then (bind (group ←(create PageGroup
filePage ← targetFileSize
volumePage ← nullVolumePage
nextFilePage ←(fetch (FileDescriptor size) of filePtr)))
until (PROGN (\VFMDeletePageGroup vol filePtr group)
(\VAMFreePageGroup vol filePtr group)
(replace (FileDescriptor size) of filePtr with (fetch (PageGroup
filePage)
of group))
(if (EQ (fetch (PageGroup filePage) of group)
0)
then (replace (PageGroup nextFilePage) of group with 0)
(\VFMDeletePageGroup vol filePtr group)
(\VAMFreePageGroup vol filePtr group)
T
else (EQP (fetch (PageGroup filePage) of group)
targetFileSize)))
do (replace (PageGroup nextFilePage) of group with (fetch (PageGroup filePage)
of group))
(replace (PageGroup filePage) of group with targetFileSize)
(BLOCK))
(\PFDsplyVolumes))))
(\PFFindPageAddr
(LAMBDA (file filePage) (* edited: "20-Jan-85 16:02")
(* * vol: LogicalVolumeDescriptor, file: FileDescriptor, filePage: FIXP; returns FIXP)
(* * Tells where page filePage of file is located on the disk)
(* * Caches the last pageGroup for the file)
(PROG ((PAGEGROUP (fetch (FileDescriptor PAGEGROUP) of file)))
(if (OR (NOT (FIXP PAGEGROUP))
(LESSP filePage (fetch (PageGroup filePage) of PAGEGROUP))
(GEQ filePage (fetch (PageGroup nextFilePage) of PAGEGROUP)))
then
(* * Page group we are after is not in cache; we will have to look it up in the volume file map)
(* GetPageGroup returns a dotted pair whose CAR is NIL iff the fileID was not found, and whose CDR contains a
PageGroup indicating the desired pages. Gives a zero volume page iff the fileID is found, but the page specified
isn't.)
(SETQ PAGEGROUP (\VFMGetPageGroup (\PFGetVol (fetch (FileDescriptor volNum)
of file))
file filePage))
(OR (AND PAGEGROUP (NOT (ZEROP (fetch (PageGroup volumePage) of PAGEGROUP))))
(DiskError "HARD DISK ERROR" "Can't find file page"))
(replace (FileDescriptor PAGEGROUP) of file with PAGEGROUP))
(RETURN (IPLUS (fetch (PageGroup volumePage) of PAGEGROUP)
filePage
(IMINUS (fetch (PageGroup filePage) of PAGEGROUP)))))))
(\PFFindFileSize
(DLAMBDA ((file FileDescriptor)
(RETURNS FIXP))
(* hts: " 9-Jan-85 20:33")
(* * Finds the number of pages in the specified file, as recorded in the volume file map.)
(fetch (PageGroup filePage) of (\VFMGetPageGroup (\PFGetVol (fetch (FileDescriptor volNum)
of file))
file MAX.FIXP))))
(\PFFreeDiskPages
(DLAMBDA ((vol LogicalVolumeDescriptor)
(recompute BOOL)
(RETURNS FIXP))
(* hts: " 8-Jan-85 14:54")
(* * Returns the free page count for the specified volume.)
(if recompute
then (\VAMRecomputeFreePageCount vol)
(\PFDsplyVolumes))
(fetch (LogicalVolumeDescriptor freePageCount) of vol)))
(\PFRoomForFile
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS BOOL))
(* hts: " 1-Aug-85 16:50")
(* * Returns T iff there is room for the specified file on the specified volume. Formula is the same as Pilot uses;
it is a little more conservative than necessary. The -5 is the maximum number of file map pages that could split;
I don't know what the 15/16th's is about.)
(LEQ (DIFFERENCE (fetch (PageGroup nextFilePage) of groupPtr)
(fetch (PageGroup filePage) of groupPtr))
(if (EQ tVolFileMap (fetch (FileDescriptor type) of filePtr))
then (\PFFreeDiskPages vol)
else (DIFFERENCE (QUOTIENT (TIMES (\PFFreeDiskPages vol)
15)
16)
5)))))
(\PFSaveBuffers
(DLAMBDA ((VOL LogicalVolumeDescriptor)
(RETURNS NIL))
(* hts: "16-Feb-85 18:04")
(* * Saves out dirty buffers.)
(\PFPutLogicalVolumePage VOL VOL)
(\VAMBufferSave)
(\VFMSaveBuffer)))
)
(* * Lisp vmem)
(DEFINEQ
(\PFCurrentVol
(LAMBDA NIL (* hts: "11-Oct-84 17:18")
(* * Returns the logical volume page of the volume which contains the currently running virtual memory)
(for vol in (\PFGetVols) thereis (EQP (fetch (DiskFileID da) of (FMESAELT (fetch (
PhysicalVolumeDescriptor bootingInfo) of \PhysVolumePage)
PVBootFiles
hardMicrocode))
(fetch (DiskFileID da) of (FMESAELT (fetch (
LogicalVolumeDescriptor bootingInfo) of vol)
LVBootFiles
hardMicrocode))))))
)
(* * Display stub; real volume display stuff is implemented on a library package called
VOLUMEDISPLAY.)
(DEFINEQ
(\PFDsplyVolumes
(LAMBDA NIL (* edited: " 4-Jul-85 03:14")
(* * Updates the volume display window as necessary.)
(if (DEFINEDP (QUOTE \DSKDISPLAY.UPDATE))
then (\DSKDISPLAY.UPDATE))))
)
(RPAQQ LFALLOCATIONMAPCOMS ((* * Implements the 1108 file system volume file map. Very roughly
translates the Pilot file VolAllocMapImpl.mesa. Used to be contained
in the separate file LFALLOCATIONMAP. Must be loaded after the
PILOTFILE module.)
(* * Needed improvement : Restructure interface with FILEIO so that a
page can be allocated and written in one fell swoop. MFile/Pilot have
a special interface for this.)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (BITSPERPAGE 4096)))
(* * Public routines)
(FNS \VAMAllocPageGroup \VAMFreePageGroup \VAMInit
\VAMRecomputeFreePageCount)
(* * Private routines:)
(FNS \VAMFilePageNumber \VAMEnoughSpace \VAMFindFreePages
\VAMCheckEndOfVol \VAMUpdateVAM \VAMAdjustGroup)
(RESOURCES \DFSVAMpage \DFSVAMjunkPage)
(GLOBALVARS \VAMmonitor)
(INITVARS (\VAMmonitor (CREATE.MONITORLOCK (QUOTE VAMmonitor))))
(* * buffer management)
(FNS \VAMGetVAMPageFor \VAMBufferInit \VAMBufferSave \VAMMarkBufferDirty)
(GLOBALVARS \VAMbuffer \VAMbufferVolume \VAMbufferVolumePage
\VAMbufferDirty)
(* * Initialize VAM)
(P (\VAMInit))))
(* * Implements the 1108 file system volume file map. Very roughly translates the Pilot file
VolAllocMapImpl.mesa. Used to be contained in the separate file LFALLOCATIONMAP. Must be loaded
after the PILOTFILE module.)
(* * Needed improvement : Restructure interface with FILEIO so that a page can be allocated and
written in one fell swoop. MFile/Pilot have a special interface for this.)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ BITSPERPAGE 4096)
(CONSTANTS (BITSPERPAGE 4096))
)
)
(* * Public routines)
(DEFINEQ
(\VAMAllocPageGroup
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS BOOL))
(* hts: "12-Aug-85 18:19")
(* * Allocates as many of the pages in groupPtr as it can in a contiguous run. Modifies groupPtr so the caller can
know what pages and how many were allocated)
(WITH.MONITOR \VAMmonitor (UNINTERRUPTABLY
(LET ((RUNLENGTH (DIFFERENCE (fetch (PageGroup nextFilePage)
of groupPtr)
(fetch (PageGroup filePage)
of groupPtr))))
(if (\VAMEnoughSpace vol filePtr RUNLENGTH)
then
(* * Look in the free page bitmap to find a contiguous bunch of free pages and mark them taken in the bitmap.)
(\VAMFindFreePages vol filePtr groupPtr)
(SETQ RUNLENGTH (DIFFERENCE (fetch (PageGroup
nextFilePage)
of groupPtr)
(fetch (PageGroup
filePage)
of groupPtr)))
(* * Update free page count and lower bound on the logical volume page)
(add (fetch (LogicalVolumeDescriptor freePageCount)
of vol)
(MINUS RUNLENGTH))
(replace (LogicalVolumeDescriptor lowerBound)
of vol with (PLUS (fetch (PageGroup volumePage)
of groupPtr)
RUNLENGTH))
(* * Check all these pages to make sure they are indeed free.)
(WITH-RESOURCE \DFSVAMjunkPage
(\PFGetFreePage vol
(fetch (PageGroup
volumePage)
of groupPtr)
\DFSVAMjunkPage
RUNLENGTH))
(* * Finally, clear each page and give it a free page label.)
(WITH-RESOURCE \DFSVAMpage
(\PFCreatePage
filePtr
(\VAMFilePageNumber
(fetch (FileDescriptor type)
of filePtr)
(fetch (PageGroup volumePage)
of groupPtr)
(fetch (PageGroup filePage)
of groupPtr))
(fetch (PageGroup volumePage)
of groupPtr)
\DFSVAMpage RUNLENGTH))
(* * Return T indicating success.)
T
else
(* * Not enough space on the volume: return NIL to indicate failure.)
(replace (PageGroup nextFilePage) of groupPtr
with (fetch (PageGroup filePage) of groupPtr))
(replace (PageGroup volumePage) of groupPtr
with 0)
NIL))))))
(\VAMFreePageGroup
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS NIL))
(* hts: " 5-Aug-85 17:50")
(* * Frees each page in groupPtr)
(WITH.MONITOR \VAMmonitor (UNINTERRUPTABLY
(PROG ((group (\VAMAdjustGroup groupPtr)))
(* Adjust to coincide with Pilot's silly "[0, 0)"
convention)
(* * If no pages to free, just return (runlength <= 0 might upset later code))
(if (IGEQ (fetch (PageGroup filePage) of group)
(fetch (PageGroup nextFilePage) of group))
then (RETURN))
(LET ((RUNLENGTH (DIFFERENCE (fetch (PageGroup nextFilePage)
of group)
(fetch (PageGroup filePage)
of group))))
(* * First check the page labels to make sure all the pages really do belong to the file we are shortening.)
(WITH-RESOURCE \DFSVAMjunkPage
(\PFGetPage filePtr
(\VAMFilePageNumber
(fetch (FileDescriptor
type)
of filePtr)
(fetch (PageGroup
volumePage)
of group)
(fetch (PageGroup filePage)
of group))
(fetch (PageGroup volumePage)
of group)
\DFSVAMjunkPage RUNLENGTH))
(* * Then clear each page on the disk and give it a new label saying it is a free page.)
(WITH-RESOURCE \DFSVAMpage (\PFCreateFreePage
vol
(fetch (PageGroup volumePage)
of group)
\DFSVAMpage RUNLENGTH))
(* * Finally mark the pages as free in the free page bitmap.)
(to RUNLENGTH as volumePageNumber
from (fetch (PageGroup volumePage) of group)
do (\VAMUpdateVAM vol filePtr volumePageNumber
(QUOTE free)))
(* * Update free page count and lower bound on the logical volume page)
(add (fetch (LogicalVolumeDescriptor freePageCount)
of vol)
RUNLENGTH))
(replace (LogicalVolumeDescriptor lowerBound) of vol
with (MIN (fetch (PageGroup volumePage) of group)
(fetch (LogicalVolumeDescriptor lowerBound)
of vol))))))))
(\VAMInit
(LAMBDA NIL (* hts: " 5-Jan-85 16:18")
(* * Initializes or reinitializes the volume allocation map)
(WITH.MONITOR \VAMmonitor (\VAMBufferInit))))
(\VAMRecomputeFreePageCount
(DLAMBDA ((vol LogicalVolumeDescriptor)
(RETURNS FIXP))
(* hts: " 9-Jan-85 17:37")
(* * Recomputes the free page count for each volume from scratch; also resets the lower bound pointer)
(WITH.MONITOR \VAMmonitor (replace (LogicalVolumeDescriptor freePageCount) of vol
with (bind (firstFree ← T) for page from 1
to (fetch (LogicalVolumeDescriptor volumeSize) of vol)
count (PROG ((free (ZEROP (\VAMUpdateVAM vol NIL page
(QUOTE read)))))
(if (AND free firstFree)
then (replace (LogicalVolumeDescriptor
lowerBound)
of vol with page)
(SETQ firstFree NIL))
(RETURN free))))
(\PFPutLogicalVolumePage vol vol)
(fetch (LogicalVolumeDescriptor freePageCount) of vol))))
)
(* * Private routines:)
(DEFINEQ
(\VAMFilePageNumber
(DLAMBDA ((fileType SMALLP)
(volumePageNumber FIXP)
(filePageNumber FIXP)
(RETURNS FIXP))
(* hts: "16-Feb-85 16:21")
(* * Returns the real file page number)
(SELECTC fileType
(tLispFile filePageNumber)
(tLispDirectory filePageNumber)
(tVolumeFileMap volumePageNumber)
(tRootDirectory 0)
(tDiagnosticMicrocode filePageNumber)
(SHOULDNT))))
(\VAMEnoughSpace
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(RUNLENGTH FIXP)
(RETURNS BOOL))
(* hts: " 6-Aug-85 12:38")
(* * Tells whether there's enough space left on the specified volume to allocate RUNLENGTH pages.
There should always be room for new volume file map pages. For other kinds of files, the "15/16th's - 5" is the
criterion the Pilot people chose. It is a little over-conservative. The -5 is the maximum number of btree splits you
can have in the file map; I don't know what the "15/16th's" is for.)
(OR (EQ tVolumeFileMap (fetch (FileDescriptor type) of filePtr))
(LEQ RUNLENGTH (DIFFERENCE (IQUOTIENT (TIMES (fetch (LogicalVolumeDescriptor freePageCount)
of vol)
15)
16)
5)))))
(\VAMFindFreePages
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS NIL))
(* hts: " 5-Aug-85 18:30")
(* * Scans page allocation bitmap till it finds a chunk of contiguous free pages to partially satisfy the request.
Modifies groupPtr accordingly.)
(UNINTERRUPTABLY
(PROG ((volPage# (fetch (LogicalVolumeDescriptor lowerBound) of vol))
(filePage# (fetch (PageGroup filePage) of groupPtr)))
(* * Find first free page and allocate it. lowerBound is supposed to be the first free page on the volume)
(until (PROGN (if (IGEQ volPage# (SUB1 (fetch (LogicalVolumeDescriptor volumeSize)
of vol)))
then (DiskError "HARD DISK ERROR" "FREE PAGE COUNT WRONG"))
(EQ 0 (\VAMUpdateVAM vol filePtr volPage# (QUOTE alloc))))
do (add volPage# 1))
(* * Note in groupPtr the beginning page of the run we will allocate to this file)
(replace (PageGroup volumePage) of groupPtr with volPage#)
(* * Keep allocating until either you've allocated enough or you run out of consecutive free pages)
(repeatuntil (PROGN (add volPage# 1)
(add filePage# 1)
(if (IGEQ volPage# (SUB1 (fetch (LogicalVolumeDescriptor volumeSize)
of vol)))
then (DiskError "HARD DISK ERROR" "FREE PAGE COUNT WRONG"))
(OR (EQP filePage# (fetch (PageGroup nextFilePage) of groupPtr))
(NEQ 0 (\VAMUpdateVAM vol filePtr volPage# (QUOTE alloc))))))
(* * Note in the PageGroup what the last page allocated actually was, so the caller will know)
(replace (PageGroup nextFilePage) of groupPtr with filePage#)))))
(\VAMCheckEndOfVol
(DLAMBDA ((vol LogicalVolumeDescriptor)
(volPage# FIXP)
(RETURNS NIL))
(* hts: " 5-Aug-85 18:30")
(* * Checks to make sure you are not about to allocate off the end of the volume.)
(if (IGEQ volPage# (SUB1 (fetch (LogicalVolumeDescriptor volumeSize) of vol)))
then (DiskError "HARD DISK ERROR" "FREE PAGE COUNT WRONG"))
NIL))
(\VAMUpdateVAM
(LAMBDA (vol filePtr page allocOrFree) (* hts: "16-Jan-85 21:08")
(* * vol: LogicalVolumeDescriptor, filePtr: FileDescriptor, page: FIXP, allocOrFree: {alloc, free})
(* * RETURNS previous value of allocation map for specified page)
(* * Sets (if allocOrFree = alloc) or clears (if allocOrFree = free) the map bit for the specified page)
(PROG ((VAMPage# (IQUOTIENT page BITSPERPAGE))
(VAMWord# (IQUOTIENT (IREMAINDER page BITSPERPAGE)
BITSPERWORD))
(VAMBit# (IREMAINDER page BITSPERWORD))
VAMPage VAMWord VAMBit result)
(SETQ VAMPage (\VAMGetVAMPageFor vol VAMPage#))
(SETQ VAMWord (\GETBASE VAMPage VAMWord#))
(SETQ VAMBit (MASK.1'S (DIFFERENCE 15 VAMBit#)
1))
(SETQ result (if (BITTEST VAMWord VAMBit)
then 1
else 0))
(SELECTQ allocOrFree
(alloc (SETQ VAMWord (BITSET VAMWord VAMBit))
(\VAMMarkBufferDirty))
(free (SETQ VAMWord (BITCLEAR VAMWord VAMBit))
(\VAMMarkBufferDirty))
(read)
(SHOULDNT))
(\PUTBASE VAMPage VAMWord# VAMWord)
(RETURN result))))
(\VAMAdjustGroup
(LAMBDA (groupPtr) (* hts: " 9-Aug-85 11:36")
(* * Adjust groupPtr to not delete the last page of the file unless it is a separate request for that specific
purpose. This was a silly Pilot convention (now obsolete).)
(PROG ((group (create PageGroup using groupPtr)))
(if (EQ (fetch (PageGroup filePage) of group)
0)
then (if (EQ (fetch (PageGroup nextFilePage) of group)
0)
then (replace (PageGroup nextFilePage) of group with 1)
else (replace (PageGroup filePage) of group with 1)
(replace (PageGroup volumePage) of group with (ADD1 (fetch (PageGroup
volumePage)
of group)))))
(RETURN group))))
)
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE \DFSVAMpage)
(QUOTE RESOURCES)
(QUOTE (NEW (create Page))))
(PUTDEF (QUOTE \DFSVAMjunkPage)
(QUOTE RESOURCES)
(QUOTE (NEW (create Page))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VAMmonitor)
)
(RPAQ? \VAMmonitor (CREATE.MONITORLOCK (QUOTE VAMmonitor)))
(* * buffer management)
(DEFINEQ
(\VAMGetVAMPageFor
(DLAMBDA ((vol LogicalVolumeDescriptor)
(VAMPage# SMALLP)
(RETURNS Page))
(* hts: "16-Jan-85 21:06")
(PROG ((volumePage (IPLUS (fetch (LogicalVolumeDescriptor vamStart) of vol)
VAMPage#)))
(if (AND (FIXP \VAMbufferVolumePage)
(EQ \VAMbufferVolume vol)
(EQP \VAMbufferVolumePage volumePage))
then
(* * If the desired VAM page is already read in, just return it)
(RETURN \VAMbuffer)
else
(* * Otherwise write out the old VAM page if there is one)
(\VAMBufferSave)
(UNINTERRUPTABLY
(* * Record what the new page is)
(SETQ \VAMbufferVolume vol)
(SETQ \VAMbufferVolumePage volumePage)
(* * and read it in)
(\PFGetAllocationMapPage \VAMbufferVolume \VAMbufferVolumePage \VAMbuffer))
(RETURN \VAMbuffer)))))
(\VAMBufferInit
(LAMBDA NIL (* hts: "16-Jan-85 21:04")
(* * if bufferVolumePage is NIL, GetVAMPageFor will not try to flush an old version of it)
(SETQ \VAMbuffer (create Page))
(SETQ \VAMbufferVolume)
(SETQ \VAMbufferVolumePage)
(SETQ \VAMbufferDirty NIL)))
(\VAMBufferSave
(LAMBDA NIL (* hts: "16-Jan-85 21:03")
(* * Flush last VAM page used)
(if (AND (FIXP \VAMbufferVolumePage)
(the BOOL \VAMbufferDirty))
then (\PFPutAllocationMapPage \VAMbufferVolume \VAMbufferVolumePage \VAMbuffer)
(SETQ \VAMbufferDirty NIL))))
(\VAMMarkBufferDirty
(LAMBDA NIL (* hts: "16-Jan-85 21:02")
(* * Indicate that the buffer VAM page is dirty and will have to be written out.)
(SETQ \VAMbufferDirty T)
NIL))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VAMbuffer \VAMbufferVolume \VAMbufferVolumePage \VAMbufferDirty)
)
(* * Initialize VAM)
(\VAMInit)
(RPAQQ LFFILEMAPCOMS ((* * Implements the volume file map, which maps Pilot file ID numbers onto runs
of disk pages. Roughly equivalent to the Pilot file VolFileMapImpl.mesa.
Must be loaded after the PILOTFILE module. Used to be contained in a
separate file called LFFILEMAP.)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS Key Interval Index BufferArray Buffer)
(RECORDS \BTREEBUF)
(CONSTANTS (maxReadPtr (DIFFERENCE (MESASIZE Buffer)
(MESASIZE Index)))
(treeDepth 5))
(FNS ShowIntervals))
(INITRECORDS \BTREEBUF)
(* * Initialization routines)
(FNS \VFMInit)
(* * The following are public entry points to the volume file map module)
(FNS \VFMDeletePageGroup \VFMGetPageGroup \VFMInsertPageGroup)
(* * The following are routines internal to the volume file map module.)
(FNS \VFMContextSet \VFMCreateVPage \VFMDelete \VFMDelete1 \VFMDelete2 \VFMFind \VFMFreeVPage
\VFMGet \VFMGet1 \VFMInsert \VFMInsert1 \VFMLower \VFMMerge \VFMMerge1 \VFMPutNext
\VFMReadNext \VFMSplit \VFMSplit1)
(GLOBALVARS \VFMmaxID \VFMmaxKey \VFMnullKey \VFMvolumeHandle \VFMinterval \VFMold \VFMlow
\VFMhigh \VFMoldPtr \VFMlowPtr \VFMhighPtr \VFMmonitor)
(* * Buffer management)
(FNS \VFMGetBufferFor \VFMSaveBuffer \VFMClearBuffers \VFMKillBuffer \VFMCorrectBufferP
\VFMMarkBufferDirty)
(GLOBALVARS \VFMbufferPool \VFMbufferSize \VFMbuffer \VFMxtraBuffer)
(INITVARS (\VFMbufferSize 10))
(* * Interval cache interface)
(FNS \VFMCreateIntervals \VFMClearIntervals \VFMGetInterval \VFMBlankInterval)
(GLOBALVARS \VFMintervals)
(* * BLT routine that doesn't stomp on itself for overlapping intervals)
(FNS \VFMSmartBLT)
(* * Loading initialization)
(FNS \VFMAtLoad)
(P (\VFMAtLoad))))
(* * Implements the volume file map, which maps Pilot file ID numbers onto runs of disk pages.
Roughly equivalent to the Pilot file VolFileMapImpl.mesa. Must be loaded after the PILOTFILE
module. Used to be contained in a separate file called LFFILEMAP.)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(MESARECORD Key ((fileID SWAPPEDFIXP)
(filePage SWAPPEDFIXP)
(type WORD)))
(MESARECORD Interval ((key Key)
(volumePage SWAPPEDFIXP)
(nextKey Key)))
(MESARECORD Index ((key Key)
(volumePage SWAPPEDFIXP)))
(MESAARRAY BufferArray ((0 (SUB1 (IQUOTIENT WORDSPERPAGE (MESASIZE Index)))))
Index)
(MESARECORD Buffer ((data BufferArray)
(used WORD)) (* This is the structure for a BTree page)
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
]
[DECLARE: EVAL@COMPILE
(DATATYPE \BTREEBUF ((VOLUME POINTER)
(VOLPAGENUM FIXP)
(PAGE POINTER)
(DIRTY FLAG)))
]
(/DECLAREDATATYPE (QUOTE \BTREEBUF)
(QUOTE (POINTER FIXP POINTER FLAG))
(QUOTE ((\BTREEBUF 0 POINTER)
(\BTREEBUF 2 FIXP)
(\BTREEBUF 4 POINTER)
(\BTREEBUF 4 (FLAGBITS . 0))))
(QUOTE 6))
(DECLARE: EVAL@COMPILE
(RPAQ maxReadPtr (DIFFERENCE (MESASIZE Buffer)
(MESASIZE Index)))
(RPAQQ treeDepth 5)
(CONSTANTS (maxReadPtr (DIFFERENCE (MESASIZE Buffer)
(MESASIZE Index)))
(treeDepth 5))
)
(DEFINEQ
(ShowIntervals
(LAMBDA (vol) (* hts: " 5-Jan-85 16:30")
(bind (intervalCache ←(PROGN (\VFMContextSet vol)
(\VFMGetInterval)))
interval for level from 0 to 5
do (printout T level ":" T "key: ")
(SETQ interval (ELT intervalCache level))
(DISPLAYWORDS (fetch (Interval key) of interval)
(MESASIZE Key))
(printout T "volumePage: " (fetch (Interval volumePage) of interval)
T)
(printout T "nextKey: ")
(DISPLAYWORDS (fetch (Interval nextKey) of interval)
(MESASIZE Key)))))
)
)
(/DECLAREDATATYPE (QUOTE \BTREEBUF)
(QUOTE (POINTER FIXP POINTER FLAG))
(QUOTE ((\BTREEBUF 0 POINTER)
(\BTREEBUF 2 FIXP)
(\BTREEBUF 4 POINTER)
(\BTREEBUF 4 (FLAGBITS . 0))))
(QUOTE 6))
(* * Initialization routines)
(DEFINEQ
(\VFMInit
(LAMBDA NIL (* hts: " 5-Jan-85 16:29")
(* * Minimally reinitialize the volume file map state variables)
(WITH.MONITOR \VFMmonitor (UNINTERRUPTABLY
(* * Clear out the BTree interval cache)
(\VFMClearIntervals)
(* * Clear the btree node cache)
(\VFMClearBuffers)))))
)
(* * The following are public entry points to the volume file map module)
(DEFINEQ
(\VFMDeletePageGroup
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS NIL))
(* hts: "16-Feb-85 18:28")
(* Deletes all or part of a single page group from the volume file map. The page group requested to be deleted need
not correspond to a single run of pages on the disk. It can be part of a single run of pages or stretch over several
runs of pages. In particular it is possible to delete a page or pages out of the middle of a run of pages
(the scavenger uses this capability). The actual page group deleted is returned in the group pointed to by GroupPtr.
Thus GroupPtr points to a modifiable hint. Care must be taken by the caller to insure that the page group to be
deleted exists. If it doesn't, Bug (pageGroupNotFound) is raised. This procedure implements the following funny
features:)
(* 1.0 If the page group to be deleted includes parts of more than one run of pages on the disk, only the last run
(or that part of the last run requested to be deleted) will be deleted.)
(* 2.0 If the page group to be deleted is the last page group left for the file and includes page zero of the file
and at least one following page, page zero will not be deleted. This is a special case that facilitates shrinking a
file to a zero-length file. VolAllocMapImpl has special case code in FreePageGroup for this also.
You can delete this last page of the file by specifying page group "[0..0)".)
(* 3.0 A hole at the beginning of a file is represented as follows: if file F is missing pages
(0..n) and the preceding file in the lexicographic ordering is file E of size m, then the interval in the file map
representing the hole looks like this: (key: (E, m), volumePage: nullVolumePage, nextKey: (F, n)).)
(* 4.0 A hole in the middle of the file (e.g. missing pages (m..n)) looks like this: (key: (F, m), volumePage:
nullVolumePage, nextKey: (F, n)).)
(* 5.0 This procedure does not care whether the page group being deleted corresponds to a hole in a file or to a
real run of pages on the volume, with the exception of a hole at the beginning of a file. If the page group to be
deleted is fully contained in a hole at the beginning of the file, Bug (pageGroupNotFound) is raised.)
(WITH.MONITOR \VFMmonitor
(UNINTERRUPTABLY
(PROG ((key (create Key
fileID ←(fetch (FileDescriptor fileID) of filePtr)
filePage ←(IDIFFERENCE (fetch (PageGroup nextFilePage)
of groupPtr)
(if (EQ (fetch (PageGroup
nextFilePage)
of groupPtr)
0)
then 0
else 1))
type ←(fetch (FileDescriptor type) of filePtr)))
(interval (create Interval))
(fileSize (fetch (FileDescriptor size) of filePtr)))
(ASSERT (LEQ (fetch (PageGroup nextFilePage) of groupPtr)
fileSize))
(\VFMContextSet vol)
(MESASETQ interval (\VFMGet key 0)
Interval) (* get interval containing last page of group)
(if (OR (NOT (EQP (fetch (Key fileID) of (fetch (Interval key)
of interval))
(fetch (FileDescriptor fileID) of filePtr)))
(AND (NOT (EQP (fetch (Key fileID) of (fetch (Interval nextKey)
of interval))
(fetch (FileDescriptor fileID) of filePtr)))
(EQP (fetch (Interval volumePage) of interval)
nullVolumePage)))
then (DiskError "HARD DISK ERROR" "Page group not found"))
(* for a zero-length file, interval.nextKey.fileID #
filePtr.fileID BUT interval.volumePage #
nullVolumePage)
(replace (PageGroup filePage) of groupPtr
with (replace (Key filePage) of key
with (MAX (fetch (Key filePage) of (fetch (Interval key)
of interval))
(fetch (PageGroup filePage) of groupPtr))))
(replace (PageGroup volumePage) of groupPtr
with (if (EQP (fetch (Interval volumePage) of interval)
nullVolumePage)
then nullVolumePage
else (IPLUS (fetch (Interval volumePage) of interval)
(IDIFFERENCE (fetch (PageGroup filePage)
of groupPtr)
(fetch (Key filePage)
of (fetch (Interval key)
of interval))))))
(replace (PageGroup nextFilePage) of groupPtr
with (MIN (fetch (Key filePage) of (fetch (Interval nextKey)
of interval))
(fetch (PageGroup nextFilePage) of groupPtr)))
(* deal with the starting page of the page group first)
(if (AND (MESAEQUAL key (fetch (Interval key) of interval)
Key)
(OR (NOT (EQP (fetch (PageGroup nextFilePage) of groupPtr)
fileSize))
(NOT (ZEROP (fetch (Key filePage) of key)))))
then (\VFMDelete key 0))
(if (NOT (ZEROP (fetch (Key filePage) of key)))
then (PROG ((previousKey (create Key
fileID ←(fetch (FileDescriptor
fileID)
of filePtr)
filePage ←(SUB1 (fetch (Key filePage)
of key)))))
(if (EQP (fetch (Key fileID)
of (fetch (Interval key)
of (\VFMGet previousKey 0)))
(fetch (FileDescriptor fileID) of filePtr))
then (* key.filePage is not the first
(existing) page of the file)
(\VFMInsert key nullVolumePage 0))))
(* now deal with the ending page of the page group)
(replace (Key filePage) of key with (fetch (PageGroup nextFilePage)
of groupPtr))
(if (EQP (fetch (Key filePage) of key)
fileSize)
then (\VFMDelete key 0))
(if (AND (NOT (EQP (fetch (Key filePage) of key)
(fetch (Key filePage) of (fetch (Interval nextKey)
of interval))))
(EQP (fetch (Key fileID) of key)
(fetch (Key fileID) of (fetch (Interval nextKey)
of interval))))
then (\VFMInsert key (if (EQP (fetch (PageGroup volumePage)
of groupPtr)
nullVolumePage)
then nullVolumePage
else (IPLUS (fetch (PageGroup volumePage)
of groupPtr)
(IDIFFERENCE (fetch (PageGroup
nextFilePage)
of groupPtr)
(fetch (PageGroup
filePage)
of groupPtr))))
0)))))))
(\VFMGetPageGroup
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(filePage FIXP)
(RETURNS (ONEOF NIL PageGroup)))
(* hts: "26-Jan-85 15:15")
(* Public)
(* * finds page group containing key (filePage = nextFilePage = size when off end of file))
(WITH.MONITOR \VFMmonitor
(UNINTERRUPTABLY
(PROG ((key (create Key
fileID ←(fetch (FileDescriptor fileID) of filePtr)
filePage ← filePage
type ←(fetch (FileDescriptor type) of filePtr)))
(interval (create Interval)))
(\VFMContextSet vol)
(MESASETQ interval (\VFMGet key 0)
Interval)
(RETURN (AND (EQP (fetch (Key fileID) of (fetch (Interval key)
of interval))
(fetch (FileDescriptor fileID) of filePtr))
(create PageGroup
filePage ←(fetch (Key filePage)
of (fetch (Interval key) of interval))
volumePage ←(fetch (Interval volumePage)
of interval)
nextFilePage ←(fetch (Key filePage)
of
(if
(EQP (fetch (Key fileID)
of (fetch (Interval
nextKey)
of interval))
(fetch (FileDescriptor
fileID)
of filePtr))
then (fetch (Interval nextKey)
of interval)
else (fetch (Interval key)
of interval))))))
(* covers page zero and size requests)
)))))
(\VFMInsertPageGroup
(DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS NIL))
(* hts: "16-Feb-85 18:28")
(* public)
(* * inserts a pageGroup into B-tree (unordered inserts are merged for rebuild))
(WITH.MONITOR \VFMmonitor
(UNINTERRUPTABLY
(PROG ((key (create Key
fileID ←(fetch (FileDescriptor fileID) of filePtr)
filePage ←(fetch (PageGroup filePage) of groupPtr)
type ←(fetch (FileDescriptor type) of filePtr)))
(interval (create Interval)))
(\VFMContextSet vol)
(MESASETQ interval (\VFMGet key 0)
Interval)
(if (MESAEQUAL (fetch (Interval key) of interval)
key Key)
then (\VFMDelete key 0)
(MESASETQ interval (\VFMGet key 0)
Interval))
(if (OR (NOT (EQP (IDIFFERENCE (fetch (Key filePage) of key)
(fetch (Key filePage)
of (fetch (Interval key) of interval)))
(IDIFFERENCE (fetch (PageGroup volumePage)
of groupPtr)
(fetch (Interval volumePage) of interval)))
)
(NOT (EQP (fetch (Key fileID) of key)
(fetch (Key fileID) of (fetch (Interval key)
of interval)))))
then (* don't merge with previous)
(\VFMInsert key (fetch (PageGroup volumePage) of groupPtr)
0)
(MESASETQ interval (\VFMGet key 0)
Interval))
(replace (Key filePage) of key with (fetch (PageGroup nextFilePage)
of groupPtr))
(if (AND (NOT (MESAEQUAL (fetch (Interval nextKey) of interval)
key Key))
(NOT (EQP (fetch (PageGroup filePage) of groupPtr)
(fetch (PageGroup nextFilePage) of groupPtr))))
then (\VFMInsert key nullVolumePage 0))
(if (AND (MESAEQUAL (fetch (Interval nextKey) of interval)
key Key)
(EQP (fetch (Interval volumePage) of (\VFMGet key 0))
(IPLUS (fetch (Interval volumePage) of interval)
(IDIFFERENCE (fetch (Key filePage)
of (fetch (Interval nextKey)
of interval))
(fetch (Key filePage)
of (fetch (Interval key)
of interval))))))
then (\VFMDelete key 0) (* merge with following)))))))
)
(* * The following are routines internal to the volume file map module.)
(DEFINEQ
(\VFMContextSet
(LAMBDA (vol) (* hts: " 5-Jan-85 16:24")
(* vol: LogicalVolumeDescriptor)
(* Internal)
(SETQ \VFMvolumeHandle vol)))
(\VFMCreateVPage
(LAMBDA NIL (* hts: " 6-Aug-85 12:44")
(* Returns SWAPPEDFIXP)
(* Internal)
(* * Calls VolAllocMap.AllocPageGroup to get a new page for the vfm B-tree. Returns its volume-relative page
number.)
(with LogicalVolumeDescriptor \VFMvolumeHandle
(PROG ((group (create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← 1))
(vfmFileD (ELT \PFFileMapFileD (\PFVolumeNumber \VFMvolumeHandle))))
(OR (\VAMAllocPageGroup \VFMvolumeHandle vfmFileD group)
(DiskError "HARD DISK ERROR" "File map Btree split failed."))
(RETURN (fetch (PageGroup volumePage) of group))))))
(\VFMDelete
(LAMBDA (deleteKey deleteLevel) (* hts: "24-Jan-85 16:23")
(* key: Key, level: SMALLP)
(* Internal)
(* * Deletes the index corresponding to key. Error if no such index. No merging is done here explicitly;
it happens as a side-effect of (Find ...))
(DECLARE (SPECVARS deleteKey deleteLevel))
(PROG (firstFlag lastFlag volumePage (nextKey (create Key)))
(DECLARE (SPECVARS firstFlag lastFlag volumePage nextKey))
(* * volumePage is the page holding the key (delete if firstFlag AND lastFlag) -
nextKey is the following key; must be slid down over deleted key)
(\VFMFind deleteKey deleteLevel (FUNCTION \VFMDelete1))
(if firstFlag
then
(* * Since this is the first entry in a page, there is a reference to it in the next higher level.
If the current page will become empty due to the delete, we simply delete the reference in the higher page.
Otherwise we must replace the reference with the new first entry of the current page.)
(\VFMDelete deleteKey (ADD1 deleteLevel))
(if lastFlag
then (\VFMFreeVPage volumePage)
else (\VFMInsert nextKey volumePage (ADD1 deleteLevel))))
(\VFMFind deleteKey deleteLevel (FUNCTION \VFMDelete2)))
(* Get the preceding index)
))
(\VFMDelete1
(LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(* * Save the following Index in nextKey; set firstFlag, lastFlag, and volumePage. Shift entries if at beginning of
page.)
(SETQ firstFlag (EQP \VFMlowPtr 0))
(SETQ lastFlag (EQP \VFMhighPtr (fetch (Buffer used) of \VFMbuffer)))
(SETQ volumePage (fetch (Interval volumePage) of \VFMinterval))
(MESASETQ nextKey (fetch (Index key) of \VFMhigh)
Key)
(ASSERT (MESAEQUAL (fetch (Index key) of \VFMlow)
deleteKey Key))
(if (AND firstFlag (NOT lastFlag))
then (\VFMSmartBLT \VFMbuffer (\ADDBASE \VFMbuffer \VFMhighPtr)
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE
(fetch (Buffer used)
of \VFMbuffer)
\VFMhighPtr)))
(\VFMMarkBufferDirty \VFMbuffer))))
(\VFMDelete2
(LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(* * Slide the entries down over nextKey, and then reinsert nextKey in place of the deleted entry.
Be careful to preserve the correct volumePage.)
(replace (Index key) of \VFMhigh with nextKey)
(replace (Index volumePage) of \VFMhigh with (fetch (Index volumePage) of \VFMlow))
(MESASETQ \VFMlow \VFMold Index)
(SETQ \VFMlowPtr \VFMoldPtr)
(\VFMSmartBLT (\ADDBASE \VFMbuffer (IPLUS \VFMlowPtr (MESASIZE Index)))
(\ADDBASE \VFMbuffer \VFMhighPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMhighPtr))
(\VFMPutNext (fetch (Index key) of \VFMhigh)
(fetch (Index volumePage) of \VFMhigh)
deleteLevel)
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE (IPLUS \VFMlowPtr (fetch (Buffer used)
of \VFMbuffer))
\VFMhighPtr))
(\VFMMarkBufferDirty \VFMbuffer)))
(\VFMFind
(LAMBDA (key level proc) (* hts: "25-Jan-85 11:46")
(* key: Key, level: SMALLP, proc: FUNCTION)
(* Internal)
(* executes proc with context
(buffer, low, \VFMhigh) surrounding key
(merges too))
(MESASETQ \VFMinterval (\VFMGet key (ADD1 level))
Interval)
(SETQ \VFMbuffer (\VFMGetBufferFor (fetch (Interval volumePage) of \VFMinterval)))
(* * Initialize reader)
(replace (Index key) of \VFMhigh with (fetch (Interval key) of \VFMinterval))
(replace (Index volumePage) of \VFMhigh with nullVolumePage)
(MESASETQ \VFMold (MESASETQ \VFMlow \VFMhigh Index)
Index)
(SETQ \VFMoldPtr (SETQ \VFMlowPtr (SETQ \VFMhighPtr 0)))
(* * Scan this page till key is passed)
(repeatuntil (\VFMLower key (fetch (Index key) of \VFMhigh)) do (\VFMReadNext))
(APPLY proc)
(if (AND (ILEQ (fetch (Buffer used) of \VFMbuffer)
(IQUOTIENT (MESASIZE Buffer)
3))
(NOT (MESAEQUAL (fetch (Interval nextKey) of \VFMinterval)
\VFMmaxKey Key)))
then (\VFMMerge (fetch (Index key) of \VFMold)
level))))
(\VFMFreeVPage
(LAMBDA (volumePage) (* hts: " 9-Jan-85 17:31")
(* volumePage: SWAPPEDFIXP)
(* Internal)
(* * calls VolAllocMap.FreePageGroup to free a page of the vfm BTree)
(with LogicalVolumeDescriptor \VFMvolumeHandle
(PROG ((group (create PageGroup
filePage ← volumePage
volumePage ← volumePage
nextFilePage ←(ADD1 volumePage)))
(vfmFileD (ELT \PFFileMapFileD (\PFVolumeNumber \VFMvolumeHandle))))
(\VAMFreePageGroup \VFMvolumeHandle vfmFileD group)))
(\VFMKillBuffer volumePage)))
(\VFMGet
(LAMBDA (getKey getLevel) (* hts: "26-Jan-85 18:58")
(* key: Key, level: SMALLP; returns Interval)
(* Internal)
(DECLARE (SPECVARS getKey getLevel))
(if (GREATERP getLevel treeDepth)
then (DiskError "HARD DISK ERROR" "Can't find BTree entry"))
(if (EQ getLevel treeDepth)
then
(* * If you've run out of interval cache to check, just return the widest possible interval)
(create Interval
key ← \VFMnullKey
volumePage ←(fetch (LogicalVolumeDescriptor vfmStart) of \VFMvolumeHandle)
nextKey ← \VFMmaxKey)
else (MESASETQ \VFMinterval (ELT (\VFMGetInterval)
getLevel)
Interval)
(if (OR (\VFMLower getKey (fetch (Interval key) of \VFMinterval))
(NOT (\VFMLower getKey (fetch (Interval nextKey) of \VFMinterval))))
then
(* * If the cached interval for the current level isn't the one you were looking for, then search one level closer
to the root of the btree)
(\VFMFind getKey getLevel (FUNCTION \VFMGet1)))
(ELT (\VFMGetInterval)
getLevel))))
(\VFMGet1
(LAMBDA NIL (* hts: " 5-Jan-85 16:30")
(* Internal)
(PROG ((interval (ELT (\VFMGetInterval)
getLevel)))
(if interval
then (replace (Interval key) of interval with (fetch (Index key) of \VFMlow))
(replace (Interval volumePage) of interval with (fetch (Index volumePage)
of \VFMhigh))
(replace (Interval nextKey) of interval with (fetch (Index key) of \VFMhigh))))))
(\VFMInsert
(LAMBDA (insertKey insertVolumePage insertLevel) (* hts: "24-Jan-85 17:44")
(* key: Key, volumePage: PageNumber, level: Level)
(* Internal)
(* * Inserts an Index containing key and volumePage, calling Split if necessary.)
(DECLARE (SPECVARS insertKey insertVolumePage insertLevel))
(PROG (splitFlag)
(DECLARE (SPECVARS splitFlag))
(* * Try the insert.)
(\VFMFind insertKey insertLevel (FUNCTION \VFMInsert1))
(* * If there wasn't enough space to insert, split the page and retry the insertion.)
(if splitFlag
then (\VFMSplit insertKey insertLevel)
(\VFMFind insertKey insertLevel (FUNCTION \VFMInsert1))))))
(\VFMInsert1
(LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(PROG NIL
(if (SETQ splitFlag (IGREATERP (fetch (Buffer used) of \VFMbuffer)
maxReadPtr))
then (RETURN))
(if (ILESSP \VFMlowPtr (fetch (Buffer used) of \VFMbuffer))
then (\VFMSmartBLT (\ADDBASE \VFMbuffer (IPLUS \VFMlowPtr (TIMES (MESASIZE Index)
2)))
(\ADDBASE \VFMbuffer \VFMhighPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMhighPtr))
(\VFMPutNext insertKey (fetch (Index volumePage) of \VFMhigh)
insertLevel)
else (\VFMSmartBLT (\ADDBASE \VFMbuffer (IPLUS \VFMlowPtr (MESASIZE Index)))
(\ADDBASE \VFMbuffer \VFMhighPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMhighPtr)))
(\VFMPutNext (fetch (Index key) of \VFMhigh)
insertVolumePage insertLevel)
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE (IPLUS \VFMlowPtr
(fetch (Buffer used)
of \VFMbuffer))
\VFMhighPtr))
(\VFMMarkBufferDirty \VFMbuffer))))
(\VFMLower
(LAMBDA (a b) (* hts: " 5-Jan-85 16:23")
(* a: Key, b: Key; returns BOOLEAN)
(* Internal)
(* * Compares two keys for ordering; maxKey < maxKey to close key space)
(* * somewhat icky because fileids are 32 bit #s where high bit set means high positive number, not negative.)
(PROG ((AFILE (fetch (Key fileID) of a))
(BFILE (fetch (Key fileID) of b))
(APAGE (fetch (Key filePage) of a))
(BPAGE (fetch (Key filePage) of b)))
(RETURN (OR (if (GEQ AFILE 0)
then (if (LESSP BFILE 0)
then T
else (AND (GEQ BFILE 0)
(LESSP AFILE BFILE)))
else (if (GEQ BFILE 0)
then NIL
else (AND (LESSP BFILE 0)
(GREATERP AFILE BFILE))))
(AND (EQP AFILE BFILE)
(OR (ILESSP APAGE BPAGE)
(MESAEQUAL b \VFMmaxKey Key))))))))
(\VFMMerge
(LAMBDA (mergeKey mergeLevel) (* hts: "25-Jan-85 12:17")
(* key: Key, level: SMALLP)
(* Internal)
(* * Tries to merge page of oldInterval with next page at same mergeLevel or with root; cannot merge last page of
any mergeLevel except rootlevel)
(DECLARE (SPECVARS mergeKey mergeLevel))
(PROG (mergeFlag (leftInterval (create Interval))
(rightInterval (create Interval)))
(DECLARE (SPECVARS mergeFlag leftInterval rightInterval))
(* * get a valid volumePage)
(MESASETQ leftInterval (\VFMGet mergeKey (ADD1 mergeLevel))
Interval)
(\VFMFind (fetch (Interval nextKey) of leftInterval)
mergeLevel
(FUNCTION \VFMMerge1)) (* beware the merging)
(* * Get rid of the old reference to the merging page.)
(\VFMDelete (fetch (Interval nextKey) of leftInterval)
(ADD1 mergeLevel))
(* * If the page was not actually merged, insert the new Index, else free up the merged page.)
(if mergeFlag
then (\VFMFreeVPage (fetch (Interval volumePage) of rightInterval))
else (\VFMInsert (fetch (Interval key) of rightInterval)
(fetch (Interval volumePage) of rightInterval)
(ADD1 mergeLevel))))))
(\VFMMerge1
(LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(PROG (xtraBufferUsed)
(MESASETQ rightInterval \VFMinterval Interval)
(SETQ \VFMxtraBuffer (\VFMGetBufferFor (fetch (Interval volumePage) of leftInterval)))
(SETQ xtraBufferUsed (fetch (Buffer used) of \VFMxtraBuffer))
(* xtraBufferUsed used to solve stack modeling error)
(if (EQ mergeLevel (SUB1 treeDepth))
then (replace (Buffer used) of \VFMxtraBuffer with 0))
(if (SETQ mergeFlag (ILESSP (IPLUS (fetch (Buffer used) of \VFMbuffer)
(fetch (Buffer used) of \VFMxtraBuffer))
(MESASIZE Buffer)))
then
(* * If merging possible then merge pages. Merge buffer with aux buffer.)
(\VFMSmartBLT (\ADDBASE \VFMxtraBuffer xtraBufferUsed)
\VFMbuffer
(fetch (Buffer used) of \VFMbuffer))
(replace (Buffer used) of \VFMxtraBuffer with (IPLUS (fetch (Buffer used)
of \VFMxtraBuffer)
(fetch (Buffer used)
of \VFMbuffer)))
(* buffer.used remains to prevent Find from attempting
a merge)
else
(* * otherwise balance pages simply to provide hysteresis against futile merge attempts. First find middle.)
(while (ILESSP \VFMlowPtr (IQUOTIENT (IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
(fetch (Buffer used) of
\VFMxtraBuffer))
2))
do (\VFMReadNext))
(* * move first of \VFMbuffer to xtra)
(\VFMSmartBLT (\ADDBASE \VFMxtraBuffer xtraBufferUsed)
\VFMbuffer \VFMlowPtr)
(* * slide down the rest of \VFMbuffer)
(\VFMSmartBLT \VFMbuffer (\ADDBASE \VFMbuffer \VFMlowPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMlowPtr))
(* * Straighten out end-of-node info.)
(replace (Buffer used) of \VFMxtraBuffer with (IPLUS (fetch (Buffer used)
of \VFMxtraBuffer)
\VFMlowPtr))
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE (fetch (Buffer used)
of \VFMbuffer)
\VFMlowPtr))
(* * use \VFMlow to insert while it is still valid)
(replace (Interval key) of rightInterval with (fetch (Index key) of \VFMlow)))
(* * Finish up.)
(\VFMMarkBufferDirty \VFMbuffer)
(\VFMMarkBufferDirty \VFMxtraBuffer)
(SETQ \VFMxtraBuffer NIL))))
(\VFMPutNext
(LAMBDA (key volumePage level) (* hts: "25-Jan-85 15:25")
(* key: Key, volumePage: SWAPPEDFIXP, level: SMALLP)
(* Internal)
(* Compresses item in the context of low. Note the side effect on \VFMlow but not on high!! No compression is
implemented in this version, but useful one would include: front compression (especially to shrink page groups back
to 2 fields))
(MESASETQ \VFMold \VFMlow Index)
(SETQ \VFMoldPtr \VFMlowPtr)
(replace (Index key) of \VFMlow with key)
(replace (Index volumePage) of \VFMlow with volumePage)
(MESASETQ (\ADDBASE (fetch (Buffer data) of \VFMbuffer)
\VFMlowPtr)
\VFMlow Index)
(SETQ \VFMlowPtr (IPLUS \VFMoldPtr (MESASIZE Index)))
(* * keep cache up to date in the face of changes)
(SETA (\VFMGetInterval)
level
(create Interval
key ←(fetch (Index key) of \VFMold)
volumePage ←(fetch (Index volumePage) of \VFMlow)
nextKey ←(fetch (Index key) of \VFMlow)))
(* * Mark buffer dirty)
(\VFMMarkBufferDirty \VFMbuffer)))
(\VFMReadNext
(LAMBDA NIL (* hts: "26-Jan-85 15:24")
(* * Internal)
(* * Decompresses item at \VFMhigh to become \VFMlow & bumps high. Note the side effect on \VFMlow and not high.
No compression is implemented in this version)
(OR (LEQ \VFMhighPtr (fetch (Buffer used) of \VFMbuffer))
(DiskError "HARD DISK ERROR" "Read too far in ReadNext"))
(MESASETQ \VFMold \VFMlow Index)
(SETQ \VFMoldPtr \VFMlowPtr)
(MESASETQ \VFMlow \VFMhigh Index)
(SETQ \VFMlowPtr \VFMhighPtr)
(if (ILESSP \VFMhighPtr (fetch (Buffer used) of \VFMbuffer))
then (* Loophole)
(MESASETQ \VFMhigh (\ADDBASE (fetch (Buffer data) of \VFMbuffer)
\VFMhighPtr)
Index)
(SETQ \VFMhighPtr (IPLUS \VFMhighPtr (MESASIZE Index)))
else (* Leave ptr alone)
(replace (Index key) of \VFMhigh with \VFMmaxKey)
(replace (Index volumePage) of \VFMhigh with nullVolumePage))))
(\VFMSplit
(LAMBDA (splitKey splitLevel) (* hts: " 5-Jan-85 16:29")
(* key: Key, level: SMALLP)
(* Internal)
(* * moves half of \DFSVFMbuffer (or root) to xtraBuffer, creating new page of tree)
(DECLARE (SPECVARS splitKey splitLevel))
(PROG ((keyStone (create Key))
(page (\VFMCreateVPage))) (* keyStone is the half way mark)
(DECLARE (SPECVARS keyStone page))
(\VFMFind splitKey splitLevel (FUNCTION \VFMSplit1))
(\VFMInsert keyStone page (ADD1 splitLevel)))))
(\VFMSplit1
(LAMBDA NIL (* hts: "25-Jan-85 12:01")
(* Internal)
(* * Read in an extra page into which to copy the second half of the current node)
(SETQ \VFMxtraBuffer (\VFMGetBufferFor page))
(* * Find the middle of the page to split)
(SETQ \VFMhighPtr 0)
(replace (Index key) of \VFMhigh with (fetch (Interval key) of \VFMinterval))
(replace (Index volumePage) of \VFMhigh with nullVolumePage)
(repeatuntil (IGREATERP \VFMhighPtr (IQUOTIENT (fetch (Buffer used) of \VFMbuffer)
2))
do (\VFMReadNext))
(* * Move the last half of buffer to extra buffer.)
(\BLT \VFMxtraBuffer (\ADDBASE (fetch (Buffer data) of \VFMbuffer)
\VFMlowPtr)
(replace (Buffer used) of \VFMxtraBuffer with (IDIFFERENCE (fetch (Buffer used)
of \VFMbuffer)
\VFMlowPtr)))
(replace (Buffer used) of \VFMbuffer with \VFMlowPtr)
(MESASETQ keyStone (fetch (Index key) of \VFMlow)
Key)
(* * Mark buffers dirty so that they will be flushed out to disk, and clear the extra buffer holder
(just to prevent confusion))
(\VFMMarkBufferDirty \VFMbuffer)
(\VFMMarkBufferDirty \VFMxtraBuffer)
(SETQ \VFMxtraBuffer NIL)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VFMmaxID \VFMmaxKey \VFMnullKey \VFMvolumeHandle \VFMinterval \VFMold \VFMlow \VFMhigh
\VFMoldPtr \VFMlowPtr \VFMhighPtr \VFMmonitor)
)
(* * Buffer management)
(DEFINEQ
(\VFMGetBufferFor
(DLAMBDA ((VOLPAGENUM FIXP)
(RETURNS Buffer))
(* hts: "25-Jan-85 15:23")
(* page: SWAPPEDFIXP)
(* Internal)
(* * Try to find btree page in buffer pool. If there, move to front of buffer pool. Otherwise, read in the requred
page and put it at the front of the pool. If buffer pool is > maxbufferpoolsize then flush the last page in the
pool)
(DPROG ((BUFFER (\VFMKillBuffer VOLPAGENUM) (ONEOF NIL \BTREEBUF))
(LAST NIL LST)
(FLUSH NIL LST))
(if BUFFER
then
(* * Move buffer to front of buffer list)
(push \VFMbufferPool BUFFER)
else
(* * Create and read in new buffer)
(push \VFMbufferPool (SETQ BUFFER
(create \BTREEBUF
VOLUME ← \VFMvolumeHandle
VOLPAGENUM ← VOLPAGENUM
PAGE ←(create Buffer)
DIRTY ← NIL)))
(\PFGetFileMapPage \VFMvolumeHandle VOLPAGENUM (fetch (\BTREEBUF PAGE) of BUFFER))
(* * Shorten buffer pool if necessary)
(if (SETQ FLUSH (CDR (SETQ LAST (FNTH \VFMbufferPool \VFMbufferSize))))
then (RPLACD LAST NIL)
(\VFMSaveBuffer T FLUSH)))
(* * Finally set the main buffer page to be the selected buffer page.)
(RETURN (fetch (\BTREEBUF PAGE) of BUFFER)))))
(\VFMSaveBuffer
(DLAMBDA ((notAll BOOL)
(whichBuffers LST)
(evenIfNotDirty BOOL)
(RETURNS NIL))
(* mjs "20-Feb-85 21:00")
(* * Flushes dirty buffers. If notAll is true, then it is to save only the specified buffers)
(OR notAll (SETQ whichBuffers \VFMbufferPool))
(for BUF inside whichBuffers when (OR (fetch (\BTREEBUF DIRTY) of BUF)
evenIfNotDirty)
do (\PFPutFileMapPage (fetch (\BTREEBUF VOLUME) of BUF)
(fetch (\BTREEBUF VOLPAGENUM) of BUF)
(fetch (\BTREEBUF PAGE) of BUF))
(replace (\BTREEBUF DIRTY) of BUF with NIL))))
(\VFMClearBuffers
(LAMBDA NIL (* hts: "16-Nov-84 15:38")
(* * Clear the btree node cache)
(SETQ \VFMbufferPool NIL)))
(\VFMKillBuffer
(DLAMBDA ((VOLPAGENUM FIXP)
(RETURNS (ONEOF NIL \BTREEBUF)))
(* hts: "23-Jan-85 16:19")
(* * Remove the buffer for a btree node which is being decommissioned.)
(* * return the removed node)
(if (AND (LISTP \VFMbufferPool)
(\VFMCorrectBufferP (CAR \VFMbufferPool)
VOLPAGENUM))
then (PROG1 (CAR \VFMbufferPool)
(SETQ \VFMbufferPool (CDR \VFMbufferPool)))
else (bind CURRENT for PREV on \VFMbufferPool do (if (AND (LISTP (SETQ CURRENT (CDR PREV)))
(\VFMCorrectBufferP (CAR CURRENT)
VOLPAGENUM))
then (RETURN (PROG1 (CAR CURRENT)
(RPLACD PREV
(CDR CURRENT)))
))))))
(\VFMCorrectBufferP
(LAMBDA (BUFFER VOLPAGENUM) (* hts: " 9-Jan-85 18:20")
(* * True iff BUFFER is the right buffer for VOLPAGENUM)
(AND (EQ (fetch (\BTREEBUF VOLUME) of BUFFER)
\VFMvolumeHandle)
(EQ (fetch (\BTREEBUF VOLPAGENUM) of BUFFER)
VOLPAGENUM))))
(\VFMMarkBufferDirty
(DLAMBDA ((BUFFERPAGE Buffer)
(RETURNS NIL))
(* hts: "25-Jan-85 11:44")
(* * Note that the specified buffer has been written into and will have to be flushed out to disk.)
(replace (\BTREEBUF DIRTY) of (for BUF in \VFMbufferPool thereis (EQ BUFFERPAGE
(fetch (\BTREEBUF PAGE)
of BUF)))
with T)
NIL))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VFMbufferPool \VFMbufferSize \VFMbuffer \VFMxtraBuffer)
)
(RPAQ? \VFMbufferSize 10)
(* * Interval cache interface)
(DEFINEQ
(\VFMCreateIntervals
(LAMBDA NIL (* hts: " 5-Jan-85 16:25")
(* * Conditionally create array to hold interval cache for each volume. Conditional so that loadfroming this file
will not destroy state.)
(* * Interval cache for each volume keeps a finger into the BTree: traces a correct path through the BTree, which
need be only partially backtracked (if at all) to find any given interval in the BTree. Saves reading one page at
each level of the BTree every time you want to look for an interval.)
(if (NOT (AND (BOUNDP (QUOTE \VFMintervals))
(type? ARRAYP \VFMintervals)
(ZEROP (ARRAYORIG \VFMintervals))
(EQ maxLogicalVolumes (ARRAYSIZE \VFMintervals))))
then (SETQ \VFMintervals (ARRAY maxLogicalVolumes NIL NIL 0)))))
(\VFMClearIntervals
(LAMBDA NIL (* hts: " 5-Jan-85 16:25")
(* * Clears the BTree interval cache so that it will be correctly reinitialized should this lisp image wake up on an
alien machine)
(for volume from 0 to (SUB1 maxLogicalVolumes) do (SETA \VFMintervals volume NIL))))
(\VFMGetInterval
(LAMBDA NIL (* hts: "26-Jan-85 18:56")
(* * Returns the interval cache for the current volume. If this interval cache is empty, initializes with a leftmost
path through the BTree for that volume.)
(PROG ((volNum (\PFVolumeNumber \VFMvolumeHandle)))
(RETURN (OR (ELT \VFMintervals volNum)
(SETA \VFMintervals volNum
(bind (intervalArray ←(ARRAY treeDepth NIL NIL 0))
(BTreePageNum ←(fetch (LogicalVolumeDescriptor vfmStart)
of \VFMvolumeHandle))
for level from (SUB1 treeDepth) to 0 by -1
do (SETQ \VFMbuffer (\VFMGetBufferFor BTreePageNum))
(SETQ BTreePageNum
(fetch (Interval volumePage)
of (SETA intervalArray level
(create Interval
key ← \VFMnullKey
volumePage ←(fetch (Index volumePage)
of \VFMbuffer)
nextKey ←(fetch (Index key) of \VFMbuffer)))))
finally (RETURN intervalArray))))))))
(\VFMBlankInterval
(LAMBDA NIL (* hts: "26-Jan-85 18:57")
(* * Returns the interval cache for the current volume. If this interval cache is empty, initializes with a blank
set of intervals with InitMap will fill with a leftmost path through the BTree for that volume.)
(* * Should be called by InitMap only.)
(PROG ((volNum (\PFVolumeNumber \VFMvolumeHandle)))
(RETURN (OR (ELT \VFMintervals volNum)
(SETA \VFMintervals volNum (PROG ((intervalCache (ARRAY treeDepth NIL NIL 0)))
(for level from 0 to (SUB1 treeDepth)
do (SETA intervalCache level (create
Interval)))
(RETURN intervalCache))))))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VFMintervals)
)
(* * BLT routine that doesn't stomp on itself for overlapping intervals)
(DEFINEQ
(\VFMSmartBLT
(LAMBDA (DBASE SBASE NWORDS) (* hts: "24-Jun-84 15:57")
(* This is necessary because \BLT will not copy
overlapping intervals correctly in one direction.)
(if (AND (PTRGTP SBASE DBASE)
(PTRGTP (\ADDBASE DBASE NWORDS)
SBASE))
then (for i from 0 to (SUB1 NWORDS) do (\PUTBASE DBASE i (\GETBASE SBASE i)))
DBASE
else (\BLT DBASE SBASE NWORDS))))
)
(* * Loading initialization)
(DEFINEQ
(\VFMAtLoad
(LAMBDA NIL (* hts: "25-Jan-85 11:50")
(* * Initialize global variables for the volume file map)
(SETQ \VFMmaxID -1)
(SETQ \VFMmaxKey (create Key
fileID ← \VFMmaxID
filePage ← lastPageNumber))
(SETQ \VFMnullKey (create Key))
(SETQ \VFMvolumeHandle NIL)
(SETQ \VFMinterval (create Interval))
(SETQ \VFMold (create Index))
(SETQ \VFMlow (create Index))
(SETQ \VFMhigh (create Index))
(SETQ \VFMoldPtr 0)
(SETQ \VFMlowPtr 0)
(SETQ \VFMhighPtr 0)
(\VFMCreateIntervals)
(SETQ \VFMmonitor (CREATE.MONITORLOCK (QUOTE \VFMmonitor)))))
)
(\VFMAtLoad)
(PUTPROPS LOCALFILE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1378 2827 (\PFFetchString 1388 . 1977) (\PFReplaceString 1979 . 2825)) (23046 27866 (
CREATEDSKDIRECTORY 23056 . 24655) (PURGEDSKDIRECTORY 24657 . 26407) (LISPDIRECTORYP 26409 . 26941) (
VOLUMES 26943 . 27450) (VOLUMESIZE 27452 . 27864)) (27867 28705 (DFSCREATEDIRECTORY 27877 . 28096) (
MKDIR 28098 . 28304) (DFSPURGEDIRECTORY 28306 . 28524) (DFSVOLUMES 28526 . 28703)) (28706 29590 (
\DFSCurrentVolume 28716 . 29115) (\DFSFreeDiskPages 29117 . 29588)) (29591 31250 (\LFEntryPoint 29601
. 30689) (\LFNormalizeVolumeName 30691 . 31248)) (31281 33816 (\LFCreateDevice 31291 . 32577) (
\LFOpenDevice 32579 . 33433) (\LFCloseDevice 33435 . 33814)) (34041 46436 (\LFOpenFile 34051 . 36475)
(\LFGetStreamForFile 36477 . 38443) (\LFOpenOldFile 38445 . 40593) (\LFGenFileID 40595 . 40966) (
\LFCreateFile 40968 . 42819) (\LFMakeLeaderPage 42821 . 44587) (\LFUpdateLeaderPage 44589 . 46051) (
\LFWriteLeaderPage 46053 . 46434)) (46437 47795 (\LFCloseFile 46447 . 47793)) (47796 49040 (
\LFDeleteFile 47806 . 49038)) (49041 51691 (\LFReadPages 49051 . 51689)) (51692 54694 (\LFWritePages
51702 . 52458) (\LFExtendFileIfNecessary 52460 . 53814) (\LFExtendFile 53816 . 54692)) (54695 56877 (
\LFGetFileInfo 54705 . 56875)) (56878 57548 (\LFGetFileName 56888 . 57546)) (57549 59631 (\LFEventFn
57559 . 59629)) (59632 61150 (\LFDirectoryNameP 59642 . 61148)) (61151 62578 (\LFTruncateFile 61161 .
62576)) (67023 70405 (\LFFindDirectory 67033 . 67644) (\LFFindDirectoryVol 67646 . 69157) (
\LFParseFileName 69159 . 70403)) (70451 74783 (\LFMakeVolumeDirectory 70461 . 71972) (\LFDirectoryP
71974 . 73610) (\LFPurgeDirectory 73612 . 74406) (\LFCloseDirectory 74408 . 74781)) (74864 81819 (
\LFMakeDirEntry 74874 . 76857) (\LFRemoveDirEntry 76859 . 77990) (\LFReadFileID 77992 . 78570) (
\LFFindDirHole 78572 . 80301) (\LFMakeDirHole 80303 . 81533) (\LFCheckBang 81535 . 81817)) (81820
87692 (\LFDirectorySearch 81830 . 85190) (\LFVersions 85192 . 87690)) (87693 93695 (\LFFileSpec 87703
. 90310) (\LFUnpackName 90312 . 91995) (\LFFullFileName 91997 . 92702) (\LFFileName 92704 . 93693)) (
93696 94214 (\LFDirectoryScrambled 93706 . 94212)) (94215 94803 (\LFDWIN 94225 . 94472) (\LFDWOUT
94474 . 94801)) (94838 106087 (\LFGenerateFiles 94848 . 99161) (\LFFindNextFile 99163 . 101176) (
\LFSortFiles 101178 . 102211) (\LFHighestVersions 102213 . 102832) (\LFFindInfo 102834 . 104827) (
\LFReturnNextFile 104829 . 105456) (\LFReturnInfo 105458 . 106085)) (106195 107235 (\LFGetDirectory
106205 . 106405) (\LFPutDirectory 106407 . 106772) (\LFCreateDirectories 106774 . 107233)) (107360
108125 (\LFINITCASEARRAY 107370 . 107884) (\LFCASEARRAYFETCH 107886 . 108123)) (108956 113960 (
SCAVENGEDSKDIRECTORY 108966 . 112257) (SCAVENGEVOLUME 112259 . 112461) (\LFScavFileName 112463 .
113360) (\LFScavVersion 113362 . 113958)) (114077 115037 (\VFMGenerateFileIDs 114087 . 115035)) (
117655 117867 (\PFGetPhysicalVolumePage 117665 . 117865)) (117868 118442 (\PFGetLogicalVolumePage
117878 . 118158) (\PFPutLogicalVolumePage 118160 . 118440)) (118443 119181 (\PFGetMarkerPage 118453 .
118815) (\PFPutMarkerPage 118817 . 119179)) (119182 119920 (\PFGetFreePage 119192 . 119565) (
\PFCreateFreePage 119567 . 119918)) (119921 120567 (\PFGetAllocationMapPage 119931 . 120241) (
\PFPutAllocationMapPage 120243 . 120565)) (120568 121202 (\PFGetFileMapPage 120578 . 120888) (
\PFPutFileMapPage 120890 . 121200)) (121203 122574 (\PFGetPage 121213 . 121673) (\PFPutPage 121675 .
122076) (\PFCreatePage 122078 . 122572)) (122575 124077 (\PFTransferFilePage 122585 . 124075)) (124078
125492 (\PFTransferPage 124088 . 125490)) (125928 129591 (\PFCreateFileDescriptors 125938 . 128257) (
\PFInitFileDescriptors 128259 . 129589)) (129795 130179 (\PFCreatePhysicalVolume 129805 . 130177)) (
130314 132824 (\PFCreateVols 130324 . 131650) (\PFInitializeVols 131652 . 131969) (\PFGetVols 131971
. 132249) (\PFGetVol 132251 . 132399) (\PFVolumeNumber 132401 . 132822)) (132932 133416 (\PFGetLVPage
132942 . 133414)) (133445 134357 (\PFVersionOK 133455 . 133848) (\PFPilotVolumeP 133850 . 134355)) (
134391 135671 (\PFEnsureInitialized 134401 . 135669)) (135873 137537 (\PFFindDirectoryID 135883 .
136369) (\PFInsertDirectoryID 136371 . 137014) (\PFRemoveDirectoryID 137016 . 137535)) (137538 140244
(\PFFindRootDirEntry 137548 . 138098) (\PFAddRootDirEntry 138100 . 138658) (\PFRemoveRootDirEntry
138660 . 139342) (\PFFindRootDirEntryNum 139344 . 139925) (\PFPatchRootDirEntries 139927 . 140242)) (
140245 142883 (\PFGetRootDirectory 140255 . 141125) (\PFPutRootDirectory 141127 . 141813) (
\PFCreateRootDirectory 141815 . 142432) (\PFPurgeRootDirectory 142434 . 142881)) (142884 143680 (
\GetRootDirectoryType 142894 . 143118) (\PFPutRootDirectoryType 143120 . 143678)) (143715 150552 (
\PFNewPages 143725 . 145278) (\PFTrimHelper 145280 . 146760) (\PFFindPageAddr 146762 . 148374) (
\PFFindFileSize 148376 . 148827) (\PFFreeDiskPages 148829 . 149285) (\PFRoomForFile 149287 . 150226) (
\PFSaveBuffers 150228 . 150550)) (150575 151234 (\PFCurrentVol 150585 . 151232)) (151346 151636 (
\PFDsplyVolumes 151356 . 151634)) (153425 160078 (\VAMAllocPageGroup 153435 . 156224) (
\VAMFreePageGroup 156226 . 158843) (\VAMInit 158845 . 159082) (\VAMRecomputeFreePageCount 159084 .
160076)) (160109 166235 (\VAMFilePageNumber 160119 . 160649) (\VAMEnoughSpace 160651 . 161595) (
\VAMFindFreePages 161597 . 163578) (\VAMCheckEndOfVol 163580 . 164069) (\VAMUpdateVAM 164071 . 165346)
(\VAMAdjustGroup 165348 . 166233)) (166577 168632 (\VAMGetVAMPageFor 166587 . 167619) (\VAMBufferInit
167621 . 167989) (\VAMBufferSave 167991 . 168370) (\VAMMarkBufferDirty 168372 . 168630)) (172008
172653 (ShowIntervals 172018 . 172651)) (172904 173322 (\VFMInit 172914 . 173320)) (173403 185540 (
\VFMDeletePageGroup 173413 . 180880) (\VFMGetPageGroup 180882 . 182727) (\VFMInsertPageGroup 182729 .
185538)) (185620 207837 (\VFMContextSet 185630 . 185955) (\VFMCreateVPage 185957 . 186832) (\VFMDelete
186834 . 188482) (\VFMDelete1 188484 . 189552) (\VFMDelete2 189554 . 190721) (\VFMFind 190723 .
192235) (\VFMFreeVPage 192237 . 192984) (\VFMGet 192986 . 194355) (\VFMGet1 194357 . 194983) (
\VFMInsert 194985 . 195903) (\VFMInsert1 195905 . 197290) (\VFMLower 197292 . 198450) (\VFMMerge
198452 . 200036) (\VFMMerge1 200038 . 203015) (\VFMPutNext 203017 . 204358) (\VFMReadNext 204360 .
205552) (\VFMSplit 205554 . 206315) (\VFMSplit1 206317 . 207835)) (208058 212393 (\VFMGetBufferFor
208068 . 209657) (\VFMSaveBuffer 209659 . 210423) (\VFMClearBuffers 210425 . 210624) (\VFMKillBuffer
210626 . 211534) (\VFMCorrectBufferP 211536 . 211895) (\VFMMarkBufferDirty 211897 . 212391)) (212568
215848 (\VFMCreateIntervals 212578 . 213482) (\VFMClearIntervals 213484 . 213868) (\VFMGetInterval
213870 . 215016) (\VFMBlankInterval 215018 . 215846)) (215992 216564 (\VFMSmartBLT 216002 . 216562)) (
216600 217376 (\VFMAtLoad 216610 . 217374)))))
STOP