(FILECREATED "18-Mar-85 16:37:53" {ERIS}<LISP>INTERMEZZO>SOURCES>LFDIRECTORY.;7 44388
changes to: (FNS \LFUnpackName)
previous date: "11-Mar-85 18:42:45" {ERIS}<LISP>INTERMEZZO>SOURCES>LFDIRECTORY.;6)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LFDIRECTORYCOMS)
(RPAQQ LFDIRECTORYCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LFPILOTFILE LOCALFILE)
(FILES DECL)
(CONSTANTS (directorySize 50))
(RECORDS GenerateFileState GeneratedFile DIRSEARCHSTATE
PARSEDFILENAME ExpandedName DFSFileSpec)
(MACROS CONDCONCAT)
(FNS PRINTDIRECTORY))
(DECLARE: (LOCALVARS . T)
(IGNOREDECL . T))
(* * 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)))
(* * Load other file system modules)
(FILES SCAVENGEDSKDIRECTORY)))
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
LFPILOTFILE LOCALFILE)
(FILESLOAD DECL)
(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])
)
(DEFINEQ
(PRINTDIRECTORY
[LAMBDA (STREAM) (* hts: " 5-Jan-85 15:01")
(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])
)
)
(DECLARE:
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(RESETSAVE COMPILEIGNOREDECL (QUOTE T))
)
)
(* * 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)))
(* mjs "23-Feb-85 20:19")
(* * 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))
(\PFNewPages vol file (create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← directorySize))
(* * 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)
(RETURNS NIL))
(* hts: "16-Feb-85 22:15")
(* * Makes a directory entry for a new file)
(PROG ((NC (LENGTH (fetch (ExpandedName CHARLIST) of UNAME)))
POS 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))
(* * Find a place in the directory file.)
(SETQ POS (\LFFindDirHole SIZE DirStream))
(* * 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 (BYTES DIRSTREAM) (* mjs "23-Feb-85 20:17")
(* * Returns the byte address of a directory hole of size BYTES)
(bind (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)
(\LFMakeDirHole DIRSTREAM PTR BYTES)
(RETURN PTR)
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 SIZE) (* hts: " 4-Jan-85 15:12")
(* * comment)
(UNINTERRUPTABLY
(\SETFILEPTR DIRSTREAM WHERE)
(* * Mark beginning of entry)
(\BOUT DIRSTREAM (CHARCODE !))
(* * Mark as hole)
(\BOUT DIRSTREAM 0)
(* * Note size of hole)
(\BOUT DIRSTREAM SIZE))
(FORCEOUTPUT 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: "16-Jan-85 16:21")
(* * 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))
(* * Load other file system modules)
(FILESLOAD SCAVENGEDSKDIRECTORY)
(PUTPROPS LFDIRECTORY COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3144 3866 (PRINTDIRECTORY 3154 . 3864)) (4319 7674 (\LFFindDirectory 4329 . 4940) (
\LFFindDirectoryVol 4942 . 6445) (\LFParseFileName 6447 . 7672)) (7720 11965 (\LFMakeVolumeDirectory
7730 . 9159) (\LFDirectoryP 9161 . 10792) (\LFPurgeDirectory 10794 . 11588) (\LFCloseDirectory 11590
. 11963)) (12046 17872 (\LFMakeDirEntry 12056 . 14140) (\LFRemoveDirEntry 14142 . 15268) (
\LFReadFileID 15270 . 15847) (\LFFindDirHole 15849 . 17128) (\LFMakeDirHole 17130 . 17586) (
\LFCheckBang 17588 . 17870)) (17873 23733 (\LFDirectorySearch 17883 . 21240) (\LFVersions 21242 .
23731)) (23734 29715 (\LFFileSpec 23744 . 26339) (\LFUnpackName 26341 . 28021) (\LFFullFileName 28023
. 28725) (\LFFileName 28727 . 29713)) (29716 30234 (\LFDirectoryScrambled 29726 . 30232)) (30235
30819 (\LFDWIN 30245 . 30490) (\LFDWOUT 30492 . 30817)) (30854 42074 (\LFGenerateFiles 30864 . 35160)
(\LFFindNextFile 35162 . 37172) (\LFSortFiles 37174 . 38206) (\LFHighestVersions 38208 . 38823) (
\LFFindInfo 38825 . 40814) (\LFReturnNextFile 40816 . 41443) (\LFReturnInfo 41445 . 42072)) (42182
43216 (\LFGetDirectory 42192 . 42389) (\LFPutDirectory 42391 . 42756) (\LFCreateDirectories 42758 .
43214)) (43341 44103 (\LFINITCASEARRAY 43351 . 43863) (\LFCASEARRAYFETCH 43865 . 44101)))))
STOP