(FILECREATED " 8-Jun-84 00:42:36" {ERIS}<LISPNEW>SOURCES>DLIONFS.;6 88088
changes to: (FNS \DFSGetVolumeInfo)
previous date: " 5-Jun-84 13:48:14" {ERIS}<LISPNEW>SOURCES>DLIONFS.;4)
(* Copyright (c) 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT DLIONFSCOMS)
(RPAQQ DLIONFSCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (COMS * DLIONFSCOMPILECOMS))
(INITRECORDS GadolKey)
(* These provide the interface between this file and VolumeFileMap)
(FNS \DFSTrimHelper \DFSFindVolumeNumber)
(* These functions transfer pages to and from the disk)
(FNS \PvTransferPage \PvTransferPageNoSwap \LvGetPage \LvPutPage \LvBasePageAddr)
[DECLARE: DONTEVAL@LOAD (P (\LOCKFN (QUOTE \PvTransferPage))
(\LOCKFN (QUOTE \PvTransferPageNoSwap))
(\LOCKVAR (QUOTE \DFSWriteFlg]
(* These functions are part of the volume file map (BTree)
%. Most of this code has been gutted and moved to the file VolumeFileMap.)
(FNS \DFSFindPageAddr)
(* The following implement the device and directory level parts of the 1108 file system.)
(FNS \DFSFindDirHole \DFSDEVICEP \DFSVOLUMEP \DFSGenFileID \DFSMakeStrPtr \DFSInit
\DFSEnsureInitialized \DFSGetVolumeInfo \DFSGetBuffer \DFSGetPvName \DFSGetLvName
\DFSGetLvNum \DFSHostNameP \DFSOpenDiskDevice \DFSCloseFile \DFSDirectoryNameP
\DFSEventFn \DFSGetFileInfo \DFSGetFileName \DFSReadPages \DFSSetFileInfo \DFSTrimFile
\DFSTruncateFile \DFSWritePages \DFSUnpackName \DFSUNAMELength \DFSZeroBuffer
\DFSMakeVolumeDirectory \DFSOpenDirectory \DFSMakeLeaderPage \DFSOpenFileFromKey
\DFSDeleteFile \DFSMakeDirEntry \DFSReadOnePage \DFSWriteOnePage \DFSCreateFile
\DFSNewPages \DFSOpenFile \DFSUpdateAccessTimes \DFSExtendFile \DFSCompleteStream
\DFSGetStreamForFile \DFSFileSpec \DFSMoveToLeader \DFSWriteLeaderPage
\DFSReadLeaderPage \DFSVersions \DFSDirectorySearch \DFSFullFileName \DFSGenerateFiles
\DFSNextFileFn \DFSFileInfoFn \DFSFreeDiskPages \DFSDsplyVolumes \DFSDeviceConflict
\DFSCoreDeviceP \DFSDFSDeviceP)
(* This function is a temporary check to make sure \DFSNewPages is doing the right thing.)
(FNS \DFSCheck \DFSCheckEntry)
(* These provide direct user interface to the file system.)
(FNS MKDIR DFSVOLUMES DFSLISPVOLUMEP VOLUMEDISPLAY MAKEPILOT SCAVENGEVOLUME CURRENTVOLUME)
(GLOBALVARS \DFSReadVolumes \DFSInitialized \DFSWriteFlg \DFSCheck)
(FILES VOLUMEFILEMAP VOLUMEALLOCATIONMAP)
(FNS \DFSAtLoad)
(P (\DFSAtLoad))))
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ DLIONFSCOMPILECOMS ((RECORDS PhysVolumeDscr SubVolumeDscr LogicalVolumeDscr)
(RECORDS FILEGENOBJ DLIONSTREAM DLIONDISK DFSUnpackedName DFSLeaderPage
DFSFileSpec DFSGenerateFileState DFSDirSearchState)
(CONSTANTS (DFSPilotVolume 0)
(DFSLispVolume 3)
(hardMicrocode 0)
(nullVolumePage 0)
(SubVolumeEntrySize 13))
(MACROS FADDR UCASECHAR BETWEEN)
(MACROS LvPagePtr SubVolumeEntryPtr LvDevicePtr LvNum LVEqual SwapIn&Dirty
MarkerPageAddr)
(* The following are for diagnostic purposes.)
(FNS DsplyPvPage DsplyLvPage DsplyPage DsplyWords ShowIntervals
DsplySubVolEntry DsplyFileStream)))
[DECLARE: EVAL@COMPILE
(BLOCKRECORD PhysVolumeDscr ((Seal WORD) (* Validation)
(Version WORD)
(NameLength WORD)
(PvID 5 WORD)
(BootingInfo 36 WORD) (* Defines 4 PILOT file types)
(Name 40 BYTE) (* Ascii name of the volume)
(SubVolCount WORD)
(SubVolMrkID 5 WORD) (* Marker pages belong to this Pseudo File)
(BadPageCount SWAPPEDFIXP)
(MaxBadPages SWAPPEDFIXP)
(OnLineCount WORD)
(SubVolumes 78 WORD) (* See SubVolumeDscr record for description of each of
six entries stored here)
(Fill1 99 WORD)
(LocalTimeParmValid WORD)
(LocalTimeParm 2 WORD)
(CheckSum WORD))
(SYSTEM))
(BLOCKRECORD SubVolumeDscr ((LvID 5 WORD) (* Logical Volume ID)
(LvSize SWAPPEDFIXP) (* Size for the complete voluem..may span packs some
day)
(LvPage SWAPPEDFIXP) (* Typically 0)
(PvPage SWAPPEDFIXP) (* Disk Address of the beginning of the volume See
LogicalVolumeDscr Record NIL)
(NPages SWAPPEDFIXP) (* Number of Pages of Volume in this Phisycal Volume)
)
(SYSTEM))
(BLOCKRECORD LogicalVolumeDscr ((Seal WORD) (* Validation)
(Version WORD)
(LvID 5 WORD) (* ID of This Volume)
(NameLength WORD) (* Length of th ASCII name of this volume)
(Name 40 BYTE) (* Volume name in AScII)
(Type WORD)
(VolumeSize SWAPPEDFIXP) (* Number of pages in this volume)
(BootingInfo 54 WORD) (* Defines 6 PILOT file types)
(TreeDepth WORD)
(Changing WORD)
(FreePageCount SWAPPEDFIXP)
(* Number of free pages remaining)
(VAMStart SWAPPEDFIXP)
(VFMStart SWAPPEDFIXP) (* Relative address of the start of the volume file map)
(LowerBound SWAPPEDFIXP)
(RootFileID 30 WORD)
(FreeSpaceID 5 WORD)
(VAMID 5 WORD)
(VFMID 5 WORD)
(VolumeRootDirectory 5 WORD)
(VolNum WORD)
(IntervalCache 96 WORD) (* One entry for each level of the B-Tree)
(Fill 6 WORD)
(VFMLowKey 7 WORD)
(CheckSum WORD))
(SYSTEM))
]
[DECLARE: EVAL@COMPILE
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
(ACCESSFNS DLIONSTREAM ((FID (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(TRANSFERKEY (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))
(LastAllocated (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE)))
(CREATE (create STREAM)))
(ACCESSFNS DLIONDISK ((VolNum (\DFSFindVolumeNumber (fetch DEVICEINFO of DATUM)))
(DirectoryStream (ELT \DirStreams (LvNum DATUM))
(SETA \DirStreams (LvNum DATUM)
NEWVALUE)))
(CREATE (create FDEV)))
(RECORD DFSUnpackedName ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS))
(BLOCKRECORD DFSLeaderPage ((TimeCreate FIXP)
(TimeWrite FIXP)
(TimeRead FIXP)
(FileKey 7 WORD)
(AllocatedPages FIXP)
(EofPage FIXP)
(EOffSet WORD)
(NameLength WORD)
(FileName 100 BYTE)
(AuthorLength WORD)
(AuthorName 30 BYTE)))
(RECORD DFSFileSpec (UNAME FSDIRPTR)
[ACCESSFNS DFSFileSpec ((DFSNAME (\DFSFullFileName (fetch UNAME of DATUM])
(RECORD DFSGenerateFileState (DIROFD HOSTNAME ENTRYSTART GENSTREAM . SEARCHSTATE))
(RECORD DFSDirSearchState (DIRPTR . CHARLIST))
]
(DECLARE: EVAL@COMPILE
(RPAQQ DFSPilotVolume 0)
(RPAQQ DFSLispVolume 3)
(RPAQQ hardMicrocode 0)
(RPAQQ nullVolumePage 0)
(RPAQQ SubVolumeEntrySize 13)
(CONSTANTS (DFSPilotVolume 0)
(DFSLispVolume 3)
(hardMicrocode 0)
(nullVolumePage 0)
(SubVolumeEntrySize 13))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS FADDR MACRO ((Parm Fld)
(LOCF (fetch Fld of Parm))))
(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: EVAL@COMPILE
(PUTPROPS LvPagePtr MACRO ((I)
(ELT \LogicalVolumes I)))
(PUTPROPS SubVolumeEntryPtr MACRO ((LVNum) (* edited: " 7-JUN-83 14:02")
(\ADDBASE (FADDR \PhysVolumePage (PhysVolumeDscr SubVolumes))
(ITIMES (SUB1 LVNum)
SubVolumeEntrySize))))
(PUTPROPS LvDevicePtr MACRO ((VolNum)
(ELT \DFSDevices VolNum)))
(PUTPROPS LvNum MACRO ((DEV)
(fetch (DLIONDISK VolNum) of DEV)))
(PUTPROPS LVEqual MACRO ((a b)
(MESAEQUAL (fetch (LogicalVolumeDescriptor vID) of a)
(fetch (LogicalVolumeDescriptor vID) of b)
ID)))
(PUTPROPS SwapIn&Dirty MACRO (OPENLAMBDA (page)
(\PUTBASE page 0 (\GETBASE page 0))))
(PUTPROPS MarkerPageAddr MACRO [(vol)
(fetch (SubVolumeDscr NPages) of (SubVolumeEntryPtr (
\DFSFindVolumeNumber vol])
)
(* The following are for diagnostic purposes.)
(DEFINEQ
(DsplyPvPage
[LAMBDA NIL (* sg: " 8-JUN-83 19:26")
(INSPECT \PhysVolumePage (QUOTE PhysVolumeDscr])
(DsplyLvPage
[LAMBDA (I) (* sg: " 8-JUN-83 19:25")
(INSPECT (LvPagePtr I)
(QUOTE LogicalVolumeDscr])
(DsplyPage
[LAMBDA (VolNum PageAddr) (* SDG "14-NOV-83 13:45")
(DsplyWords (\LvGetPage VolNum PageAddr)
256])
(DsplyWords
[LAMBDA (Start Number) (* hts: " 3-Apr-84 16:04")
(for I from 0 to (SUB1 Number)
do (PRIN1 (\GETBASE Start I))
(PRIN1 " ")
(if (ZEROP (IREMAINDER (ADD1 I)
10))
then (TERPRI)))
(TERPRI])
(ShowIntervals
[LAMBDA (vol) (* hts: " 4-Apr-84 16:20")
(bind interval for I from 0 to 5
do (printout T I ":" T "key: ")
(SETQ interval (PROG ((newCopy (create Intervals)))
(\BLT newCopy (\ADDBASE (fetch (LogicalVolumeDescriptor interval)
of vol)
(IPLUS (ITIMES (IDIFFERENCE I 0)
16)))
(MESASIZE Intervals))
(RETURN newCopy)))
(DsplyWords (fetch (Interval key) of interval)
(MESASIZE Key))
(printout T "volumePage: " (fetch (Interval volumePage) of interval)
T)
(printout T "nextKey: ")
(DsplyWords (fetch (Interval nextKey) of interval)
(MESASIZE Key])
(DsplySubVolEntry
[LAMBDA (Vol) (* edited: " 8-JUN-83 19:57")
(INSPECT (SubVolumeEntryPtr Vol)
(QUOTE SubVolumeDscr])
(DsplyFileStream
[LAMBDA (File) (* SDG "10-AUG-83 15:50")
(INSPECT (GETSTREAM File)
(QUOTE DLIONSTREAM))
(INSPECT (GETSTREAM File])
)
)
(* These provide the interface between this file and VolumeFileMap)
(DEFINEQ
(\DFSTrimHelper
[LAMBDA (volNum key targetFileSize actualFileSize) (* hts: "24-May-84 20:35")
(* 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 actualFileSize))
then (bind (group ←(create PageGroup (SETQ filePage targetFileSize)
(SETQ volumePage nullVolumePage)
(SETQ nextFilePage actualFileSize)))
(filePtr ←(create FileDescriptor (SETQ fileID (fetch (Key fileID) of key))
(SETQ volumeID (fetch (LogicalVolumeDescriptor vID)
of (LvPagePtr volNum)))
(SETQ location (QUOTE local))
(SETQ immutable NIL)
(SETQ temporary NIL)
(SETQ size actualFileSize)
(SETQ type 0)))
until (PROGN (\DFSVFMDeletePageGroup (LvPagePtr volNum)
filePtr group)
(\DFSVAMFreePageGroup (LvPagePtr volNum)
filePtr group)
(if (ZEROP (fetch (PageGroup filePage) of group))
then (replace (PageGroup nextFilePage) of group with 0)
(\DFSVFMDeletePageGroup (LvPagePtr volNum)
filePtr group)
(\DFSVAMFreePageGroup (LvPagePtr volNum)
filePtr group)
T
else (EQP (fetch (PageGroup filePage) of group)
targetFileSize)))
do (replace (FileDescriptor size) of filePtr with (fetch (PageGroup filePage)
of group))
(replace (PageGroup nextFilePage) of group with (fetch (PageGroup filePage)
of group))
(replace (PageGroup filePage) of group with targetFileSize))
(\DFSDsplyVolumes])
(\DFSFindVolumeNumber
[LAMBDA (vol) (* hts: "18-May-84 21:51")
(* vol: LogicalVolumeDescriptor;
RETURNS: FIXP in 1..6)
(* 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. Should be changed later.)
(OR [FIXP (for volNum from 1 to 6 thereis (LVEqual vol (LvPagePtr volNum]
(SHOULDNT (QUOTE cantFindLogicalVolume])
)
(* These functions transfer pages to and from the disk)
(DEFINEQ
(\PvTransferPage
[LAMBDA (absoluteDiskAddress BUFFER WRITEFLG) (* hts: "23-May-84 16:17")
(* This function modifies the IOCB that controls the Dlion rigid disk. The IOCB was originally stolen from the
booting process, and is now inherited by Lisp. It modifies the IOCB to select read/write and the sector/head
number to read/write to.)
(UNINTERRUPTABLY
(SwapIn&Dirty BUFFER)
(SETQ \DFSWriteFlg WRITEFLG) (* Call the page reading/writing routine in a special
stack environment which will not page fault on frame
extension)
(\MISCAPPLY*(FUNCTION \PvTransferPageNoSwap)
absoluteDiskAddress BUFFER) (* absoluteDiskAddress is just barely a smallp for the
Quantum; will have to worry about unboxed arith when we
go to large Trident drives)
)])
(\PvTransferPageNoSwap
[LAMBDA (absoluteDiskAddress buffer) (* hts: "11-May-84 22:56")
(* Calls \DL.XFERDISK in a special stack environment that is guaranteed not to page fault.
\DFSWriteFlg is passed as a global because \MISCAPPLY* allows only two args to be passed.)
(\DL.XFERDISK absoluteDiskAddress buffer \DFSWriteFlg])
(\LvGetPage
[LAMBDA (VolNum PageAddr Buffer) (* hts: "23-May-84 16:23")
(* Reads a page from the disk and puts the result in Buffer. The page read is the PageAddr'th page of the
VolNum'th logical volume.)
(* Steve: you should modify this routine to deal with
labels correctly. If label is non-NIL, I expect it to be
checked.)
(if (NOT (FIXP VolNum))
then (SETQ VolNum (\DFSFindVolumeNumber VolNum)))
(if (NOT Buffer)
then (SETQ Buffer (\DFSGetBuffer))) (* If Buffer does not exist, create a new one.)
(\PvTransferPage (IPLUS (\LvBasePageAddr VolNum)
PageAddr)
Buffer) (* Read the page off the disk)
Buffer])
(\LvPutPage
[LAMBDA (VolNum PageAddr PagePtr) (* hts: "20-May-84 21:29")
(* Writes the contents of PagePtr onto the disk at the
PageAddr'th page of the VolNum'th logical volume.)
(if (NOT (FIXP VolNum))
then (SETQ VolNum (\DFSFindVolumeNumber VolNum)))
(\PvTransferPage (IPLUS (\LvBasePageAddr VolNum)
PageAddr)
PagePtr T)
NIL])
(\LvBasePageAddr
[LAMBDA (LVNum) (* SDG "14-NOV-83 13:43")
(fetch (SubVolumeDscr PvPage) of (SubVolumeEntryPtr LVNum])
)
(DECLARE: DONTEVAL@LOAD
(\LOCKFN (QUOTE \PvTransferPage))
(\LOCKFN (QUOTE \PvTransferPageNoSwap))
(\LOCKVAR (QUOTE \DFSWriteFlg))
)
(* These functions are part of the volume file map (BTree) %. Most of this code has been gutted
and moved to the file VolumeFileMap.)
(DEFINEQ
(\DFSFindPageAddr
[LAMBDA (vol file filePage noCheck) (* hts: "20-May-84 21:39")
(PROG ((result (\DFSVFMGetPageGroup vol file filePage)))
(* 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)
(if (NULL (CAR result))
then (SHOULDNT (QUOTE keyNotFound)))
[if (ZEROP (fetch (PageGroup volumePage) of (CDR result)))
then (if noCheck
then (RETURN NIL)
else (SHOULDNT (QUOTE keyNotFound]
(* Gives a zero volume page iff the fileID is found, but the page specified isn't. noCheck is T only when called
to see if the file should be extended.)
(RETURN (IPLUS (fetch (PageGroup volumePage) of (CDR result))
filePage
(IMINUS (fetch (PageGroup filePage) of (CDR result])
)
(* The following implement the device and directory level parts of the 1108 file system.)
(DEFINEQ
(\DFSFindDirHole
[LAMBDA (WDS DIRSTREAM) (* hts: " 5-Jun-84 13:14")
(* Swiped wholesale from mod44io)
(* 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 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])
(\DFSDEVICEP
[LAMBDA (DirSpec) (* hts: "22-May-84 16:50")
(PROG (LvNum)
(if (NEQ (MACHINETYPE)
(QUOTE DANDELION))
then (RETURN NIL))
(\DFSEnsureInitialized)
(SETQ LvNum (\DFSGetLvNum (MKSTRING DirSpec)))
(RETURN (OR (AND LvNum (LvDevicePtr LvNum))
(AND (EQ (QUOTE DSK)
(MKATOM (U-CASE DirSpec)))
(PROGN
(* Special case for DSK (should really be handled in mod44io): if there is no logical volume for DSK, create a
coredevice for it)
(printout NIL
"Warning: There is no lisp logical volume called DSK."
T "Creating coredevice {DSK}." T
"{DSK} files will be core files."
T "They will not be part of the local file system." T)
(\GETDEVICEFROMNAME (COREDEVICE (QUOTE DSK])
(\DFSVOLUMEP
[LAMBDA (DirSpec) (* hts: "11-May-84 22:35")
(\DFSEnsureInitialized)
(\DFSGetLvNum (MKSTRING DirSpec])
(\DFSGenFileID
[LAMBDA NIL (* hts: "13-May-84 16:20")
(PROG (NewKey)
(SETQ NewKey (create Key
filePage ← 0))
(\PUTBASE NewKey 0 (CADDR \MY.NSHOSTNUMBER))
(\PUTBASE NewKey 1 (CADDDR \MY.NSHOSTNUMBER))
(\PUTBASE NewKey 2 (IMOD (CLOCK 0)
1000))
(\BLT (\ADDBASE NewKey 3)
(DAYTIME)
2)
(RETURN NewKey])
(\DFSMakeStrPtr
[LAMBDA (Addr Len) (* SDG "17-JUN-83 14:16")
(PROG ((STR "Test3"))
(\PUTBASEPTR STR 0 Addr)
(\PUTBASE STR 2 Len)
(RETURN STR])
(\DFSInit
[LAMBDA NIL (* hts: " 5-Jun-84 12:17")
(UNINTERRUPTABLY
(OR (EQ (MACHINETYPE)
(QUOTE DANDELION))
(ERROR (QUOTE attemptToRunDFSOnNon1108)))
(OR \DFSReadVolumes (\DFSGetVolumeInfo))
(\DFSVAMInit)
(\DFSVFMInit)
(SETQ \DFSDevices (ARRAY 6))
(SETQ \DirStreams (ARRAY 6))
(for volNum from 1 to (fetch (PhysVolumeDscr SubVolCount) of \PhysVolumePage)
when (EQ (fetch (LogicalVolumeDescriptor type) of (LvPagePtr volNum))
DFSLispVolume)
do (if (NOT (\DFSDeviceConflict (MKATOM (\DFSGetLvName volNum))
(QUOTE smashDFSDevice)))
then (\DFSOpenDiskDevice volNum))) (* Create a lisp file device for every logical volume
marked to be a lisp logical volume)
(SETQ \DFSMachineId \MY.NSHOSTNUMBER)
(SETQ \DFSInitialized T)
(\DFSDsplyVolumes))])
(\DFSEnsureInitialized
[LAMBDA NIL (* hts: "11-May-84 22:43")
(if (NOT (AND (BOUNDP (QUOTE \DFSInitialized))
\DFSInitialized))
then (\DFSInit])
(\DFSGetVolumeInfo
[LAMBDA NIL (* edited: " 8-Jun-84 00:35")
[if (NOT (BOUNDP \PhysVolumePage))
then (SETQ \PhysVolumePage (NCREATE (QUOTE VMEMPAGEP]
(\PvTransferPage 0 \PhysVolumePage NIL)
(if (NOT (BOUNDP (QUOTE \LogicalVolumes)))
then (SETQ \LogicalVolumes (ARRAY 6)))
(for volNum from 1 to (fetch (PhysVolumeDscr SubVolCount) of \PhysVolumePage)
do [if (NULL (ELT \LogicalVolumes volNum))
then (SETA \LogicalVolumes volNum (NCREATE (QUOTE VMEMPAGEP]
(\LvGetPage volNum 0 (ELT \LogicalVolumes volNum))
(* Cache the logical volume pages))
(SETQ \DFSReadVolumes T) (* Note that this routine has been run)
])
(\DFSGetBuffer
[LAMBDA NIL (* SDG "14-NOV-83 15:56")
(NCREATE (QUOTE VMEMPAGEP])
(\DFSGetPvName
[LAMBDA NIL (* SDG "14-NOV-83 14:41")
(\DFSMakeStrPtr (FADDR \PhysVolumePage (PhysVolumeDscr Name))
(fetch (PhysVolumeDscr NameLength) of \PhysVolumePage])
(\DFSGetLvName
[LAMBDA (VolNum) (* hts: " 2-May-84 14:59")
(U-CASE (\DFSMakeStrPtr (FADDR (LvPagePtr VolNum)
(LogicalVolumeDscr Name))
(fetch (LogicalVolumeDscr NameLength) of (LvPagePtr VolNum])
(\DFSGetLvNum
[LAMBDA (LvName) (* hts: " 3-May-84 09:08")
(SETQ LvName (U-CASE LvName))
(for I from 1 to (fetch (PhysVolumeDscr SubVolCount) of \PhysVolumePage)
do (if (STREQUAL (\DFSGetLvName I)
LvName)
then (RETURN I])
(\DFSHostNameP
[LAMBDA NIL (* SDG "30-JUN-83 15:23")
NIL])
(\DFSOpenDiskDevice
[LAMBDA (VolNum) (* hts: "17-May-84 10:51")
(UNINTERRUPTABLY
(PROG ((volumeName (MKATOM (\DFSGetLvName VolNum)))
DEV)
(SETQ DEV
(create FDEV
DEVICENAME ← volumeName
FDBINABLE ← T
FDBOUTABLE ← T
FDEXTENDABLE ← T
RESETABLE ← T
RANDOMACCESSP ← T
NODIRECTORIES ← T
PAGEMAPPED ← T
CLOSEFILE ←(FUNCTION \DFSCloseFile)
DELETEFILE ←(FUNCTION \DFSDeleteFile)
GETFILEINFO ←(FUNCTION \DFSGetFileInfo)
GETFILENAME ←(FUNCTION \DFSGetFileName)
OPENFILE ←(FUNCTION \DFSOpenFile)
READPAGES ←(FUNCTION \DFSReadPages)
SETFILEINFO ←(FUNCTION \DFSSetFileInfo)
TRUNCATEFILE ←(FUNCTION \DFSTruncateFile)
WRITEPAGES ←(FUNCTION \DFSWritePages)
REOPENFILE ←(FUNCTION \DFSOpenFile)
GENERATEFILES ←(FUNCTION \DFSGenerateFiles)
EVENTFN ←(FUNCTION \DFSEventFn)
DEVICEINFO ←(LvPagePtr VolNum)
DIRECTORYNAMEP ←(FUNCTION \DFSDirectoryNameP)
HOSTNAMEP ←(FUNCTION \DFSHostNameP)
BIN ←(FUNCTION \PAGEDBIN)
BOUT ←(FUNCTION \PAGEDBOUT)
PEEKBIN ←(FUNCTION \PAGEDPEEKBIN)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
SETFILEPTR ←(FUNCTION \PAGEDSETFILEPTR)
GETFILEPTR ←(FUNCTION \PAGEDGETFILEPTR)
GETEOFPTR ←(FUNCTION \PAGEDGETEOFPTR)
EOFP ←(FUNCTION \PAGEDEOFP)
BLOCKIN ←(FUNCTION \PAGEDBINS)
BLOCKOUT ←(FUNCTION \PAGEDBOUTS)
FLUSHOUTPUT ←(FUNCTION \PAGED.FLUSHOUTPUT)))
(SETA \DFSDevices VolNum DEV)
(if (EQ DFSLispVolume (fetch (LogicalVolumeDescriptor type) of (LvPagePtr VolNum)))
then (replace (DLIONDISK DirectoryStream) of DEV with (\DFSOpenDirectory DEV)))
(\DEFINEDEVICE volumeName DEV)
(printout NIL "Created local disk device {" volumeName "}" T)
(RETURN DEV)))])
(\DFSCloseFile
[LAMBDA (STREAM) (* hts: " 5-Jun-84 10:37")
(* Update EOF in leader page)
(UNINTERRUPTABLY
(PROG ((BUFFER (\DFSGetBuffer)))
(RELEASECPAGE STREAM)
(\CLEARMAP STREAM)
(if (NEQ (fetch ACCESS of STREAM)
(QUOTE INPUT))
then (\DFSTrimFile STREAM)
(SETQ BUFFER (\DFSReadLeaderPage STREAM BUFFER))
(replace (DFSLeaderPage EofPage) of BUFFER with (fetch (STREAM EPAGE)
of STREAM))
(replace (DFSLeaderPage EOffSet) of BUFFER with (fetch (STREAM EOFFSET)
of STREAM))
(replace (DFSLeaderPage AllocatedPages) of BUFFER
with (IPLUS (fetch (STREAM EPAGE) of STREAM)
(if (ZEROP (fetch EOFFSET of STREAM))
then 1
else 2)))
(\DFSWriteLeaderPage STREAM BUFFER))
(RETURN STREAM)))])
(\DFSDirectoryNameP
[LAMBDA (DirSpec) (* hts: " 5-Jun-84 12:13")
(UNINTERRUPTABLY
(PROG ((Volume (FILENAMEFIELD DirSpec (QUOTE HOST)))
LvNum)
(SETQ LvNum (\DFSVOLUMEP Volume))
(RETURN (if (AND LvNum (fetch DirectoryStream of (LvDevicePtr LvNum))
(\DFSUnpackName DirSpec))
then T
else NIL))))])
(\DFSEventFn
[LAMBDA (Dev Event) (* hts: " 5-Jun-84 11:57")
(UNINTERRUPTABLY
(SELECTQ Event
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(OR \DFSReadVolumes (\DFSGetVolumeInfo))
(PROG (LvNum)
(if [NOT (AND (EQUAL \DFSMachineId \MY.NSHOSTNUMBER)
[SETQ LvNum (\DFSGetLvNum (MKSTRING (fetch (FDEV DEVICENAME)
of Dev]
(EQ DFSLispVolume (fetch (LogicalVolumeDescriptor type)
of (LvPagePtr LvNum]
then (replace (FDEV REOPENFILE) of Dev with (FUNCTION NILL))
(* ensure that no local files from another machine
(or the same machine with changed logical volumes) will
be reopened)
(\REMOVEDEVICE Dev)
(printout NIL "Device {" (fetch (FDEV DEVICENAME) of Dev)
"} has disappeared." T)
(SETQ \DFSInitialized NIL)
(* Make the 1108 file system reinitialize itself)
))
(if (NOT (EQ (MACHINETYPE)
(QUOTE DANDELION)))
then (\OPENDISKDEVICE 0) (* Open mod44 disk)))
(BEFORELOGOUT (if (fetch DirectoryStream of Dev)
then (\FLUSH.OPEN.STREAMS Dev))
(SETQ \DFSReadVolumes NIL))
NIL))])
(\DFSGetFileInfo
[LAMBDA (STREAM ATTRIBUTE DEV) (* hts: " 5-Jun-84 10:41")
(* Get the value of the ATTRIBUTE for a model44 file.
If STREAM is a filename, then the file is not open.)
(UNINTERRUPTABLY
[PROG (BUFFER STREAMPASSED)
(SETQ STREAMPASSED (type? STREAM STREAM))
(RETURN (if [OR STREAMPASSED (SETQ STREAM (\DFSGetStreamForFile STREAM (QUOTE OLD)
(QUOTE INPUT)
DEV NIL (\DFSGetBuffer]
then (SETQ BUFFER (\DFSGetBuffer))
(if (NEQ ATTRIBUTE (QUOTE LENGTH))
then (\LvGetPage (fetch (DLIONDISK VolNum) of DEV)
(\DFSFindPageAddr
(fetch (FDEV DEVICEINFO) of DEV)
(create FileDescriptor
fileID ←(fetch (Key fileID)
of (fetch (DLIONSTREAM
FID)
of STREAM))
volumeID ←(fetch (
LogicalVolumeDescriptor vID) of (fetch (FDEV DEVICEINFO) of DEV))
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0)
0)
BUFFER))
(SELECTQ
ATTRIBUTE
(LENGTH (if (NOT STREAMPASSED)
then (SETQ STREAM (\DFSCompleteStream STREAM BUFFER))
else (\UPDATEOF STREAM))
(IPLUS (fetch (STREAM EOFFSET) of STREAM)
(ITIMES (fetch (STREAM EPAGE) of STREAM)
512)))
(WRITEDATE (GDATE (fetch (DFSLeaderPage TimeWrite) of BUFFER)))
(READDATE (GDATE (fetch (DFSLeaderPage TimeRead) of BUFFER)))
(CREATIONDATE (GDATE (fetch (DFSLeaderPage TimeCreate) of BUFFER)))
(IWRITEDATE (fetch (DFSLeaderPage TimeWrite) of BUFFER))
(IREADDATE (fetch (DFSLeaderPage TimeRead) of BUFFER))
(ICREATIONDATE (fetch (DFSLeaderPage TimeCreate) of BUFFER))
[AUTHOR (PROG ((AuthorStart (FADDR BUFFER (DFSLeaderPage AuthorName))
)
(AuthorLength (fetch (DFSLeaderPage AuthorLength)
of BUFFER)))
(RETURN (if (IGREATERP AuthorLength 0)
then [PACK (for I from 0
to (SUB1 AuthorLength)
collect (CHARACTER
(\GETBASEBYTE
AuthorStart I]
else (QUOTE ????]
NIL])])
(\DFSGetFileName
[LAMBDA (FileName Recog Dev) (* hts: " 5-Jun-84 10:42")
(UNINTERRUPTABLY
(fetch DFSNAME of (\DFSFileSpec FileName Recog (fetch DirectoryStream of Dev))))])
(\DFSReadPages
[LAMBDA (Stream FirstPage Buffers) (* hts: " 5-Jun-84 11:53")
(UNINTERRUPTABLY
(for Buffer inside Buffers as Page from FirstPage sum (\DFSReadOnePage Stream Page Buffer)))])
(\DFSSetFileInfo
[LAMBDA (Stream Attribute Value Device) (* hts: " 5-Jun-84 11:54")
(UNINTERRUPTABLY
[PROG ((BUFFER (\DFSGetBuffer))
STREAMPASSED)
(SETQ STREAMPASSED (type? STREAM Stream))
(RETURN (COND
((OR STREAMPASSED (SETQ Stream (\DFSGetStreamForFile Stream (QUOTE OLD)
(QUOTE INPUT)
Device NIL BUFFER)))
(\DFSReadLeaderPage Stream BUFFER)
(SELECTQ Attribute
(CREATIONDATE (replace (DFSLeaderPage TimeCreate) of BUFFER
with (IDATE Value)))
(ICREATIONDATE (replace (DFSLeaderPage TimeCreate) of BUFFER
with Value))
[AUTHOR (PROG ((AuthorStart (FADDR BUFFER (DFSLeaderPage
AuthorName)))
(Value (CHCON Value))
AuthorLength)
(SETQ AuthorLength (LENGTH Value))
(replace (DFSLeaderPage AuthorLength) of BUFFER
with AuthorLength)
(for I from 0 to (SUB1 AuthorLength) as C
in Value do (\PUTBASEBYTE AuthorStart I C]
(SETQ Value NIL))
(\DFSWriteLeaderPage Stream BUFFER)
Value])])
(\DFSTrimFile
[LAMBDA (Stream actualPages) (* hts: "24-May-84 20:33")
(PROG ((Buffer (\DFSGetBuffer))
(DEV (fetch DEVICE of Stream))
VolNum Key desiredPages actualPages)
(FLUSHMAP Stream)
(SETQ VolNum (fetch (DLIONDISK VolNum) of DEV))
(SETQ Key (fetch FID of Stream))
(SETQ desiredPages (IPLUS (fetch EPAGE of Stream)
(if (ZEROP (fetch EOFFSET of Stream))
then 1
else 2)))
(SETQ actualPages (fetch (DLIONSTREAM LastAllocated) of Stream))
(\DFSTrimHelper VolNum Key desiredPages actualPages)
(* \DFSTrimHelper will take the requisite pages out of the BTree. desiredPages is the desired number of pages in
the file, and actualPages is the number of pages actually in the file.)
(RETURN Stream])
(\DFSTruncateFile
[LAMBDA (STREAM LP EP UpdateNow) (* SDG "29-JUN-83 13:00")
NIL])
(\DFSWritePages
[LAMBDA (Stream FirstPage Buffers) (* hts: " 5-Jun-84 13:41")
(UNINTERRUPTABLY
(for Buffer inside Buffers as Page from FirstPage do (\DFSWriteOnePage Stream Page Buffer)))])
(\DFSUnpackName
[LAMBDA (NAME) (* edited: "10-Jan-84 17:28")
(* Unpacks file name into a DFSUnpackedName 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)
(COND
([OR (NOT NAME)
(EQ NAME T)
(NEQ (NTHCHARCODE NAME 1)
(CHARCODE {))
(NOT (SETQ J (STRPOS "}" NAME)))
(NOT (SETQ VOLNUM (\DFSGetLvNum (SUBSTRING NAME 2 (SUB1 J]
(RETURN)))
(SETQ END (SETQ RESULT (create DFSUnpackedName
PARTNUM ← VOLNUM)))
(* End is the cell whose CDR can be smashed.)
(add J 1)
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 VERSION of RESULT with VERSION)
(RETURN RESULT])
(\DFSUNAMELength
[LAMBDA (UNAME) (* edited: "16-SEP-83 14:59")
(LENGTH (fetch CHARPAIRS of UNAME])
(\DFSZeroBuffer
[LAMBDA (Buffer) (* SDG " 5-AUG-83 20:27")
(for I from 0 to 255 do (\PUTBASE Buffer I 0])
(\DFSMakeVolumeDirectory
[LAMBDA (dev) (* hts: "15-May-84 20:07")
(PROG ((vol (LvPagePtr (LvNum dev)))
(key (\DFSGenFileID))
(buffer (\DFSGetBuffer))
[dirName (\DFSUnpackName (PACK* (QUOTE {)
(fetch DEVICENAME of dev)
(QUOTE })
(QUOTE DIRECTORY;1]
file)
[SETQ dirName (\DFSUnpackName (PACK* (QUOTE {)
(fetch DEVICENAME of dev)
(QUOTE })
(QUOTE DIRECTORY;1]
(SETQ file (create FileDescriptor
fileID ←(fetch (Key fileID) of key)
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))
(UNINTERRUPTABLY
(SETQ buffer (\DFSMakeLeaderPage dirName key 20 buffer))
(\LvPutPage vol (fetch (PageGroup volumePage) of (CDR (\DFSVFMGetPageGroup vol file 0)))
buffer)) (* Make and put a leader page for the directory file)
(UNINTERRUPTABLY
(MESASETQ (fetch (LogicalVolumeDescriptor volumeRootDirectory) of vol)
(fetch (Key fileID) of key)
ID)
(\LvPutPage vol 0 vol)) (* Record the ID of the directory file)
(UNINTERRUPTABLY
(replace (DLIONDISK DirectoryStream) of dev with (\DFSOpenDirectory dev)))
(printout NIL "Created directory for device {" (fetch DEVICENAME of dev)
"}" T)
(RETURN key])
(\DFSOpenDirectory
[LAMBDA (dev) (* hts: "15-May-84 20:07")
(UNINTERRUPTABLY
(PROG (DirStream DirKey)
[SETQ DirKey (create Key
fileID ←(fetch (LogicalVolumeDescriptor volumeRootDirectory)
of (fetch DEVICEINFO of dev]
(SETQ DirStream (\DFSOpenFileFromKey dev (\DFSUnpackName (PACK* (QUOTE {)
(fetch DEVICENAME
of dev)
(QUOTE })
(QUOTE DIRECTORY.;1)))
(QUOTE BOTH)
NIL DirKey (\DFSGetBuffer)))
(SETQ DirStream (\OPENFILE DirStream (QUOTE BOTH)))
[replace MAXBUFFERS of DirStream with (IMAX 20 (ADD1 (fetch EPAGE of DirStream]
(RETURN DirStream)))])
(\DFSMakeLeaderPage
[LAMBDA (Name Key Pages LeaderPage Info) (* hts: "16-May-84 10:20")
(PROG ([CurrentTime (IDATE (CADR (FASSOC (QUOTE CREATIONDATE)
Info]
[Author (CHCON (OR (CADR (FASSOC (QUOTE AUTHOR)
Info))
(USERNAME]
AuthorStart LeaderNameStart)
(SETQ LeaderPage (OR LeaderPage (\DFSGetBuffer)))
(\DFSZeroBuffer LeaderPage)
(SETQ AuthorStart (LOCF (fetch (DFSLeaderPage AuthorName) of LeaderPage)))
(SETQ LeaderNameStart (ITIMES (IDIFFERENCE [CDR (LOC (LOCF (fetch (DFSLeaderPage FileName)
of LeaderPage]
(CDR (LOC LeaderPage)))
2))
(replace TimeCreate of LeaderPage with CurrentTime)
(replace TimeWrite of LeaderPage with CurrentTime)
(\BLT (FADDR LeaderPage (DFSLeaderPage FileKey))
Key 7)
(replace (DFSLeaderPage AllocatedPages) of LeaderPage with Pages)
(replace (DFSLeaderPage EofPage) of LeaderPage with 0)
(replace (DFSLeaderPage EOffSet) of LeaderPage with 0)
(replace (DFSLeaderPage NameLength) of LeaderPage with (\DFSMoveToLeader Name LeaderPage
LeaderNameStart))
(replace (DFSLeaderPage AuthorLength) of LeaderPage with (LENGTH Author))
(for I from 0 to (SUB1 (fetch (DFSLeaderPage AuthorLength) of LeaderPage)) as C
in Author do (\PUTBASEBYTE AuthorStart I C))
(RETURN LeaderPage])
(\DFSOpenFileFromKey
[LAMBDA (Dev Name Access DirInfo Key Buffer) (* hts: "11-May-84 16:21")
(PROG (STREAM)
(if (NULL Key)
then (RETURN))
(SETQ STREAM (create DLIONSTREAM))
(replace FULLFILENAME of STREAM with (\DFSFullFileName Name))
(replace DEVICE of STREAM with Dev)
(replace FID of STREAM with Key)
(replace TRANSFERKEY of STREAM with (create Key
fileID ←(fetch FID of STREAM)))
(replace DIRINFO of STREAM with (OR DirInfo -1))
(\DFSCompleteStream STREAM Buffer)
(RETURN STREAM])
(\DFSDeleteFile
[LAMBDA (FileName Dev) (* hts: " 5-Jun-84 10:40")
(UNINTERRUPTABLY
(PROG ((Buffer (\DFSGetBuffer))
(VolNum (fetch VolNum of Dev))
Stream DirStream Key actualPages)
(SETQ Stream (\DFSGetStreamForFile FileName (QUOTE OLDEST)
(QUOTE BOTH)
Dev NIL Buffer NIL))
(if (OR (NOT Stream)
(bind (NAME ←(fetch FULLFILENAME of Stream)) find ST in \OPENFILES
suchthat (EQ (fetch FULLFILENAME of ST)
NAME)))
then (RETURN))
(SETQ Key (fetch FID of Stream))
(SETQ actualPages (fetch (DLIONSTREAM LastAllocated) of Stream))
(\DFSTrimHelper VolNum Key 0 actualPages) (* Take the entire file out of the BTree and out of the
allocation map)
(SETQ DirStream (fetch DirectoryStream of Dev))
(\SETFILEPTR DirStream (fetch (DLIONSTREAM DIRINFO) of Stream))
(\BOUT DirStream (LOGAND 3 (\PEEKBIN DirStream)))
(FLUSHMAP DirStream)
(replace FID of Stream with NIL)
(replace (DLIONSTREAM TRANSFERKEY) of Stream with NIL)
(RETURN (fetch FULLFILENAME of Stream))))])
(\DFSMakeDirEntry
[LAMBDA (FID UNAME FDEV) (* hts: " 5-Jun-84 13:14")
(* Makes a directory entry for a new file)
(UNINTERRUPTABLY
(PROG ((DirStream (fetch (DLIONDISK DirectoryStream) of FDEV))
(NC (\DFSUNAMELength UNAME))
POS SIZE LeaderPage)
(SETQ SIZE (FOLDHI (IPLUS NC 16)
BYTESPERWORD))
(* The 16 is 1 word marker, 5 words fileID, 1 byte string length (for filename), 1 byte !, and 1 word version
number)
(SETQ POS (\DFSFindDirHole SIZE DirStream))
(for I from 0 to 4 do (\WOUT DirStream (\GETBASE FID I)))
(\BOUT DirStream NC) (* This byte says # chars in filename
(exclusive of ! and version #))
[for C in (fetch CHARPAIRS of UNAME) do (\BOUT DirStream (UCASECHAR (CAR C]
(\BOUT DirStream (CHARCODE !))
(\WOUT DirStream (fetch VERSION of UNAME))
(\SETFILEPTR DirStream POS)
(\BOUT DirStream (LOGOR 4 (\PEEKBIN DirStream)))
(* When everything is ready, finally change the type
from hole to file.)
(FLUSHMAP DirStream)
(SETQ LeaderPage (\DFSReadLeaderPage DirStream (\DFSGetBuffer)))
(replace EofPage of LeaderPage with (fetch EPAGE of DirStream))
(replace EOffSet of LeaderPage with (fetch EOFFSET of DirStream))
(\DFSWriteLeaderPage DirStream LeaderPage)
(RETURN POS)))])
(\DFSReadOnePage
[LAMBDA (Stream Page Buffer) (* hts: "20-May-84 21:13")
(PROG ((VolNum (LvNum (fetch (STREAM DEVICE) of Stream)))
(Key (fetch TRANSFERKEY of Stream)))
(if (OR (ILESSP Page (fetch EPAGE of Stream))
(AND (EQUAL Page (fetch EPAGE of Stream))
(IGREATERP (fetch EOFFSET of Stream)
0)))
then (\LvGetPage VolNum (\DFSFindPageAddr (LvPagePtr VolNum)
(create FileDescriptor
fileID ←(fetch (Key fileID)
of Key)
volumeID ←(fetch (
LogicalVolumeDescriptor vID) of (LvPagePtr VolNum))
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0)
(ADD1 Page))
Buffer)
(BLOCK)
(RETURN 256)
else (\DFSZeroBuffer Buffer)
(BLOCK)
(RETURN 0])
(\DFSWriteOnePage
[LAMBDA (Stream Page Buffer) (* hts: "20-May-84 21:52")
(PROG ((vol (fetch (FDEV DEVICEINFO) of (fetch (STREAM DEVICE) of Stream)))
(Key (fetch TRANSFERKEY of Stream))
filePtr volumePage)
(SETQ Page (ADD1 Page))
(SETQ filePtr (create FileDescriptor
fileID ←(fetch (Key fileID) of Key)
volumeID ←(fetch (LogicalVolumeDescriptor vID) of vol)
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0))
(SETQ volumePage (\DFSFindPageAddr vol filePtr Page T))
(if (NULL volumePage)
then (* if this page is beyond the last allocated page of the
file, extend the file another chunk)
(\DFSExtendFile Stream Page Key)
(SETQ volumePage (\DFSFindPageAddr vol filePtr Page T)))
(\LvPutPage vol volumePage Buffer)
(BLOCK])
(\DFSCreateFile
[LAMBDA (fileName dev buffer pages info) (* hts: "15-May-84 19:58")
(PROG ((vol (LvPagePtr (LvNum dev)))
(key (\DFSGenFileID))
(initialAlloc (OR pages 64))
buffer file) (* Why the fuck is buffer here as well as an arg??? Why
is buffer passed in at all??)
[if (NLISTP fileName)
then (SETQ fileName (fetch UNAME of (\DFSFileSpec fileName (QUOTE NEW)
(fetch DirectoryStream of dev]
(SETQ file (create FileDescriptor
fileID ←(fetch (Key fileID) of key)
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 ← initialAlloc))
(UNINTERRUPTABLY
(SETQ buffer (\DFSMakeLeaderPage fileName key initialAlloc buffer info))
(\LvPutPage vol (fetch (PageGroup volumePage) of (CDR (\DFSVFMGetPageGroup vol file 0)))
buffer)) (* Create leader page for the new file and put it)
(\DFSMakeDirEntry key fileName dev) (* Enter the new file in the directory)
(RETURN key])
(\DFSNewPages
[LAMBDA (vol file group) (* hts: "18-May-84 23:57")
(* Attempts to allocate needed pages for file.
Returns a list of intervals allocated.
Interval represented as dotted pair
(startPage . #ofPages))
(PROG ((lastPageAllocated (fetch (PageGroup filePage) of group))
currentGroup)
(until (EQP lastPageAllocated (fetch (PageGroup nextFilePage) of group))
do (SETQ currentGroup (create PageGroup
filePage ← lastPageAllocated
volumePage ← 0
nextFilePage ←(fetch (PageGroup nextFilePage)
of group)))
(\DFSVAMAllocPageGroup vol file currentGroup)
(* Allocate as many pages of the desired group as
possible)
(\DFSVFMInsertPageGroup vol file currentGroup)
(* Stick the newly allocated group into the volume file
map BTree)
(if \DFSCheck
then (\DFSCheck vol file currentGroup))
(SETQ lastPageAllocated (fetch (PageGroup nextFilePage) of currentGroup)))
(\DFSDsplyVolumes])
(\DFSOpenFile
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hts: " 5-Jun-84 11:40")
(* Open a Model44 file. Gets the physical end of file
and sets up ofd)
(UNINTERRUPTABLY
(PROG ([PAGESTIMATE (AND (NEQ ACCESS (QUOTE INPUT))
(for X in OTHERINFO when (EQ (CAR (LISTP X))
(QUOTE LENGTH))
do (RETURN (ADD1 (FOLDHI (CADR X)
BYTESPERPAGE]
(BUFFER (\DFSGetBuffer))
STREAM)
(OR (SETQ STREAM (if (NOT (type? STREAM NAME))
then (\DFSGetStreamForFile NAME RECOG ACCESS FDEV
(AND (NEQ ACCESS (QUOTE INPUT))
(OR PAGESTIMATE T))
BUFFER NIL PAGESTIMATE OTHERINFO)
else (\DFSCompleteStream NAME BUFFER)))
(RETURN NIL))
(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)))
(* Leader page is read in during STREAM initialization)
(if (AND (NOT OLDSTREAM)
(NOT (FMEMB (QUOTE DON'T.CHANGE.DATE)
OTHERINFO)))
then (\DFSUpdateAccessTimes STREAM ACCESS BUFFER)
(* For REOPENFILE op, don't change dates)
(* Resets validation)
(* We write out accumulated changes to leader page)
)
(\DFSWriteLeaderPage STREAM BUFFER)
(RETURN STREAM)))])
(\DFSUpdateAccessTimes
[LAMBDA (STREAM ACCESS BUF) (* edited: "10-Jan-84 17:21")
(* The leader page of STREAM has been read into buffer. Set the "last read" and/or "last written" times in the BUF
according to access, which is assumed to be either INPUT, OUTPUT, BOTH, or APPEND.)
(PROG ((DT (DAYTIME)))
(\DFSReadLeaderPage STREAM BUF)
(SELECTQ ACCESS
((OUTPUT BOTH APPEND)
(replace TimeWrite of BUF with DT))
NIL)
(SELECTQ ACCESS
((INPUT BOTH)
(replace TimeRead of BUF with DT))
NIL])
(\DFSExtendFile
[LAMBDA (stream page key) (* hts: "15-May-84 20:11")
(PROG [[vol (LvPagePtr (fetch VolNum of (fetch DEVICE of stream]
(leader (\DFSReadLeaderPage stream (\DFSGetBuffer)))
(allocate (MAX 64 (IDIFFERENCE page (fetch LastAllocated of stream]
(\DFSNewPages vol (create FileDescriptor
fileID ←(fetch (Key fileID) of key)
volumeID ←(fetch (LogicalVolumeDescriptor vID) of vol)
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0)
(create PageGroup
filePage ←(fetch LastAllocated of stream)
volumePage ← 0
nextFilePage ←(IPLUS (fetch LastAllocated of stream)
allocate)))
(UNINTERRUPTABLY
(add (fetch AllocatedPages of leader)
allocate)
(replace EofPage of leader with page)
(replace LastAllocated of stream with (fetch AllocatedPages of leader))
(\DFSWriteLeaderPage stream leader)) (* Fix up leader page and stream)
])
(\DFSCompleteStream
[LAMBDA (STREAM SCRBUFF) (* hts: "13-May-84 13:42")
(* Completes the fields of a file handle that describes an existing file by reading in its leader page which it
leaves for its caller)
(PROG ((Leader (\DFSReadLeaderPage STREAM SCRBUFF)))
(* Get the page number and the number of bytes on the last page of the file specified by fHandle.
If the last page number hint is wrong in the leader page, then find the real last page and change the hint.)
(* UPDATEVALIDATION STREAM BUF)
(* Validation is low order bits of creation and write
dates)
(replace LastAllocated of STREAM with (fetch AllocatedPages of Leader))
(replace EPAGE of STREAM with (fetch EofPage of Leader))
(replace EOFFSET of STREAM with (fetch EOffSet of Leader)))
STREAM])
(\DFSGetStreamForFile
[LAMBDA (NAME RECOG ACCESS FDEV CREATEFLG SCRBUFF FAST PAGES OTHERINFO)
(* hts: "12-May-84 00:35")
(* Creates a STREAM for dsk file NAME, creating it if necessary when CREATEFLG is true. SCRBUFF is a scratch
buffer for manipluating the leader page. If FAST is true, does not fill in any fields of STREAM that would require
reading the file, e.g., the length and full map)
(PROG ((DIROFD (fetch (DLIONDISK DirectoryStream) of FDEV))
FS STREAM FileKey)
(SETQ FS (\DFSFileSpec NAME RECOG (fetch DirectoryStream of FDEV)))
(RETURN (if (NULL DIROFD)
then (* Non-existent device)
NIL
elseif (for OpenFile in \OPENFILES thereis (EQUAL (fetch DFSNAME of FS)
(fetch FULLNAME of OpenFile)))
elseif (fetch FSDIRPTR of FS)
then (\SETFILEPTR DIROFD (IPLUS 2 (fetch FSDIRPTR of FS)))
(SETQ STREAM (create DLIONSTREAM))
(SETQ FileKey (create Key))
(for I from 0 to 4 do (\PUTBASE FileKey I (\WIN DIROFD)))
(replace FULLFILENAME of STREAM with (fetch DFSNAME of FS))
(replace DEVICE of STREAM with FDEV)
(replace FID of STREAM with FileKey)
(replace TRANSFERKEY of STREAM with (create Key
fileID ←(fetch FID
of STREAM)))
(replace DIRINFO of STREAM with (fetch FSDIRPTR of FS))
(\DFSCompleteStream STREAM SCRBUFF)
STREAM
elseif (NULL (CAR (fetch VERSION of FS)))
then NIL
elseif (IGREATERP (CAR (fetch VERSION of FS))
MAX.SMALLP)
then (ERROR "Version number limit is 65535 on 1108 File System")
elseif CREATEFLG
then (SETQ FileKey (\DFSCreateFile (fetch UNAME of FS)
FDEV SCRBUFF PAGES OTHERINFO))
(\DFSOpenFileFromKey FDEV (fetch UNAME of FS)
ACCESS NIL FileKey SCRBUFF])
(\DFSFileSpec
[LAMBDA (NAME RECOG DIROFD) (* hts: "14-May-84 09:45")
(* 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 (DP V L (UNAME (\DFSUnpackName NAME)))
[if (NULL DIROFD)
then (printout NIL "No LISP directory on volume " (\DFSGetLvName (fetch PARTNUM
of UNAME))
T)
(RETURN (create DFSFileSpec
UNAME ← NIL))
elseif (NULL UNAME)
then (* BAD FILE NAME)
(RETURN (create DFSFileSpec
UNAME ← NIL))
elseif [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]
then (SETQ DP (CDR V))
(SETQ V (CAR V))
else (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])
(\DFSMoveToLeader
[LAMBDA (UNAME SCRBUFF StartPos) (* SDG "10-AUG-83 23:21")
(for POS from StartPos as C in (fetch CHARPAIRS of UNAME) do (\PUTBASEBYTE SCRBUFF POS
(UCASECHAR
(CAR C)))
finally [COND
((OR (CDR (fetch VERSION of UNAME))
(NEQ (CAR (fetch VERSION of UNAME))
(CHARCODE 1)))
(\PUTBASEBYTE SCRBUFF POS (CHARCODE !))
(for old POS from (ADD1 POS) as C in (fetch VERSION of UNAME)
do (\PUTBASEBYTE SCRBUFF POS C]
(\PUTBASEBYTE SCRBUFF POS (CHARCODE %.))
(OR (EVENP (add POS 1)
BYTESPERWORD)
(\PUTBASEBYTE SCRBUFF POS 0)) (* Fill out the last word)
(RETURN (IDIFFERENCE POS StartPos])
(\DFSWriteLeaderPage
[LAMBDA (Stream Buffer) (* hts: "20-May-84 21:29")
(PROG ((vol (fetch (FDEV DEVICEINFO) of (fetch DEVICE of Stream)))
(Key (fetch FID of Stream)))
(\LvPutPage vol (\DFSFindPageAddr vol (create FileDescriptor
fileID ←(fetch (Key fileID) of Key)
volumeID ←(fetch (LogicalVolumeDescriptor
vID)
of vol)
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0)
0)
Buffer])
(\DFSReadLeaderPage
[LAMBDA (Stream Buffer) (* hts: "20-May-84 21:30")
(PROG ((vol (fetch (FDEV DEVICEINFO) of (fetch DEVICE of Stream)))
(Key (fetch FID of Stream)))
(RETURN (\LvGetPage vol (\DFSFindPageAddr vol (create FileDescriptor
fileID ←(fetch (Key fileID)
of Key)
volumeID ←(fetch (
LogicalVolumeDescriptor vID) of vol)
location ←(QUOTE local)
immutable ← NIL
temporary ← NIL
type ← 0)
0)
Buffer])
(\DFSVersions
[LAMBDA (UNAME STREAM HMIN) (* hts: "23-Apr-84 18:46")
(* 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 13 (\DFSUNAMELength 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)
(* 13 in LEN1 calc is 12 for 6 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 DIRHOLEPTR of STREAM)
(SETQ HMIN NIL)) (* Stop looking if found a hole)
(GO S])
(\DFSDirectorySearch
[LAMBDA (STREAM TLIST HMIN) (* hts: "23-Apr-84 18:46")
(* 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 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 5 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 DIRHOLEPTR of STREAM with PTR)
(SETQ HMIN NIL))
(GO NEXT))
(\SETFILEPTR STREAM (IPLUS PTR 12))
(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])
(\DFSFullFileName
[LAMBDA (UNAME) (* SDG "14-NOV-83 16:11")
(PROGN (* Produces a Lisp style file-name of the form
"name.[ext];ver")
(AND (fetch VERSION of UNAME)
(PACK* (COND
((fetch PARTNUM of UNAME)
(PACK* "{" (\DFSGetLvName (fetch PARTNUM of UNAME))
"}"))
(T (SHOULDNT)))
(PACKC (NCONC (for X in (fetch CHARPAIRS of UNAME) collect
(UCASECHAR (CAR X)))
(APPEND [COND
((FASSOC (CHARCODE %.)
(fetch CHARPAIRS of UNAME))
(CHARCODE (;)))
(T (CHARCODE (%. ;]
(CHCON (fetch VERSION of UNAME])
(\DFSGenerateFiles
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* hts: " 5-Jun-84 11:56")
(* 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.)
(UNINTERRUPTABLY
[PROG ((DIROFD (fetch DirectoryStream of FDEV))
[HOSTNAME (U-CASE (FILENAMEFIELD PATTERN (QUOTE HOST]
[DIRECTORY (U-CASE (FILENAMEFIELD PATTERN (QUOTE DIRECTORY]
CHARLIST)
[OR DIROFD (RETURN (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION NILL]
(SETQ PATTERN (PACKFILENAME (QUOTE HOST)
NIL
(QUOTE BODY)
PATTERN))
[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
GENSTREAM ← DESIREDPROPS
SEARCHSTATE ←(create DFSDirSearchState
DIRPTR ← 0
CHARLIST ← CHARLIST])])
(\DFSNextFileFn
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* bvm: " 6-May-84 22:47")
(* 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 NOVERSION, returns the filenames without the semi-colon and version number)
(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 (\SEARCHDIR1 DIROFD (fetch SEARCHSTATE of GENFILESTATE)))
[SETQ TEMP (SCRATCHLIST SCRATCHLIST [COND
((NULL NAMEONLY)
(ADDTOSCRATCHLIST (CHARCODE {))
(for C in (CHCON (fetch HOSTNAME of GENFILESTATE))
do (ADDTOSCRATCHLIST C))
(ADDTOSCRATCHLIST (CHARCODE }]
[\SETFILEPTR DIROFD
(SETQ NAMESTART
(IDIFFERENCE (GETFILEPTR DIROFD)
(SETQ LEN
(LENGTH (fetch CHARLIST
of (fetch SEARCHSTATE
of GENFILESTATE]
(COND
(NIL (replace ENTRYSTART of GENFILESTATE
with (IDIFFERENCE NAMESTART 13))
(replace DIRINFO of (fetch GENSTREAM of GENFILESTATE)
with NIL)))
(* 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]
(COND
((fetch GENSTREAM of GENFILESTATE) (* Temporary for \DFSFileInfoFn)
(replace ENTRYSTART of GENFILESTATE with (PACKC TEMP]
(RETURN TEMP])
(\DFSFileInfoFn
[LAMBDA (GENFILESTATE ATTRIBUTE) (* bvm: " 6-May-84 22:36")
(GETFILEINFO (fetch GENSTREAM of GENFILESTATE)
ATTRIBUTE])
(\DFSFreeDiskPages
[LAMBDA (volName recompute) (* hts: "22-May-84 10:17")
(PROG ((volNum (\DFSGetLvNum (MKSTRING volName)))
vol)
(if (NULL volNum)
then (ERROR (CONCAT "Volume " volName " not on local disk")))
(SETQ vol (LvPagePtr volNum))
(if recompute
then (\DFSVAMRecomputeFreePageCount vol)
(\DFSDsplyVolumes))
(RETURN (fetch (LogicalVolumeDscr FreePageCount) of vol])
(\DFSDsplyVolumes
[LAMBDA NIL (* hts: "23-May-84 09:08")
(PROG NIL
(if (NOT \DFSDISPLAY)
then (RETURN NIL)
elseif (NULL \VolumeDsplyWindow)
then (SETQ \VolumeDsplyWindow (CREATEW (create REGION
WIDTH ← 290
HEIGHT ←(IPLUS
45
(ITIMES 15 (fetch (PhysVolumeDscr
SubVolCount)
of \PhysVolumePage)))
LEFT ← 100
BOTTOM ← 50)
"1108 InterLisp File System"))
[WINDOWPROP \VolumeDsplyWindow (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(SETQ \DFSDISPLAY NIL]
(WINDOWPROP \VolumeDsplyWindow (QUOTE RESHAPEFN)
(QUOTE DON'T))
else (CLEARW \VolumeDsplyWindow))
(printout \VolumeDsplyWindow # (DSPFONT \DFSfixedFont \VolumeDsplyWindow)
"Physical Volume: " # (DSPFONT \DFSfixedBold \VolumeDsplyWindow)
(\DFSGetPvName)
#
(DSPFONT \DFSfixedFont \VolumeDsplyWindow)
T "Logical Volumes:" T)
(for I from 1 to (fetch (PhysVolumeDscr SubVolCount) of \PhysVolumePage)
do (printout \VolumeDsplyWindow # (DSPFONT \DFSfixedFont \VolumeDsplyWindow)
(if (EQ (fetch (LogicalVolumeDscr Type) of (LvPagePtr I))
DFSLispVolume)
then "* "
else " ")
I " " # (DSPFONT \DFSfixedBold \VolumeDsplyWindow)
(\DFSGetLvName I)
" " # (DSPFONT \DFSfixedFont \VolumeDsplyWindow)
.FR 18 (fetch (LogicalVolumeDscr VolumeSize) of (LvPagePtr I))
" Pages" .FR 31 (fetch (LogicalVolumeDscr FreePageCount)
of (LvPagePtr I))
" Free" .FONT DEFAULTFONT T])
(\DFSDeviceConflict
[LAMBDA (deviceName smashDFSDevice) (* hts: "21-May-84 19:59")
(* Resolves device name conflicts appropriately before
creating DlionFS device)
(PROG ((deviceEntry (FASSOC deviceName \DEVICENAMETODEVICE))
newDeviceName device (conflictingDevice NIL))
(SETQ device (CDR deviceEntry))
(if device
then (if (\DFSCoreDeviceP device)
then (SETQ conflictingDevice "coredevice"))
(if (AND (NOT smashDFSDevice)
(\DFSDFSDeviceP device))
then (SETQ conflictingDevice "local file device"))
(if conflictingDevice
then (printout NIL "{" deviceName "} is already a " conflictingDevice "." T
"Do you wish to smash it? ")
(if (EQ (QUOTE N)
(ASKUSER))
then (RETURN T)))
(printout NIL "Supplanted old device {" deviceName "}" T)
(RETURN NIL])
(\DFSCoreDeviceP
[LAMBDA (dev) (* hts: "11-May-84 21:48")
(* Returns NIL iff dev is not a coredevice.
There probably is a better way to do this.)
(EQ (FUNCTION \CORE.CLOSEFILE)
(fetch (FDEV CLOSEFILE) of dev])
(\DFSDFSDeviceP
[LAMBDA (dev) (* hts: "11-May-84 21:51")
(* Returns NIL iff dev is not a DLIONFS device.)
(EQ (FUNCTION \DFSCloseFile)
(fetch (FDEV CLOSEFILE) of dev])
)
(* This function is a temporary check to make sure \DFSNewPages is doing the right thing.)
(DEFINEQ
(\DFSCheck
[LAMBDA (vol file group) (* hts: "19-May-84 00:06")
(* First check to make sure all the pages in the
interval have been allocated.)
(OR [for page from (fetch (PageGroup volumePage) of group)
to [IPLUS (fetch (PageGroup volumePage) of group)
(SUB1 (IDIFFERENCE (fetch (PageGroup nextFilePage) of group)
(fetch (PageGroup filePage) of group]
never (ZEROP (\DFSVAMUpdateVAM vol NIL page (QUOTE read]
(SHOULDNT (QUOTE wrongPageAllocated))) (* Then invalidate interval cache)
(\DFSCheckEntry (\DFSVFMGetPageGroup vol file 0))
(\DFSCheckEntry (\DFSVFMGetPageGroup vol file (fetch (PageGroup filePage) of group)))
(\DFSCheckEntry (\DFSVFMGetPageGroup vol file 0))
(\DFSCheckEntry (\DFSVFMGetPageGroup vol file (SUB1 (fetch (PageGroup nextFilePage) of group])
(\DFSCheckEntry
[LAMBDA (foundGroup) (* hts: "18-May-84 23:56")
(OR [AND (CAR foundGroup)
(NEQ 0 (fetch (PageGroup volumePage) of (CDR foundGroup]
(SHOULDNT (QUOTE missingPagesInBTree])
)
(* These provide direct user interface to the file system.)
(DEFINEQ
(MKDIR
[LAMBDA (VolName) (* hts: " 5-Jun-84 10:23")
(PROG ((volNum (\DFSVOLUMEP VolName))
vol markerPage) (* \DFSVOLUMEP returns the volume number associated with
VolName, it there is such)
(if (NULL volNum)
then (ERROR (CONCAT "Volume " VolName " not on local disk")))
(SETQ vol (LvPagePtr volNum))
(if (\DFSDeviceConflict VolName)
then (RETURN NIL)
else (UNINTERRUPTABLY
(replace (LogicalVolumeDescriptor type) of vol with DFSPilotVolume)
(\DFSVFMInitMap vol)
(\DFSOpenDiskDevice volNum)
(\DFSMakeVolumeDirectory (LvDevicePtr volNum))
(replace (LogicalVolumeDescriptor type) of vol with DFSLispVolume)
(\LvPutPage vol 0 vol)
(SETQ markerPage (\LvGetPage vol (MarkerPageAddr vol)))
(replace (LogicalSubVolumeMarker type) of (fetch (SubVolumeMarkerPage logical)
of markerPage)
with DFSLispVolume)
(replace (LogicalSubVolumeMarker volumeRootDirectory) of markerPage
with (fetch (LogicalVolumeDescriptor volumeRootDirectory) of vol))
(* This should be of (fetch (SubVolumeMarkerPage logical) of markerPage) rather than of markerPage, but can't be
because of a bug in dtdeclare not fixed in lispnew.)
(\LvPutPage vol (MarkerPageAddr vol)
markerPage)
(\DFSDsplyVolumes))
(RETURN VolName])
(DFSVOLUMES
[LAMBDA NIL (* hts: " 5-Jun-84 12:18")
(SELECTQ (MACHINETYPE)
[DANDELION (UNINTERRUPTABLY
(\DFSEnsureInitialized)
(for I from 1 to (fetch SubVolCount of \PhysVolumePage)
collect (MKATOM (\DFSGetLvName I))))]
NIL])
(DFSLISPVOLUMEP
[LAMBDA (VOL) (* hts: " 5-Jun-84 12:19")
(SELECTQ (MACHINETYPE)
[DANDELION (UNINTERRUPTABLY
[PROG ((volNum (\DFSVOLUMEP VOL)))
(RETURN (AND volNum (LvDevicePtr volNum])]
NIL])
(VOLUMEDISPLAY
[LAMBDA (NewState) (* hts: " 5-Jun-84 12:19")
(* If newState = OFF, turns volume display window off; if ON, turns it on; if anything else, doesn't do anything.
Returns old state (oneof {ON, OFF}))
(UNINTERRUPTABLY
(\DFSEnsureInitialized)
(PROG [(oldState (SELECTQ \DFSDISPLAY
(T (QUOTE ON))
(NIL (QUOTE OFF))
(SHOULDNT]
(SELECTQ NewState
(ON (if \VolumeDsplyWindow
then (CLOSEW \VolumeDsplyWindow))
(* If there already was a volume display window, shut it
(which will set \DFSDISPLAY to NIL.))
(SETQ \DFSDISPLAY T)
(\DFSDsplyVolumes))
(OFF (if \VolumeDsplyWindow
then (CLOSEW \VolumeDsplyWindow)))
NIL)
(RETURN oldState)))])
(MAKEPILOT
[LAMBDA (VOL) (* hts: "21-May-84 17:58")
(PROG [(volNum (\DFSVOLUMEP VOL))
vol
(device (CDR (FASSOC VOL \DEVICENAMETODEVICE]
(if (NOT volNum)
then (ERROR (CONCAT VOL " is not a local disk volume")))
(UNINTERRUPTABLY
(SETQ vol (LvPagePtr volNum))
(replace (LogicalVolumeDescriptor type) of vol with DFSPilotVolume)
(\LvPutPage vol 0 vol)
(\DFSDsplyVolumes)
(if device
then (\REMOVEDEVICE device)
(SETA \DFSDevices volNum NIL)))])
(SCAVENGEVOLUME
[LAMBDA (VOL) (* hts: "23-May-84 10:35")
(* VOL: atom (which is a lisp logical volume name))
(* 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)
(PROG ((volNum (\DFSVOLUMEP VOL))
vol device (oldDirectoryID (create ID)))
(if (NOT (DFSLISPVOLUMEP VOL))
then (ERROR (CONCAT VOL " is not a lisp local disk volume")))
(UNINTERRUPTABLY
(SETQ vol (LvPagePtr volNum))
(SETQ device (LvDevicePtr volNum))
(MESASETQ oldDirectoryID (fetch (LogicalVolumeDescriptor volumeRootDirectory)
of vol)
ID)
(\DFSMakeVolumeDirectory device) (* Create a fresh directory)
[for fileID in (\DFSVFMGenerateFileIDs vol)
do (COND
((MESAEQUAL fileID (fetch (LogicalVolumeDescriptor volumeRootDirectory)
of vol)
ID) (* fileID is the ID of the directory we just created;
don't make a directory entry for it)
)
((MESAEQUAL fileID oldDirectoryID ID)
(\DFSTrimHelper volNum (create Key
fileID ← fileID)
0 50)
(* fileID is the ID of the old (smashed) directory; chop it out of the BTree and don't make a directory entry for
it)
)
(T (\DFSMakeDirEntry fileID (fetch UNAME
of (\DFSFileSpec (PACKFILENAME
(QUOTE HOST)
(fetch (FDEV DEVICENAME)
of device)
(QUOTE NAME)
(GENSYM))
(QUOTE NEW)
(fetch DirectoryStream
of device)))
device) (* Enter this fileID into the directory with a gensym
filename)
])])
(CURRENTVOLUME
[LAMBDA NIL (* hts: " 5-Jun-84 12:22")
(UNINTERRUPTABLY
(\DFSEnsureInitialized)
[MKATOM (\DFSGetLvName (for volNum to 6 thereis (EQP (fetch (DiskFileID da)
of (FMESAELT (fetch (
PhysicalVolumeDescriptor bootingInfo) of \PhysVolumePage)
PVBootFiles
hardMicrocode))
(fetch (DiskFileID da)
of (FMESAELT (fetch (
LogicalVolumeDescriptor bootingInfo) of (LvPagePtr volNum))
LVBootFiles
hardMicrocode])])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \DFSReadVolumes \DFSInitialized \DFSWriteFlg \DFSCheck)
)
(FILESLOAD VOLUMEFILEMAP VOLUMEALLOCATIONMAP)
(DEFINEQ
(\DFSAtLoad
[LAMBDA NIL (* hts: " 5-Jun-84 12:16")
(UNINTERRUPTABLY
(SETQ \DFSfixedFont (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(SETQ \DFSfixedBold (FONTCREATE (QUOTE GACHA)
10
(QUOTE BRR)))
(SETQ \VolumeDsplyWindow)
(SETQ \DFSDISPLAY)
(SETQ \DFSReadVolumes)
(SETQ \DFSCheck)
(if (EQ (MACHINETYPE)
(QUOTE DANDELION))
then (\DFSEnsureInitialized)))])
)
(\DFSAtLoad)
(PUTPROPS DLIONFS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8838 10833 (DsplyPvPage 8848 . 9008) (DsplyLvPage 9010 . 9177) (DsplyPage 9179 . 9345)
(DsplyWords 9347 . 9647) (ShowIntervals 9649 . 10446) (DsplySubVolEntry 10448 . 10630) (
DsplyFileStream 10632 . 10831)) (10912 13342 (\DFSTrimHelper 10922 . 12735) (\DFSFindVolumeNumber
12737 . 13340)) (13407 16306 (\PvTransferPage 13417 . 14351) (\PvTransferPageNoSwap 14353 . 14737) (
\LvGetPage 14739 . 15625) (\LvPutPage 15627 . 16119) (\LvBasePageAddr 16121 . 16304)) (16583 17556 (
\DFSFindPageAddr 16593 . 17554)) (17655 79384 (\DFSFindDirHole 17665 . 18858) (\DFSDEVICEP 18860 .
19754) (\DFSVOLUMEP 19756 . 19938) (\DFSGenFileID 19940 . 20383) (\DFSMakeStrPtr 20385 . 20611) (
\DFSInit 20613 . 21554) (\DFSEnsureInitialized 21556 . 21777) (\DFSGetVolumeInfo 21779 . 22645) (
\DFSGetBuffer 22647 . 22788) (\DFSGetPvName 22790 . 23039) (\DFSGetLvName 23041 . 23318) (\DFSGetLvNum
23320 . 23653) (\DFSHostNameP 23655 . 23774) (\DFSOpenDiskDevice 23776 . 25595) (\DFSCloseFile 25597
. 26650) (\DFSDirectoryNameP 26652 . 27076) (\DFSEventFn 27078 . 28529) (\DFSGetFileInfo 28531 .
31010) (\DFSGetFileName 31012 . 31256) (\DFSReadPages 31258 . 31516) (\DFSSetFileInfo 31518 . 32733) (
\DFSTrimFile 32735 . 33666) (\DFSTruncateFile 33668 . 33790) (\DFSWritePages 33792 . 34051) (
\DFSUnpackName 34053 . 38422) (\DFSUNAMELength 38424 . 38587) (\DFSZeroBuffer 38589 . 38766) (
\DFSMakeVolumeDirectory 38768 . 40536) (\DFSOpenDirectory 40538 . 41338) (\DFSMakeLeaderPage 41340 .
42937) (\DFSOpenFileFromKey 42939 . 43652) (\DFSDeleteFile 43654 . 44952) (\DFSMakeDirEntry 44954 .
46644) (\DFSReadOnePage 46646 . 47564) (\DFSWriteOnePage 47566 . 48584) (\DFSCreateFile 48586 . 49998)
(\DFSNewPages 50000 . 51341) (\DFSOpenFile 51343 . 53139) (\DFSUpdateAccessTimes 53141 . 53786) (
\DFSExtendFile 53788 . 54962) (\DFSCompleteStream 54964 . 56062) (\DFSGetStreamForFile 56064 . 58281)
(\DFSFileSpec 58283 . 60437) (\DFSMoveToLeader 60439 . 61272) (\DFSWriteLeaderPage 61274 . 61870) (
\DFSReadLeaderPage 61872 . 62471) (\DFSVersions 62473 . 66459) (\DFSDirectorySearch 66461 . 68850) (
\DFSFullFileName 68852 . 69636) (\DFSGenerateFiles 69638 . 72091) (\DFSNextFileFn 72093 . 75208) (
\DFSFileInfoFn 75210 . 75395) (\DFSFreeDiskPages 75397 . 75908) (\DFSDsplyVolumes 75910 . 77686) (
\DFSDeviceConflict 77688 . 78720) (\DFSCoreDeviceP 78722 . 79080) (\DFSDFSDeviceP 79082 . 79382)) (
79484 80777 (\DFSCheck 79494 . 80521) (\DFSCheckEntry 80523 . 80775)) (80846 87353 (MKDIR 80856 .
82458) (DFSVOLUMES 82460 . 82835) (DFSLISPVOLUMEP 82837 . 83144) (VOLUMEDISPLAY 83146 . 84062) (
MAKEPILOT 84064 . 84692) (SCAVENGEVOLUME 84694 . 86728) (CURRENTVOLUME 86730 . 87351)) (87514 87992 (
\DFSAtLoad 87524 . 87990)))))
STOP