(FILECREATED "11-Oct-84 11:39:04" {ERIS}<STANSBURY>OS>VOLUMEDIRECTORY.;1 30682
changes to: (VARS VOLUMEDIRECTORYCOMS)
previous date: "24-Sep-84 23:48:14" {ERIS}<STANSBURY>VAM>VOLUMEDIRECTORY.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT VOLUMEDIRECTORYCOMS)
(RPAQQ VOLUMEDIRECTORYCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (COMS * VOLUMEDIRECTORYCOMPILECOMS))
(DECLARE: (LOCALVARS . T))
(* * Functions for creating directories and making entries in them and
deleting entries from them)
(FNS \DFSMakeVolumeDirectory \DFSOpenDirectory \DFSMakeDirEntry
\DFSFindDirHole \DFSReadFileID \DFSRemoveDirEntry
\DFSDirectorySearch \DFSVersions \DFSFileSpec \DFSUnpackName
\DFSFullFileName \DFSFileName)
(FNS \DWIN \DWOUT)
(* * Directory enumeration)
(FNS \DFSGenerateFiles \DFSNextFileFn \DFSFileInfoFn)))
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ VOLUMEDIRECTORYCOMPILECOMS ((FILES (LOADCOMP)
DLIONFS)
(RECORDS DFSGenerateFileState DFSDirSearchState)
(MACROS UCASECHAR BETWEEN)))
(FILESLOAD (LOADCOMP)
DLIONFS)
[DECLARE: EVAL@COMPILE
(RECORD DFSGenerateFileState (DIROFD HOSTNAME ENTRYSTART GENSTREAM . SEARCHSTATE))
(RECORD DFSDirSearchState (DIRPTR . CHARLIST))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS UCASECHAR MACRO [(C)
(COND
((ILESSP C (CHARCODE a))
C)
(T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
(CHARCODE A])
(PUTPROPS BETWEEN MACRO (OPENLAMBDA (V LO HI)
(AND (IGEQ V LO)
(ILEQ V HI))))
)
)
(DECLARE:
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
)
(* * Functions for creating directories and making entries in them and deleting entries from
them)
(DEFINEQ
(\DFSMakeVolumeDirectory
[LAMBDA (vol) (* hts: "14-Sep-84 17:19")
(UNINTERRUPTABLY
(PROG ((markerPage (\LvGetPage vol (MarkerPageAddr vol)))
(dirName (\DFSUnpackName (PACKFILENAME (QUOTE HOST)
(fetch (LogicalVolumeDescriptor LVlabel)
of vol)
(QUOTE NAME)
(QUOTE DIRECTORY)
(QUOTE VERSION)
1)))
(directoryID (\DFSGenFileID vol))
file)
(* * Record that volume is now a Lisp volume; also record new directory ID)
(replace (LogicalVolumeDescriptor type) of vol with DFSLispVolume)
(replace (LogicalVolumeDescriptor volumeRootDirectory) of vol with directoryID)
(\LvPutPage vol 0 vol)
(replace (LogicalSubVolumeMarker type) of (fetch (SubVolumeMarkerPage logical)
of markerPage)
with DFSLispVolume)
(replace (LogicalSubVolumeMarker volumeRootDirectory) of markerPage with directoryID)
(\LvPutPage vol (MarkerPageAddr vol)
markerPage)
(* * Allocate and record pages for the directory file)
(SETQ file (create FileDescriptor
fileID ← directoryID
volumeID ←(fetch (LogicalVolumeDescriptor vID) of vol)
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0))
(\DFSNewPages vol file (create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← 50))
(* * Make and put a leader page for the directory file; dlionstream created here is just a throwaway)
(\DFSMakeLeaderPage vol file dirName)
(* * Indicate done!)
(printout NIL "Created Lisp file directory {DSK}<" (fetch (LogicalVolumeDescriptor
LVlabel)
of vol)
">." T)))])
(\DFSOpenDirectory
[LAMBDA (vol) (* hts: "16-Sep-84 17:32")
(UNINTERRUPTABLY
(PROG [(stream (\OPENFILE (\DFSOpenOldFile (create DFSFileSpec
UNAME ←(\DFSUnpackName
(PACKFILENAME (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(fetch (
LogicalVolumeDescriptor LVlabel) of vol)
(QUOTE NAME)
(QUOTE DIRECTORY)
(QUOTE VERSION)
1)))
(fetch (LogicalVolumeDescriptor
volumeRootDirectory)
of vol))
(QUOTE BOTH]
(replace MAXBUFFERS of stream with 50)
(PutDirectory vol stream)
(printout NIL "Opened local file system directory {DSK}<" (fetch (
LogicalVolumeDescriptor LVlabel) of vol)
">." T)
(RETURN stream)))])
(\DFSMakeDirEntry
[LAMBDA (stream UNAME DirStream) (* edited: "18-Jul-84 14:40")
(* Makes a directory entry for a new file)
(UNINTERRUPTABLY
(PROG ((NC (LENGTH (fetch CHARPAIRS of UNAME)))
POS SIZE)
(* SIZE is how big the directory entry must be. The 10 is 1 word marker, 2 words fileID, 1 byte string length
(for filename), 1 byte !, and 1 word version number)
(SETQ SIZE (FOLDHI (IPLUS NC 10)
BYTESPERWORD))
(* * Find a place in the directory file. FindDirHole returns the position of the first word of the slot and leaves
the fileptr at the second word)
(SETQ POS (\DFSFindDirHole SIZE DirStream))
(\DWOUT DirStream (fetch (FileDescriptor fileID) of (fetch (DLIONSTREAM FILEDESC)
of stream)))
(* * This byte says # chars in filename (exclusive of ! and version #))
(\BOUT DirStream NC)
[for C in (fetch CHARPAIRS of UNAME) do (\BOUT DirStream (UCASECHAR (CAR C]
(\BOUT DirStream (CHARCODE !))
(\WOUT DirStream (fetch VERSION of UNAME))
(* * When everything is ready, finally change the type from hole to file.)
(\SETFILEPTR DirStream POS)
(\BOUT DirStream (LOGOR 4 (\PEEKBIN DirStream)))
(* * Remember where file is in directory)
(replace DIRINFO of stream with POS)
(* * Write changes to directory file out to disk and update appropriate fileinfo fields)
(FORCEOUTPUT DirStream)
(\DFSUpdateLeaderPage DirStream (QUOTE BOTH))))])
(\DFSFindDirHole
[LAMBDA (WDS DIRSTREAM) (* hts: "14-Sep-84 10:14")
(* Returns the byte address of a directory hole of size WDS. The directory file is positioned just after the 2-byte
length field of the hole.)
(PROG ((PTR (OR (fetch (DLIONSTREAM DIRHOLEPTR) of DIRSTREAM)
0))
T1 C)
NEXT(\SETFILEPTR DIRSTREAM PTR)
(COND
((\EOFP DIRSTREAM)
(GO END))
((ILESSP 3 (SETQ C (\BIN DIRSTREAM)))
(SETQ T1 (\BIN DIRSTREAM)) (* Already occupied)
)
[(IGREATERP WDS (SETQ T1 (IPLUS (LLSH C 8)
(\BIN DIRSTREAM]
(T (\SETFILEPTR DIRSTREAM PTR) (* Hole is large enough)
[COND
((IGREATERP T1 WDS) (* Too large, so break it apart.)
(SETQ T1 (IDIFFERENCE T1 WDS))
(\WOUT DIRSTREAM T1)
(\SETFILEPTR DIRSTREAM (SETQ PTR (IPLUS PTR T1 T1]
(GO END)))
(SETQ PTR (IPLUS PTR T1 T1))
(GO NEXT)
END (\WOUT DIRSTREAM WDS)
(RETURN PTR])
(\DFSReadFileID
[LAMBDA (directory position) (* hts: "17-Jul-84 20:42")
(\SETFILEPTR directory (IPLUS 2 position))
(\DWIN directory])
(\DFSRemoveDirEntry
[LAMBDA (stream dirStream) (* hts: "26-Jun-84 14:09")
(* * Change type of dir entry to hole and write changed directory pages out to disk)
(UNINTERRUPTABLY
(\SETFILEPTR dirStream (fetch (DLIONSTREAM DIRINFO) of stream))
(\BOUT dirStream (LOGAND 3 (\PEEKBIN dirStream)))
(FORCEOUTPUT dirStream))])
(\DFSDirectorySearch
[LAMBDA (STREAM TLIST HMIN) (* hts: "14-Sep-84 13:24")
(* Finds next directory entry for which TLIST::1 is a prefix of the filename. Returns NIL if no entry found, else
the length of the remaining chars in the entry. Leaves the directory positioned after the char matching the last
char of TLIST::1 -
STREAM is the ofd of the directory file -
TLIST is a list of the form (POS . CHARPAIRS), where POS at entry is a fileptr in the directory file at which to
start searching and CHARPAIRS is like the characters pairs of a uname. At exit, TLIST is smashed so that POS is the
fileptr just beyond the found entry. -
if HMIN~=NIL, sets STREAM's DIRHOLEPTR to NIL or the fileptr of the first hole of at least HMIN words.)
(PROG ((NEXT (CAR TLIST))
(CHARPAIRS (CDR TLIST))
THISNAMELENGTH TARGETLENGTH PTR L CHPAIR TYP ENTRYLENGTH CH)
(if HMIN
then (replace (DLIONSTREAM DIRHOLEPTR) of STREAM with NIL))
(SETQ TARGETLENGTH (LENGTH CHARPAIRS))
NEXT(\SETFILEPTR STREAM (SETQ PTR NEXT))
(if (EOFP STREAM)
then (RETURN))
(* * Format of a directory entry is -
Type (0 = hole, 1 = file), 6 bits -
Length of entry in words, 10 bits -
FP 2 words -
Name as a string)
(SETQ TYP (\BIN STREAM))
(SETQ ENTRYLENGTH (IPLUS (LLSH (LOGAND TYP 3)
8)
(\BIN STREAM)))
(SETQ NEXT (IPLUS (UNFOLD ENTRYLENGTH BYTESPERWORD)
PTR))
(if (NEQ 1 (LRSH TYP 2))
then (* Not a file)
(if (AND HMIN (ILEQ HMIN ENTRYLENGTH))
then (replace (DLIONSTREAM DIRHOLEPTR) of STREAM with PTR)
(SETQ HMIN NIL))
(GO NEXT))
(\SETFILEPTR STREAM (IPLUS PTR 6))
(if (ILESSP (SETQ THISNAMELENGTH (\BIN STREAM))
TARGETLENGTH)
then (GO NEXT))
(SETQ L CHARPAIRS)
READ(if (NULL L)
then (RPLACA TLIST NEXT)
(RETURN (IDIFFERENCE THISNAMELENGTH TARGETLENGTH)))
(SETQ CHPAIR (CAR L))
(SETQ CH (\BIN STREAM))
(if (OR (EQ CH (CAR CHPAIR))
(EQ CH (CADR CHPAIR)))
then (SETQ L (CDR L))
(GO READ)
else (GO NEXT])
(\DFSVersions
[LAMBDA (UNAME STREAM HMIN) (* hts: "14-Sep-84 13:27")
(* UNAME is a value of \UNPACKFILENAME. STREAM is the directory ofd. HMIN=T means look for a hole big enough for
UNAME, a number N means look for that size hole, NIL means don't look. Returns a list of (version . fileptr) pairs
sorted by increasing version. Ptr is a pointer to the beginning of the directory slot for the file.
If the UNAME had an escape which matches unambiguously, the UNAME is smashed with the completion characters.)
(PROG ([LEN1 (IPLUS 7 (LENGTH (fetch CHARPAIRS of UNAME]
(ESC (fetch ESCFLAG of UNAME))
(TLIST (CONS 0 (fetch CHARPAIRS of UNAME)))
(FIXEDVERSION (FIXP (fetch VERSION of UNAME)))
LASTBANG PTR NCHARSLEFT RESULT V END CHARLIST L1 OLDESCLIST L2)
(* 7 in LEN1 calc is 6 for 3 word block plus 1 for char
count)
(if (AND FIXEDVERSION (OR ESC (ZEROP FIXEDVERSION)))
then (SETQ FIXEDVERSION NIL))
(if (EQ HMIN T)
then (* 3 is ! plus two chars for version number)
(SETQ HMIN (FOLDHI (IPLUS LEN1 3)
BYTESPERWORD)))
S (if (NULL (SETQ NCHARSLEFT (\DFSDirectorySearch STREAM TLIST HMIN)))
then [if (AND ESC OLDESCLIST)
then (NCONC UNAME (for X in (DREVERSE OLDESCLIST) collect (CONS X]
(RETURN RESULT))
(SETQ PTR (GETFILEPTR STREAM))
(from NCHARSLEFT to 1 by -1 first (SETQ CHARLIST NIL) do (push CHARLIST (\BIN STREAM)))
(OR (EQ (\BIN STREAM)
(CHARCODE !))
(SHOULDNT (QUOTE badDirectoryEntry)))
(SETQ V (\WIN STREAM)) (* Read version number)
(if (NULL ESC)
then (if CHARLIST
then (GO NEXT)) (* Everything but version has to match exactly if there
was no Escape)
elseif (EQ ESC T)
then (* Escape, first time.)
(SETQ OLDESCLIST CHARLIST)
(SETQ ESC 0) (* 0 means ESC but not first time.
Used for ambiguity checking.)
else (* ESC is 0)
(* Make sure that the rest of the name is the same)
(OR (for (L1 ← CHARLIST) by (CDR L1) as (L2 ← OLDESCLIST) by (CDR L2)
do (if (NULL L1)
then (RETURN (NULL L2))
elseif [OR (NULL L2)
(AND (NEQ (CAR L1)
(CAR L2))
(NEQ (CAR L1)
(LOGXOR (CAR L2)
32]
then (RETURN NIL)))
(RETURN)))
(* * Name matches. V is the version number. Cons up a piece of the result. If UNAME has an explicit version, insist
on it now)
(SETQ PTR (IDIFFERENCE PTR LEN1)) (* \DFSVFMFind beginning of the directory entry)
(* \DFSVFMMerge new element into RESULT)
(if FIXEDVERSION
then (if (EQ V FIXEDVERSION)
then (RETURN (LIST (CONS V PTR)))
else (GO NEXT))
elseif (OR (NULL RESULT)
(IGREATERP (CAAR RESULT)
V))
then (SETQ RESULT (CONS (CONS V PTR)
RESULT))
(GO NEXT))
(SETQ END RESULT)
INS (while (AND (CDR END)
(IGREATERP V (CAADR END)))
do (SETQ END (CDR END)))
(RPLACD END (CONS (CONS V PTR)
(CDR END)))
NEXT(AND HMIN (fetch (DLIONSTREAM DIRHOLEPTR) of STREAM)
(SETQ HMIN NIL)) (* Stop looking if found a hole)
(GO S])
(\DFSFileSpec
[LAMBDA (NAME RECOG DIROFD) (* hts: "20-Sep-84 17:22")
(* 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.)
(Assert DIROFD)
(PROG (DP V L (UNAME (\DFSUnpackName NAME)))
[COND
((NULL UNAME) (* BAD FILE NAME)
(RETURN (create DFSFileSpec)))
([AND (SETQ L (\DFSVersions UNAME DIROFD (SELECTQ RECOG
((NEW OLD/NEW)
T)
NIL)))
(SETQ V (SELECTQ (OR (fetch VERSION of UNAME)
RECOG)
((OLD OLD/NEW)
(CAR (LAST L)))
[NEW (* A new version, so the DIRPTR is NIL)
(LIST (ADD1 (CAAR (LAST L]
(OLDEST (CAR L))
(SASSOC (fetch VERSION of UNAME)
L]
(SETQ DP (CDR V))
(SETQ V (CAR V)))
(T (SETQ DP NIL) (* Since file doesnt exist, recognition mode takes
precedence over version number)
(SETQ V (SELECTQ (OR RECOG (fetch VERSION of UNAME))
((NEW OLD/NEW)
(if (fetch ESCFLAG of UNAME)
then NIL
elseif (FIXP (fetch VERSION of UNAME))
else 1))
((OLD OLDEST)
NIL)
(FIXP (fetch VERSION of UNAME]
(* We may have to zap a version number that was
specified but not found)
(replace VERSION of UNAME with V)
(RETURN (create DFSFileSpec
UNAME ← UNAME
FSDIRPTR ← DP])
(\DFSUnpackName
[LAMBDA (NAME) (* hts: "16-Sep-84 17:25")
(* Unpacks file name into a UNAME of the form ((VERSION VOLNUM . ESCFLAG) . CHARPAIRS) where VERSION is the version
indicator (either a positive integer or one of OLD, OLDEST, NEW) PARTNUM is the logical volume number and ESCFLAG
indicates that NAME terminated in escape, and the CHARPAIRS is a list of pairs the first element of which is the
char actually specified in name, and the second is the upper/lower case alternative for alphabetics.)
(* changed to generate a file not found error in the
case that a directory is specified -
rrb.)
(PROG (J C END NEGATEDVERSION VERSION RESULT VOLNUM directoryInfo)
(if [NOT (SETQ VOLNUM (\DFSVolumeNameToNumber (CAR (SETQ directoryInfo (\DFSFirstDirectory
NAME]
then (RETURN))
(SETQ END (SETQ RESULT (create UNAME
PARTNUM ← VOLNUM)))
(* End is the cell whose CDR can be smashed.)
(SETQ J (CADDR directoryInfo))
COLLECTNAME
(COND
((NOT (SETQ C (NTHCHARCODE NAME J)))
(GO RET))
(T [RPLACD END (SETQ END (LIST (COND
[(BETWEEN C (CHARCODE A)
(CHARCODE Z))
(LIST C (IPLUS C (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
[(BETWEEN C (CHARCODE a)
(CHARCODE z))
(LIST C (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
((BETWEEN C (CHARCODE 0)
(CHARCODE 9))
(LIST C))
(T (SELCHARQ C
((; !)
(GO SEMI))
((< >)
(LIST C))
((ESCAPE *)
(replace ESCFLAG of RESULT with T)
(SETQ C (NTHCHARCODE NAME
(add J 1)))
(GO TERM))
(%.
(* Omit trailing dots)
(SELCHARQ (NTHCHARCODE NAME
(ADD1 J))
(NIL (GO RET))
((; !)
(add J 1)
(GO SEMI))
(LIST C)))
(($ + -)
(LIST C))
(GO ERR]
(add J 1)
(GO COLLECTNAME)))
SEMI[SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
((H h)
(SETQQ VERSION OLD)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
((L l)
(SETQQ VERSION OLDEST)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
((N n)
(SETQQ VERSION NEW)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
[(T t S s A a P p) (* Various Tenex crocks. Not implemented, but don't
complain about them)
(PROG NIL
SKIP(SELCHARQ (NTHCHARCODE NAME (add J 1))
((; !)
(GO SEMI))
(NIL (GO RET))
(GO SKIP]
[- (COND
(VERSION (GO ERR))
(T (SETQ NEGATEDVERSION T)
(SETQ VERSION 0)
(SETQ C (NTHCHARCODE NAME (add J 1)))
(GO COLLECTVERSION]
(NIL (GO ERR))
(COND
(VERSION (GO ERR))
(T (SETQ VERSION 0)
(GO COLLECTVERSION]
COLLECTVERSION
(COND
((AND C (BETWEEN C (CHARCODE 0)
(CHARCODE 9)))
[SETQ VERSION (IPLUS (ITIMES VERSION 10)
(IDIFFERENCE C (CHARCODE 0]
(SETQ C (NTHCHARCODE NAME (add J 1)))
(GO COLLECTVERSION)))
(COND
[NEGATEDVERSION (SETQ VERSION (SELECTQ VERSION
(1 (QUOTE NEW))
(2 (QUOTE OLDEST))
(GO ERR]
((ZEROP VERSION)
(SETQQ VERSION OLD))
((IGREATERP VERSION 65535)
(GO ERR)))
TERM(SELCHARQ C
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR))
ERR (* BAD FILE NAME)
(RETURN NIL)
RET (replace (UNAME VERSION) of RESULT with VERSION)
(RETURN RESULT])
(\DFSFullFileName
[LAMBDA (UNAME) (* hts: "16-Sep-84 16:58")
(* * Puts together a full file name (including host, directory, subdirectory, name, and version) from a uname)
(AND (fetch VERSION of UNAME)
(PACKFILENAME (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(fetch (LogicalVolumeDescriptor LVlabel) of (GetVol (fetch PARTNUM
of UNAME)))
(QUOTE NAME)
(\DFSFileName UNAME])
(\DFSFileName
[LAMBDA (uname) (* hts: "13-Sep-84 20:38")
(* * Puts together the subdirectory, filename, and version of a file from its uname)
(PACKC (NCONC (for char in (fetch CHARPAIRS of uname) collect (UCASECHAR (CAR char)))
(APPEND (if (FASSOC (CHARCODE %.)
(fetch CHARPAIRS of uname))
then (CHARCODE (;))
else (CHARCODE (%. ;)))
(CHCON (fetch VERSION of uname])
)
(DEFINEQ
(\DWIN
[LAMBDA (FILE) (* jds " 3-JAN-83 16:08")
(IPLUS (LLSH (\BIN FILE)
24)
(LLSH (\BIN FILE)
16)
(LLSH (\BIN FILE)
8)
(\BIN FILE])
(\DWOUT
[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
(\DFSGenerateFiles
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* hts: "24-Sep-84 22:45")
(* Returns a file-generator object that will generate AT LEAST all files in the sys-dir of FDEV whose names match
PATTERN. Clients might need to provide additional filtering. For M44, the generate state consists of the HOSTNAME
(DSK) followed by a "search state", a directory pointer and a character list of the sort that \SEARCHDIR1 expects.
DIRPTR is the position of the next file to be considered in the directory.)
(WITH.MONITOR \DFStopMonitor
(PROG ((DIROFD (\DFSFileNameToDirectory PATTERN))
(directoryInfo (\DFSFirstDirectory PATTERN))
HOSTNAME CHARLIST)
[OR DIROFD (RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION NILL]
[SETQ HOSTNAME (PACKFILENAME (QUOTE HOST)
(FILENAMEFIELD PATTERN (QUOTE HOST))
(QUOTE DIRECTORY)
(fetch (LogicalVolumeDescriptor LVlabel)
of (fetch (DLIONSTREAM VOLUME) of DIROFD]
(SETQ PATTERN (SUBATOM PATTERN (CADDR directoryInfo)))
[SETQ CHARLIST (for C in (UNPACK PATTERN) as I from 1
collect (SETQ C (CHCON1 C))
(COND
[(AND (IGEQ C (CHARCODE a))
(ILEQ C (CHARCODE z)))
(LIST C (IPLUS (IDIFFERENCE C (CHARCODE a))
(CHARCODE A]
[(AND (IGEQ C (CHARCODE A))
(ILEQ C (CHARCODE Z)))
(LIST C (IPLUS (IDIFFERENCE C (CHARCODE A))
(CHARCODE a]
((FMEMB C (CHARCODE (ESCAPE * ; ?)))
(* \SEARCHDIR1 currently only checks prefixes, so we truncate at the first * or escape. Also ignore version
specifications, because of the alternative representations of version 1)
(RETURN $$VAL))
([AND (EQ C (CHARCODE %.))
(FMEMB (NTHCHARCODE PATTERN (ADD1 I))
(CHARCODE (ESCAPE * ? ; NIL]
(* We don't require a dot match unless it separates a
real extension. The client must filter for various
combinations of version numbers.)
(RETURN $$VAL))
(T (LIST C]
(RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \DFSNextFileFn)
FILEINFOFN ←(FUNCTION \DFSFileInfoFn)
GENFILESTATE ←(create DFSGenerateFileState
DIROFD ← DIROFD
HOSTNAME ← HOSTNAME
SEARCHSTATE ←(create DFSDirSearchState
DIRPTR ← 0
CHARLIST ←
CHARLIST])
(\DFSNextFileFn
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* hts: "24-Sep-84 22:44")
(* GENFILESTATE is the state information from the file-generator object created by \DFSGenerateFiles This function
returns the list of character codes of the next file generated by the generator, smashing them into SCRATCHLIST.
Returns NIL if no files left. It updates GENFILESTATE so that it will get the following satisfactory file on the
next call to this function. -
If NAMEONLY returns the filenames without the semi-colon and version number)
(WITH.MONITOR \DFStopMonitor (COND
((EQ (CAR GENFILESTATE)
(QUOTE \DFSFileInfoFn)) (* Old style)
(SETQ GENFILESTATE (CDR GENFILESTATE))
(swap NAMEONLY SCRATCHLIST)))
(PROG ((DIROFD (fetch DIROFD of GENFILESTATE))
TEMP LEN GETVERSION SAWDOT SAWVERSION NAMESTART)
[COND
((SETQ TEMP (\DFSDirectorySearch DIROFD (fetch SEARCHSTATE of GENFILESTATE))
)
[SETQ TEMP (SCRATCHLIST SCRATCHLIST
[COND
((NULL NAMEONLY)
(for C in (CHCON (fetch HOSTNAME
of GENFILESTATE))
do (ADDTOSCRATCHLIST C]
[\SETFILEPTR
DIROFD
(SETQ NAMESTART
(IDIFFERENCE (GETFILEPTR DIROFD)
(SETQ LEN
(LENGTH (fetch CHARLIST
of (fetch
SEARCHSTATE
of
GENFILESTATE]
(* Read all the characters from the directory)
(for I from 1 to (IPLUS TEMP LEN 1)
do (SETQ TEMP (\BIN DIROFD))
(COND
((EQ TEMP (CHARCODE !))
(SETQ SAWVERSION T)
(COND
(NAMEONLY (RETURN)))
[COND
((NOT SAWDOT)
(ADDTOSCRATCHLIST (CHARCODE "."]
(SETQ TEMP (CHARCODE ;)))
[(AND (IGEQ TEMP (CHARCODE a))
(ILEQ TEMP (CHARCODE z)))
(SETQ TEMP (IPLUS (IDIFFERENCE
TEMP
(CHARCODE a))
(CHARCODE A]
((EQ TEMP (CHARCODE "."))
(SETQ SAWDOT T)))
(COND
((LISTP TEMP)
(for C in TEMP do (ADDTOSCRATCHLIST
C)))
(T (ADDTOSCRATCHLIST TEMP)))
finally (for C in (CHCON (\WIN DIROFD))
do (ADDTOSCRATCHLIST C)))
(COND
((AND (NOT NAMEONLY)
(NOT SAWVERSION))
(* No version found--insert ;1)
(OR SAWDOT (ADDTOSCRATCHLIST (CHARCODE %.)))
(ADDTOSCRATCHLIST (CHARCODE ;))
(ADDTOSCRATCHLIST (CHARCODE 1]
(replace GENSTREAM of GENFILESTATE with (PACKC TEMP]
(RETURN TEMP])
(\DFSFileInfoFn
[LAMBDA (GENFILESTATE ATTRIBUTE) (* hts: "24-Sep-84 23:47")
(if (NOT (type? STREAM (fetch GENSTREAM of GENFILESTATE)))
then (replace GENSTREAM of GENFILESTATE with (\DFSGetStreamForFile (fetch GENSTREAM
of GENFILESTATE)
(QUOTE OLD)
(QUOTE INPUT)))
(replace ACCESS of (fetch GENSTREAM of GENFILESTATE) with (QUOTE INPUT)))
(GETFILEINFO (fetch GENSTREAM of GENFILESTATE)
ATTRIBUTE])
)
(PUTPROPS VOLUMEDIRECTORY COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1836 23312 (\DFSMakeVolumeDirectory 1846 . 3821) (\DFSOpenDirectory 3823 . 4763) (
\DFSMakeDirEntry 4765 . 6578) (\DFSFindDirHole 6580 . 7800) (\DFSReadFileID 7802 . 7995) (
\DFSRemoveDirEntry 7997 . 8414) (\DFSDirectorySearch 8416 . 11023) (\DFSVersions 11025 . 15361) (
\DFSFileSpec 15363 . 17373) (\DFSUnpackName 17375 . 22183) (\DFSFullFileName 22185 . 22745) (
\DFSFileName 22747 . 23310)) (23313 23893 (\DWIN 23323 . 23566) (\DWOUT 23568 . 23891)) (23928 30596 (
\DFSGenerateFiles 23938 . 26796) (\DFSNextFileFn 26798 . 30011) (\DFSFileInfoFn 30013 . 30594)))))
STOP