(FILECREATED "30-Oct-84 14:23:01" {ERIS}<STANSBURY>HARMONYDFS>DLIONFS.;1 68257
changes to: (FNS \DFSGetStreamForFile)
(VARS DLIONFSCOMS)
previous date: "11-Oct-84 13:57:25" {ERIS}<LISP>HARMONY>SOURCES>DLIONFS.;8)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DLIONFSCOMS)
(RPAQQ DLIONFSCOMS ((DECLARE: EVAL@COMPILE DONTCOPY (COMS * DLIONFSCOMPILECOMS))
(DECLARE: (LOCALVARS . T))
(INITRECORDS PageGroup)
(* * Public entry)
(FNS DFSCREATEDIRECTORY DFSPURGEDIRECTORY VOLUMES VOLUMETYPE \DFSVolumeType)
(FNS \DFSCurrentVolume \DFSCurrentVol \DFSLispVolumeP \DFSGetLVPage)
(* * Initialization routines)
(FNS \DFSDEVICEP \DFSEnsureDlion \DFSEnsureInitialized \DFSInit
\DFSPhysicalVolumeOK \DFSCreateDevice \DFSDeviceConflict)
(GLOBALVARS \DFSInitialized \DFSdevice \PhysVolumePage \DFStopMonitor)
[INITVARS (\DFSInitialized NIL)
\DFSdevice
(\DFStopMonitor (CREATE.MONITORLOCK (QUOTE topMonitor]
(P (ADDTOVAR \SYSTEMCACHEVARS \DFSInitialized))
(FNS \DFSAtLoad)
(P (\DFSAtLoad))
(* * Device methods)
(FNS \DFSOpenFile \DFSGetStreamForFile \DFSOpenOldFile \DFSGenFileID
\DFSCreateFile \DFSNewPages \DFSMakeLeaderPage \DFSUpdateLeaderPage
\DFSWriteLeaderPage \DFSFindPageAddr)
(FNS \DFSCloseFile \DFSTrimHelper)
(FNS \DFSDeleteFile)
(FNS \DFSReadPages \DFSReadOnePage)
(FNS \DFSWritePages \DFSWriteOnePage \DFSExtendFile)
(FNS \DFSGetFileInfo)
(FNS \DFSSetFileInfo)
(FNS \DFSGetFileName)
(FNS \DFSEventFn)
(FNS \DFSFreeDiskPages)
(FNS \DFSDirectoryNameP)
(FNS \DFSHostNameP)
(* * Routines for mapping file names onto volumes and directories)
(FNS \DFSFileNameToDirectory \DFSVolumeNameToNumber \DFSFirstDirectory)
(* * These functions transfer pages to and from the disk)
(FNS \PvTransferPage \PvTransferPageNoSwap \LvGetPage \LvPutPage)
[DECLARE: DONTEVAL@LOAD (P (\LOCKFN (QUOTE \PvTransferPage))
(\LOCKFN (QUOTE \PvTransferPageNoSwap))
(\LOCKVAR (QUOTE \DFSWriteFlg]
(GLOBALVARS \DFSWriteFlg \DFSioMonitor)
[INITVARS (\DFSioMonitor (CREATE.MONITORLOCK (QUOTE ioMonitor]
(* * Display stuff)
(FNS VOLUMEDISPLAY \DFSDsplyVolumes \DFSDsplyVolumes.REPAINTFN)
(GLOBALVARS \DFSDISPLAY \DFSfixedFont \DFSfixedBold)
(INITVARS (\DFSfixedFont (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(\DFSfixedBold (FONTCREATE (QUOTE GACHA)
10
(QUOTE BRR)))
\DFSDISPLAY)
(* * Load other file system modules)
(FILES VOLUMEDIRECTORY VOLUMEFILEMAP VOLUMEALLOCATIONMAP)))
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ DLIONFSCOMPILECOMS ((* * File system constants. maxPagesPerFile = 2↑23 - 1)
(CONSTANTS (tUnassigned 0)
(tPhysicalVolumeRootPage 1)
(tSubVolumeMarkerPage 4)
(tLogicalVolumeRootPage 5)
(tFreePage 6)
(tVolumeAllocationMap 7)
(tVolumeFileMap 8)
(tRootDirectory 18)
(maxPagesPerFile 8388607)
(lastPageNumber (SUB1 maxPagesPerFile))
(nullVolumePage 0)
(maxLogicalVolumes 10))
(CONSTANTS (DFSPilotVolume 0)
(DFSLispVolume 3))
(CONSTANTS (hardMicrocode 0))
(* * File system datatypes)
(RECORDS Page)
(FILES MESATYPES)
(RECORDS FileID VolumeID Key Interval PageGroup FileDescriptor DiskFileID LVBootFiles
RootFileArray LogicalVolumeDescriptor PVBootFiles SubVolumeDesc SubVolumeArray
PhysicalVolumeDescriptor LogicalSubVolumeMarker SubVolumeMarkerPage Label)
(MACROS Vfm FetchAtom ReplaceAtom)
(RECORDS DLIONSTREAM DLIONDISK COREDEVICE LeaderPage)
(RECORDS UNAME DFSFileSpec)
(* * Macros for page reading &writing, etc.)
(MACROS LVEqual VolumeNumber SwapIn&Dirty LvBasePageAddr MarkerPageAddr DiskError)
(* * Interface to logical volumes, devices, directories)
(MACROS CreateVols InitializeVols GetVols GetVol CreateDirectories PutDirectory GetDirectory)
(GLOBALVARS \DFSLogicalVolumes \DFSdirectories)
(* * Assertion mechanism)
(VARS Assert)
(MACROS Assert)
(* * The following are for diagnostic purposes.)
(FNS DISPLAYPAGE DISPLAYWORDS ShowIntervals REL)))
(* * File system constants. maxPagesPerFile = 2↑23 - 1)
(DECLARE: EVAL@COMPILE
(RPAQQ tUnassigned 0)
(RPAQQ tPhysicalVolumeRootPage 1)
(RPAQQ tSubVolumeMarkerPage 4)
(RPAQQ tLogicalVolumeRootPage 5)
(RPAQQ tFreePage 6)
(RPAQQ tVolumeAllocationMap 7)
(RPAQQ tVolumeFileMap 8)
(RPAQQ tRootDirectory 18)
(RPAQQ maxPagesPerFile 8388607)
(RPAQ lastPageNumber (SUB1 maxPagesPerFile))
(RPAQQ nullVolumePage 0)
(RPAQQ maxLogicalVolumes 10)
(CONSTANTS (tUnassigned 0)
(tPhysicalVolumeRootPage 1)
(tSubVolumeMarkerPage 4)
(tLogicalVolumeRootPage 5)
(tFreePage 6)
(tVolumeAllocationMap 7)
(tVolumeFileMap 8)
(tRootDirectory 18)
(maxPagesPerFile 8388607)
(lastPageNumber (SUB1 maxPagesPerFile))
(nullVolumePage 0)
(maxLogicalVolumes 10))
)
(DECLARE: EVAL@COMPILE
(RPAQQ DFSPilotVolume 0)
(RPAQQ DFSLispVolume 3)
(CONSTANTS (DFSPilotVolume 0)
(DFSLispVolume 3))
)
(DECLARE: EVAL@COMPILE
(RPAQQ hardMicrocode 0)
(CONSTANTS (hardMicrocode 0))
)
(* * File system datatypes)
[DECLARE: EVAL@COMPILE
(RECORD Page NIL (CREATE (NCREATE (QUOTE VMEMPAGEP)))
(TYPE? (TYPENAMEP DATUM (QUOTE VMEMPAGEP))))
]
(FILESLOAD MESATYPES)
[DECLARE: EVAL@COMPILE
(MESATYPE FileID (2 WORD))
(MESATYPE VolumeID (5 WORD))
(MESARECORD Key ((fileID SWAPPEDFIXP)
(filePage SWAPPEDFIXP)))
(MESARECORD Interval ((key Key)
(volumePage SWAPPEDFIXP)
(nextKey Key)))
(DATATYPE PageGroup ((filePage SWAPPEDFIXP)
(volumePage SWAPPEDFIXP)
(nextFilePage SWAPPEDFIXP)))
(MESARECORD FileDescriptor ((fileID SWAPPEDFIXP)
(volumeID VolumeID)
(type WORD)
location immutable temporary (size SWAPPEDFIXP)))
(MESARECORD DiskFileID ((fID VolumeID)
(firstPage SWAPPEDFIXP)
(da SWAPPEDFIXP)) (* Booting information)
)
(MESAARRAY LVBootFiles ((0 5))
DiskFileID (* Booting information)
)
(MESAARRAY RootFileArray ((6 14))
FileID)
(MESARECORD LogicalVolumeDescriptor ((seal WORD) (* Validation ; absolutely must be first field)
(version WORD) (* must be 2nd field)
(vID VolumeID) (* ID of This Volume)
(labelLength WORD) (* Length of th ASCII name of this volume)
(label 40 BYTE) (* Volume name in AScII)
(type WORD)
(volumeSize SWAPPEDFIXP)
(* Number of pages in this volume)
(bootingInfo LVBootFiles)
(* Defines 6 PILOT file types)
(NIL WORD)
(NIL BITS 15)
(changing FLAG) (* Change field decls from here on only)
(* boolean ← T)
(freePageCount SWAPPEDFIXP)
(* Number of free pages remaining)
(vamStart SWAPPEDFIXP)
(vfmStart SWAPPEDFIXP)
(* Relative address of the start of the volume file
map)
(lowerBound SWAPPEDFIXP)
(volumeRootDirectory SWAPPEDFIXP)
(rootFileID RootFileArray)
(lastIDAllocated SWAPPEDFIXP)
(* Highest numbered File.ID given out on this volume. We reserve the first set of IDs for Pilot's own use.
In particular, files of type IN PilotRootFileType may have their ID the same as their File.Type.)
(scavengerLogVolume VolumeID)
(lastTimeOpendForWrite SWAPPEDFIXP)
(NIL 131 WORD)
(checksum WORD) (* Must be the last field)
)
(ACCESSFNS (LVlabel (FetchAtom (LOCF (fetch (
LogicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
LogicalVolumeDescriptor labelLength) of DATUM)))
(ReplaceAtom (LOCF (fetch (
LogicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
LogicalVolumeDescriptor labelLength) of DATUM))
40 NEWVALUE)))
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
(MESAARRAY PVBootFiles ((0 3))
DiskFileID)
(MESARECORD SubVolumeDesc ((lvID VolumeID)
(lvSize SWAPPEDFIXP)
(lvPage SWAPPEDFIXP)
(pvPage SWAPPEDFIXP)
(nPages SWAPPEDFIXP)))
(MESAARRAY SubVolumeArray ((0 9))
SubVolumeDesc)
(MESARECORD PhysicalVolumeDescriptor ((seal WORD) (* Validation)
(version WORD)
(labelLength WORD)
(pvID VolumeID)
(bootingInfo PVBootFiles)
(* Defines 4 PILOT file types)
(label 40 BYTE) (* Ascii name of the volume)
(subVolumeCount WORD)
(subVolumeMarkerID VolumeID)
(* Marker pages belong to this Pseudo File)
(badPageCount SWAPPEDFIXP)
(maxBadPages SWAPPEDFIXP)
(onLineCount WORD)
(subVolumes SubVolumeArray)
(* See SubVolumeDesc record for description of each of
six entries stored here)
(NIL 47 WORD)
(localTimeParametersValid WORD)
(localTimeParameters 2 WORD)
(checksum WORD))
(ACCESSFNS (PVlabel (FetchAtom (LOCF (fetch (
PhysicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
PhysicalVolumeDescriptor labelLength) of DATUM)))
(ReplaceAtom (LOCF (fetch (
PhysicalVolumeDescriptor label) of DATUM))
(LOCF (fetch (
PhysicalVolumeDescriptor labelLength) of DATUM))
40 NEWVALUE)))
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
(MESARECORD LogicalSubVolumeMarker ((seal WORD)
(version WORD)
(labelLength BITS 6)
(type BITS 2)
(NIL BITS 8)
(label 20 WORD)
(bootingInfo LVBootFiles)
(volumeRootDirectory SWAPPEDFIXP)))
(MESARECORD SubVolumeMarkerPage ((logical LogicalSubVolumeMarker)
(* Incomplete)
)
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
(MESARECORD Label ((fileID VolumeID) (* valid in label of every page)
(filePageLo WORD)
(filePageHi BITS 7) (* 23 bit page number, valid in label of every page)
(NIL BITS 6) (* always zero)
(immutable FLAG) (* valid only in label of page 0)
(temporary FLAG) (* valid only in label of page 0)
(zeroSize FLAG) (* valid only in label of page 0)
(type WORD) (* valid in label of every page)
bootChainLink (* valid in label of every page)
)
(ACCESSFNS (filePage (\MAKENUMBER (fetch (Label filePageHi) of DATUM)
(fetch (Label filePageLo) of DATUM))
(PROGN (replace (Label filePageHi) of DATUM
with (\HINUM NEWVALUE))
(replace (Label filePageLo) of DATUM
with (\LONUM NEWVALUE))
NEWVALUE))))
]
(/DECLAREDATATYPE (QUOTE PageGroup)
(QUOTE (SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP)))
(DECLARE: EVAL@COMPILE
(PUTPROPS Vfm MACRO ((vol)
(PROGN
(* * Returns the file ID of the volume file map)
(* * I think (not sure for Klamath) the way it's supposed to do this is to look up the tVolumeFileMap'th element of
the RootFileArray of the volume. But that doesn't work right now because of a bug in Mesatypes.
Won't matter till we write labels)
tVolumeFileMap)))
(PUTPROPS FetchAtom MACRO [(start length)
(U-CASE (PACKC (for pos from 0 to (SUB1 (\GETBASE length 0))
collect (\GETBASEBYTE start pos])
(PUTPROPS ReplaceAtom MACRO [LAMBDA (startLoc lengthLoc maxLength newAtom)
(PROG ((chars (CHCON (MKATOM newAtom)))
length)
(SETQ length (MIN (LENGTH chars)
maxLength))
(* * Output characters)
(for char in chars as pos from 0 to (SUB1 length)
do (\PUTBASEBYTE startLoc pos char))
(* * Output length of atom)
(\PUTBASE lengthLoc 0 length))
newAtom])
)
[DECLARE: EVAL@COMPILE
(RECORD DLIONSTREAM STREAM (SUBRECORD STREAM)
[ACCESSFNS ((FILEDESC (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(LEADERPAGE (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(VOLUME (fetch F3 of DATUM)
(replace F3 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]
[TYPE? (AND (type? STREAM DATUM)
(type? LogicalVolumeDescriptor (fetch (DLIONSTREAM VOLUME)
of DATUM])
(RECORD DLIONDISK FDEV (SUBRECORD FDEV)
[TYPE? (AND (type? FDEV DATUM)
(EQ (fetch (FDEV CLOSEFILE) of DATUM)
(QUOTE \DFSCloseFile])
(RECORD COREDEVICE NIL [TYPE? (AND (type? FDEV DATUM)
(EQ (FUNCTION \CORE.CLOSEFILE)
(fetch (FDEV CLOSEFILE) of DATUM])
(MESARECORD LeaderPage ((TimeCreate FIXP)
(TimeWrite FIXP)
(TimeRead FIXP)
(FileID SWAPPEDFIXP)
(AllocatedPages FIXP)
(EofPage FIXP)
(EOffSet WORD)
(NameLength WORD)
(FileName 100 BYTE)
(AuthorLength WORD)
(AuthorName 30 BYTE))
(ACCESSFNS (fileName (FetchAtom (LOCF (fetch (LeaderPage FileName)
of DATUM))
(LOCF (fetch (LeaderPage NameLength)
of DATUM)))
(ReplaceAtom (LOCF (fetch (LeaderPage FileName)
of DATUM))
(LOCF (fetch (LeaderPage NameLength)
of DATUM))
100 NEWVALUE)))
(ACCESSFNS (author (FetchAtom (LOCF (fetch (LeaderPage AuthorName)
of DATUM))
(LOCF (fetch (LeaderPage AuthorLength)
of DATUM)))
(ReplaceAtom (LOCF (fetch (LeaderPage AuthorName)
of DATUM))
(LOCF (fetch (LeaderPage AuthorLength)
of DATUM))
30 NEWVALUE)))
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
]
[DECLARE: EVAL@COMPILE
(RECORD UNAME ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS))
(RECORD DFSFileSpec (UNAME FSDIRPTR))
]
(* * Macros for page reading &writing, etc.)
(DECLARE: EVAL@COMPILE
(PUTPROPS LVEqual MACRO ((a b)
(MESAEQUAL (fetch (LogicalVolumeDescriptor vID) of a)
(fetch (LogicalVolumeDescriptor vID) of b)
VolumeID)))
(PUTPROPS VolumeNumber MACRO [(vol) (* hts: "28-May-84 20:19")
(* 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 (for otherVol in (GetVols) as volumeNumber from 0
do (if (LVEqual vol otherVol)
then (RETURN volumeNumber)))
(SHOULDNT (QUOTE cantFindLogicalVolume])
(PUTPROPS SwapIn&Dirty MACRO (OPENLAMBDA (page)
(\PUTBASE page 0 (\GETBASE page 0))))
(PUTPROPS LvBasePageAddr MACRO ((vol)
(fetch (SubVolumeDesc pvPage) of (FMESAELT (fetch (
PhysicalVolumeDescriptor subVolumes) of \PhysVolumePage)
SubVolumeArray vol))))
(PUTPROPS MarkerPageAddr MACRO [(vol)
(fetch (SubVolumeDesc nPages) of (FMESAELT (fetch (
PhysicalVolumeDescriptor subVolumes) of \PhysVolumePage)
SubVolumeArray
(OR (FIXP vol)
(VolumeNumber vol])
(PUTPROPS DiskError MACRO ((errorMessage errorMessage2)
(PROG ((\INTERRUPTABLE T))
(* * Gross hack to allow the error to show up as a break rather than a 9318)
(LISPERROR errorMessage errorMessage2))))
)
(* * Interface to logical volumes, devices, directories)
(DECLARE: EVAL@COMPILE
(PUTPROPS CreateVols MACRO [NIL (if [NOT (AND (BOUNDP (QUOTE \DFSLogicalVolumes))
(type? ARRAYP \DFSLogicalVolumes)
(ZEROP (ARRAYORIG \DFSLogicalVolumes))
(EQ maxLogicalVolumes (ARRAYSIZE \DFSLogicalVolumes]
then (SETQ \DFSLogicalVolumes (ARRAY maxLogicalVolumes NIL NIL 0))
(for volNum from 0 to (SUB1 maxLogicalVolumes)
do (SETA \DFSLogicalVolumes volNum (create
LogicalVolumeDescriptor])
(PUTPROPS InitializeVols MACRO [NIL (PROGN (for volNum from 0 to (SUB1 (fetch (
PhysicalVolumeDescriptor subVolumeCount) of \PhysVolumePage)) do (\LvGetPage volNum 0 (GetVol volNum))
)
(* * DFSEventFn requires that extra LV pages be zeroed to facilitate finding out-of-date dliondisk fdevs.)
(for volNum from (fetch (PhysicalVolumeDescriptor
subVolumeCount)
of \PhysVolumePage)
to (SUB1 maxLogicalVolumes)
do (\ZEROPAGE (fetch (POINTER PAGE#)
of (GetVol volNum])
(PUTPROPS GetVols MACRO (NIL (for volNum from 0 to (SUB1 (fetch (PhysicalVolumeDescriptor
subVolumeCount)
of \PhysVolumePage))
collect (GetVol volNum))))
(PUTPROPS GetVol MACRO ((volNum)
(ELT \DFSLogicalVolumes volNum)))
(PUTPROPS CreateDirectories MACRO [NIL (if [NOT (AND (BOUNDP (QUOTE \DFSdirectories))
(type? ARRAYP \DFSdirectories)
(ZEROP (ARRAYORIG \DFSdirectories))
(EQ maxLogicalVolumes (ARRAYSIZE \DFSdirectories]
then (SETQ \DFSdirectories (ARRAY maxLogicalVolumes NIL
NIL 0])
(PUTPROPS PutDirectory MACRO (OPENLAMBDA (vol directory)
(SETA \DFSdirectories (OR (FIXP vol)
(VolumeNumber vol))
directory)))
(PUTPROPS GetDirectory MACRO [OPENLAMBDA (vol)
(ELT \DFSdirectories (OR (FIXP vol)
(VolumeNumber vol])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DFSLogicalVolumes \DFSdirectories)
)
(* * Assertion mechanism)
(RPAQQ Assert T)
(DECLARE: EVAL@COMPILE
(PUTPROPS Assert MACRO (ARGS (if (AND (BOUNDP (QUOTE Assert))
Assert)
then [CONS (QUOTE PROG)
(CONS (QUOTE ((\INTERRUPTABLE T)))
(for I in ARGS
collect
(LIST (QUOTE OR)
I
(LIST (QUOTE SHOULDNT)
(KWOTE (LIST (QUOTE Assert-failure:)
I]
else (CONS (QUOTE *)
ARGS))))
)
(* * The following are for diagnostic purposes.)
(DEFINEQ
(DISPLAYPAGE
[LAMBDA (VolNum PageAddr) (* hts: "19-Sep-84 17:16")
(DISPLAYWORDS (\LvGetPage VolNum PageAddr)
256])
(DISPLAYWORDS
[LAMBDA (Start Number) (* hts: "19-Sep-84 17:15")
(for I from 0 to (SUB1 Number)
do (PRIN1 (\GETBASE Start I))
(PRIN1 " ")
(if (ZEROP (IREMAINDER (ADD1 I)
7))
then (TERPRI)))
(TERPRI])
(ShowIntervals
[LAMBDA (vol) (* hts: "19-Sep-84 17:16")
(bind (intervalCache ←(PROGN (\DFSVFMContextSet vol)
(\DFSVFMGetInterval)))
interval for level from 0 to 5
do (printout T level ":" T "key: ")
(SETQ interval (ELT intervalCache level))
(DISPLAYWORDS (fetch (Interval key) of interval)
(MESASIZE Key))
(printout T "volumePage: " (fetch (Interval volumePage) of interval)
T)
(printout T "nextKey: ")
(DISPLAYWORDS (fetch (Interval nextKey) of interval)
(MESASIZE Key])
(REL
[LAMBDA (FILES) (* hts: "20-Sep-84 15:25")
(* * Releases FILES from connected directory to lispcore>next)
(for F in FILES
do (COPYFILE F (PACKFILENAME (QUOTE HOST)
(QUOTE ERIS)
(QUOTE DIRECTORY)
(QUOTE LISPCORE>SOURCES)
(QUOTE NAME)
F))
(COPYFILE (PACKFILENAME (QUOTE NAME)
F
(QUOTE EXTENSION)
(QUOTE DCOM))
(PACKFILENAME (QUOTE HOST)
(QUOTE ERIS)
(QUOTE DIRECTORY)
(QUOTE LISPCORE>SOURCES)
(QUOTE NAME)
F
(QUOTE EXTENSION)
(QUOTE DCOM)))
(printout NIL "RELEASED " F T])
)
)
(DECLARE:
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
)
(/DECLAREDATATYPE (QUOTE PageGroup)
(QUOTE (SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP)))
(* * Public entry)
(DEFINEQ
(DFSCREATEDIRECTORY
[LAMBDA (volName) (* hts: "11-Oct-84 13:42")
(WITH.MONITOR \DFStopMonitor (\DFSEnsureDlion)
(\DFSEnsureInitialized)
(if (NOT (\DFSPhysicalVolumeOK T))
then (ERROR))
(PROG ((vol (\DFSGetLVPage volName)))
(if (NULL vol)
then (ERROR (CONCAT "Volume " volName " not on local disk")))
(if (LVEqual vol (\DFSCurrentVol))
then (ERROR "Can't make a lisp file directory on your vmem volume"))
(UNINTERRUPTABLY
(PROG [(oldDevice (\GETDEVICEFROMNAME (QUOTE DSK]
(if (NOT (type? DLIONDISK oldDevice))
then (\REMOVEDEVICE oldDevice)
(\DFSDeviceConflict)
(\DFSCreateDevice)))
(\DFSVFMInitMap vol)
(\DFSMakeVolumeDirectory vol))
(RETURN volName])
(DFSPURGEDIRECTORY
[LAMBDA (volName) (* hts: "24-Sep-84 17:49")
(WITH.MONITOR \DFStopMonitor (\DFSEnsureDlion)
(\DFSEnsureInitialized)
(PROG ((vol (\DFSGetLVPage volName))
device)
(if (NOT vol)
then (ERROR volName " is not a local disk volume"))
(UNINTERRUPTABLY
(* * Mark volume as being a pilot volume)
(\DFSVolumeType volName (QUOTE PILOT))
(* * Remove device and directory associated with volume)
(if (GetDirectory vol)
then (FORGETPAGES (GetDirectory vol))
(PutDirectory vol NIL))
(* * If device was DSK, replace it with a coredevice)
(if (AND [type? DLIONDISK (SETQ device (\GETDEVICEFROMNAME (QUOTE DSK]
(NOT (\DFSVolumeNameToNumber)))
then (\REMOVEDEVICE device)))
(RETURN (PACKFILENAME (QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
volName])
(VOLUMES
[LAMBDA NIL (* hts: " 7-Sep-84 12:55")
(\DFSEnsureDlion)
(\DFSEnsureInitialized)
(UNINTERRUPTABLY
(for vol in (GetVols) collect (fetch (LogicalVolumeDescriptor LVlabel) of vol)))])
(VOLUMETYPE
[LAMBDA (volumeName type) (* hts: "24-Sep-84 17:44")
(OR (EQ type (QUOTE LISPFILE))
(EQ type (QUOTE PILOT))
(NULL type)
(ERROR "type must be one of LISPFILE or PILOT or NIL"))
(WITH.MONITOR \DFStopMonitor (\DFSEnsureDlion)
(\DFSEnsureInitialized)
(\DFSVolumeType volumeName type])
(\DFSVolumeType
[LAMBDA (volumeName type) (* hts: "24-Sep-84 17:44")
(PROG ((vol (\DFSGetLVPage volumeName))
oldType)
(if (NOT vol)
then (ERROR volumeName " is not a local disk volume"))
(SETQ oldType (if (EQ (fetch (LogicalVolumeDescriptor type) of vol)
DFSLispVolume)
then (QUOTE LISPFILE)
else (QUOTE PILOT)))
(if type
then (UNINTERRUPTABLY
(replace (LogicalVolumeDescriptor type) of vol
with (if (EQ type (QUOTE LISPFILE))
then DFSLispVolume
else DFSPilotVolume))
(\LvPutPage vol 0 vol)
(PROG [(markerPage (\LvGetPage vol (MarkerPageAddr vol]
(replace (LogicalSubVolumeMarker type) of (fetch (SubVolumeMarkerPage
logical)
of markerPage)
with DFSPilotVolume)
(\LvPutPage vol (MarkerPageAddr vol)
markerPage)))
(\DFSDsplyVolumes))
(RETURN oldType])
)
(DEFINEQ
(\DFSCurrentVolume
[LAMBDA NIL (* hts: "13-Sep-84 18:12")
(* * Returns as an atom the name of the volume which contains the currently running virtual memory)
(UNINTERRUPTABLY
(\DFSEnsureInitialized)
(fetch (LogicalVolumeDescriptor LVlabel) of (\DFSCurrentVol)))])
(\DFSCurrentVol
[LAMBDA NIL (* hts: "13-Sep-84 18:13")
(* * Returns the logical volume page of the volume which contains the currently running virtual memory)
(for vol in (GetVols) thereis (EQP (fetch (DiskFileID da) of (FMESAELT (fetch (
PhysicalVolumeDescriptor bootingInfo) of \PhysVolumePage)
PVBootFiles hardMicrocode))
(fetch (DiskFileID da) of (FMESAELT (fetch (
LogicalVolumeDescriptor bootingInfo) of vol)
LVBootFiles hardMicrocode])
(\DFSLispVolumeP
[LAMBDA (vol) (* hts: "13-Sep-84 18:45")
(* * Tells whether vol is a lisp file volume. Should really include some checks on the integrity of the directory,
etc.)
(EQ DFSLispVolume (fetch (LogicalVolumeDescriptor type) of vol])
(\DFSGetLVPage
[LAMBDA (lvName) (* hts: "27-Jun-84 14:07")
(UNINTERRUPTABLY
(SETQ lvName (MKATOM (U-CASE lvName)))
(for vol in (GetVols) thereis (EQ lvName (fetch (LogicalVolumeDescriptor LVlabel)
of vol))))])
)
(* * Initialization routines)
(DEFINEQ
(\DFSDEVICEP
[LAMBDA (deviceName) (* hts: "24-Sep-84 21:26")
(* * Opens and returns the dlion local file device iff: deviceName is appropriate, the disk is ok, and there is a
valid lisp file volume. If the deviceName is valid, HostNameP will return the device, creating it if it didn't
previously exist.)
(UNINTERRUPTABLY
(SELECTQ (MACHINETYPE)
(DANDELION (\DFSEnsureInitialized)
(AND (\DFSPhysicalVolumeOK NIL)
(\DFSVolumeNameToNumber)
(\DFSHostNameP deviceName)))
NIL))])
(\DFSEnsureDlion
[LAMBDA NIL (* hts: " 7-Sep-84 12:55")
(if (NEQ (MACHINETYPE)
(QUOTE DANDELION))
then (ERROR "You can't run this function if you aren't on an 1108"])
(\DFSEnsureInitialized
[LAMBDA NIL (* hts: " 5-Sep-84 17:25")
(OR \DFSInitialized (\DFSInit])
(\DFSInit
[LAMBDA NIL (* hts: " 1-Oct-84 14:27")
(* * initialize physical volume page cache)
(\PvTransferPage 0 \PhysVolumePage NIL)
(* * initialize logical volume page cache;)
(InitializeVols)
(if (\DFSPhysicalVolumeOK T)
then
(* * Initialize volume file map and volume allocation map)
(\DFSVAMInit)
(\DFSVFMInit)
(* * Note that this routine has been run)
(SETQ \DFSInitialized T)
(\DFSDsplyVolumes)
else (SETQ \DFSInitialized])
(\DFSPhysicalVolumeOK
[LAMBDA (printMessage) (* hts: "30-Sep-84 19:45")
(* * Checks to see that the disk you are attempting to run on is partitioned in a way the file system can
understand)
(if (for vol in (GetVols) always (EQ 8 (fetch (LogicalVolumeDescriptor version) of vol)))
then T
else (if printMessage
then (printout NIL "Local disk is not formatted as Klamath disk." T
"You cannot use it."
T))
NIL])
(\DFSCreateDevice
[LAMBDA NIL (* hts: "21-Sep-84 20:52")
(UNINTERRUPTABLY
(PROG [(DEV (\MAKE.PMAP.DEVICE (create FDEV
NODIRECTORIES ← T
DEVICENAME ←(QUOTE DSK)
CLOSEFILE ←(FUNCTION \DFSCloseFile)
DELETEFILE ←(FUNCTION \DFSDeleteFile)
TRUNCATEFILE ←(FUNCTION NILL)
GETFILEINFO ←(FUNCTION \DFSGetFileInfo)
GETFILENAME ←(FUNCTION \DFSGetFileName)
OPENFILE ←(FUNCTION \DFSOpenFile)
READPAGES ←(FUNCTION \DFSReadPages)
SETFILEINFO ←(FUNCTION \DFSSetFileInfo)
WRITEPAGES ←(FUNCTION \DFSWritePages)
REOPENFILE ←(FUNCTION \DFSOpenFile)
GENERATEFILES ←(FUNCTION \DFSGenerateFiles)
EVENTFN ←(FUNCTION \DFSEventFn)
DIRECTORYNAMEP ←(FUNCTION \DFSDirectoryNameP)
HOSTNAMEP ←(FUNCTION \DFSHostNameP]
(\DEFINEDEVICE (QUOTE DSK)
DEV)
(SETQ \DFSdevice DEV)
(printout NIL "Opened local file system device {DSK}." T)
(RETURN DEV)))])
(\DFSDeviceConflict
[LAMBDA NIL (* hts: "20-Sep-84 14:42")
(* * Resolves device name conflicts appropriately before creating DlionFS device)
(if (AND (type? COREDEVICE (\GETDEVICEFROMNAME (QUOTE DSK)))
(FILDIR (QUOTE {DSK})))
then (printout NIL "{DSK} is a coredevice which has files on it." T
"Copying contents of {DSK} to {PSEUDO-DSK}."
T)
(COREDEVICE (QUOTE PSEUDO-DSK))
[for f in (FILDIR (QUOTE {DSK})) do (COPYFILE f (PACKFILENAME (QUOTE HOST)
(QUOTE PSEUDO-DSK)
(QUOTE DIRECTORY)
(FILENAMEFIELD
f
(QUOTE DIRECTORY))
(QUOTE NAME)
(FILENAMEFIELD
f
(QUOTE NAME]
(printout NIL "Purging coredevice {DSK}." T])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DFSInitialized \DFSdevice \PhysVolumePage \DFStopMonitor)
)
(RPAQ? \DFSInitialized NIL)
(RPAQ? \DFSdevice NIL)
(RPAQ? \DFStopMonitor (CREATE.MONITORLOCK (QUOTE topMonitor)))
(ADDTOVAR \SYSTEMCACHEVARS \DFSInitialized)
(DEFINEQ
(\DFSAtLoad
[LAMBDA NIL (* hts: "18-Sep-84 12:15")
(OR (BOUNDP (QUOTE \PhysVolumePage))
(SETQ \PhysVolumePage (create PhysicalVolumeDescriptor)))
(CreateVols)
(CreateDirectories])
)
(\DFSAtLoad)
(* * Device methods)
(DEFINEQ
(\DFSOpenFile
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hts: " 2-Oct-84 11:49")
(* * Open a Model44 file. Gets the physical end of file and sets up ofd)
(WITH.MONITOR \DFStopMonitor (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]
(if (NOT (type? DLIONSTREAM FILE))
then (SETQ FILE (\DFSGetStreamForFile FILE RECOG ACCESS
OLDSTREAM
(NEQ ACCESS
(QUOTE INPUT))
PAGESTIMATE
OTHERINFO)))
(if (NOT FILE)
then (RETURN NIL)
else (if (EQ ACCESS (QUOTE OUTPUT))
then (* File is EMPTY even if it is old)
(replace EPAGE of FILE
with (replace EOFFSET of FILE with 0)))
(* For REOPENFILE op, don't change dates)
(\DFSUpdateLeaderPage
FILE
(if (AND (NOT OLDSTREAM)
(NOT (FMEMB (QUOTE DON'T.CHANGE.DATE)
OTHERINFO)))
then ACCESS
else NIL))
(RETURN FILE])
(\DFSGetStreamForFile
[LAMBDA (NAME RECOG ACCESS OLDSTREAM CREATEFLG PAGES OTHERINFO)
(* hts: "30-Oct-84 14:21")
(* Creates a STREAM for dsk file NAME, creating it if
necessary when CREATEFLG is true.)
(PROG ((DIROFD (\DFSFileNameToDirectory NAME))
FS fileID alreadyOpenStream)
(if (NOT DIROFD)
then (RETURN NIL))
(SETQ FS (\DFSFileSpec NAME RECOG DIROFD))
(RETURN (COND
[(fetch FSDIRPTR of FS)
(* * If the directory code found a pointer into the directory, then the file already exists;
just open it up)
(\DFSOpenOldFile FS (\DFSReadFileID (GetDirectory (fetch PARTNUM
of (fetch UNAME
of FS)))
(fetch FSDIRPTR of FS]
((NULL (fetch VERSION of (fetch UNAME of FS)))
NIL)
((IGREATERP (fetch VERSION of (fetch UNAME of FS))
MAX.SMALLP)
(printout NIL "Version number limit is 65535 on 1108 File System" T)
(DiskError "FILE SYSTEM RESOURCES EXCEEDED" FILE))
(CREATEFLG (\DFSCreateFile (fetch (DFSFileSpec UNAME) of FS)
PAGES OTHERINFO])
(\DFSOpenOldFile
[LAMBDA (file fileID) (* hts: "16-Sep-84 19:48")
(* * Open an old (existing) file and return the resultant stream)
(PROG ([vol (GetVol (fetch (UNAME PARTNUM) of (fetch (DFSFileSpec UNAME) of file]
STREAM)
(SETQ STREAM (create DLIONSTREAM
FULLFILENAME ←(\DFSFullFileName (fetch UNAME of file))
FILEDESC ←(create FileDescriptor
fileID ← fileID
volumeID ←(fetch (LogicalVolumeDescriptor vID)
of vol)
location ←(QUOTE local)
type ← 0)
VOLUME ← vol
DIRINFO ←(fetch FSDIRPTR of file)
DEVICE ← \DFSdevice))
(* * Use leader page to look up and fill in remaining fields of stream (those having to do with the length of the
file))
(replace (DLIONSTREAM LEADERPAGE) of STREAM with (\LvGetPage vol
(\DFSFindPageAddr
vol
(fetch (DLIONSTREAM FILEDESC)
of STREAM)
0)))
(replace (FileDescriptor size) of (fetch (DLIONSTREAM FILEDESC) of STREAM)
with (fetch AllocatedPages of (fetch (DLIONSTREAM LEADERPAGE) of STREAM)))
(replace (DLIONSTREAM EPAGE) of STREAM with (fetch EofPage of (fetch (DLIONSTREAM
LEADERPAGE)
of STREAM)))
(replace (DLIONSTREAM EOFFSET) of STREAM with (fetch EOffSet of (fetch (DLIONSTREAM
LEADERPAGE)
of STREAM)))
(RETURN STREAM])
(\DFSGenFileID
[LAMBDA (vol) (* edited: "18-Jul-84 14:33")
(* * Generates and returns a new file ID and updates the ID count for the logical volume)
(add (fetch (LogicalVolumeDescriptor lastIDAllocated) of vol)
1])
(\DFSCreateFile
[LAMBDA (fileName pages info) (* hts: "10-Oct-84 12:57")
(UNINTERRUPTABLY
(PROG ((initialAlloc 20)
(vol (GetVol (fetch (UNAME PARTNUM) of fileName)))
stream)
(SETQ stream (create DLIONSTREAM
FULLFILENAME ←(\DFSFullFileName fileName)
FILEDESC ←(create FileDescriptor
fileID ←(\DFSGenFileID vol)
volumeID ←(fetch (LogicalVolumeDescriptor vID)
of vol)
location ←(QUOTE local)
type ← 0)
VOLUME ← vol
DEVICE ← \DFSdevice))
(* * Allocate pages for file; this will update size field of FileDescriptor)
(\DFSNewPages vol (fetch (DLIONSTREAM FILEDESC) of stream)
(create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← initialAlloc))
(* * Create leader page for the new file and put it and cache it)
(replace (DLIONSTREAM LEADERPAGE) of stream with (\DFSMakeLeaderPage
vol
(fetch (DLIONSTREAM FILEDESC)
of stream)
fileName info))
(* * Enter the new file in the directory)
(\DFSMakeDirEntry stream fileName (GetDirectory vol))
(RETURN stream)))])
(\DFSNewPages
[LAMBDA (vol file group) (* hts: "17-Jun-84 13:00")
(* Attempts to allocate needed pages for file.
Returns a list of intervals allocated.
Interval represented as dotted pair
(startPage . #ofPages))
(PROG (currentGroup)
(until (EQP (fetch (FileDescriptor size) of file)
(fetch (PageGroup nextFilePage) of group))
do (SETQ currentGroup (create PageGroup
filePage ←(fetch (FileDescriptor size) of file)
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)
(replace (FileDescriptor size) of file with (fetch (PageGroup nextFilePage)
of currentGroup)))
(\DFSDsplyVolumes])
(\DFSMakeLeaderPage
[LAMBDA (vol file uname Info) (* hts: " 6-Sep-84 18:38")
(* * Make, put, and return leader page for file)
(PROG ([CurrentTime (IDATE (CADR (FASSOC (QUOTE CREATIONDATE)
Info]
(Author (OR (CADR (FASSOC (QUOTE AUTHOR)
Info))
(USERNAME)))
(LeaderPage (create LeaderPage)))
(replace (LeaderPage TimeCreate) of LeaderPage with CurrentTime)
(replace (LeaderPage TimeWrite) of LeaderPage with CurrentTime)
(replace (LeaderPage FileID) of LeaderPage with (fetch (FileDescriptor fileID)
of file))
(replace (LeaderPage AllocatedPages) of LeaderPage with (fetch (FileDescriptor size)
of file))
(replace (LeaderPage EofPage) of LeaderPage with 0)
(replace (LeaderPage EOffSet) of LeaderPage with 0)
(replace (LeaderPage fileName) of LeaderPage with (\DFSFileName uname))
(replace (LeaderPage author) of LeaderPage with Author)
(\LvPutPage vol (\DFSFindPageAddr vol file 0)
LeaderPage)
(RETURN LeaderPage])
(\DFSUpdateLeaderPage
[LAMBDA (stream access) (* hts: " 3-Jul-84 11:29")
(UNINTERRUPTABLY
(PROG ((leaderPage (fetch (DLIONSTREAM LEADERPAGE) of stream))
(time (DAYTIME)))
(* * Update end of file info)
(replace (LeaderPage EofPage) of leaderPage with (fetch (STREAM EPAGE) of stream))
(replace (LeaderPage EOffSet) of leaderPage with (fetch (STREAM EOFFSET) of stream))
(replace (LeaderPage AllocatedPages) of leaderPage with (fetch (FileDescriptor size)
of (fetch (DLIONSTREAM
FILEDESC)
of stream)))
(* * Update info saying how many pages have been allocated to the file)
(replace (LeaderPage AllocatedPages) of leaderPage with (fetch (FileDescriptor size)
of (fetch (DLIONSTREAM
FILEDESC)
of stream)))
(* * Update access times)
(SELECTQ access
((OUTPUT BOTH APPEND)
(replace (LeaderPage TimeWrite) of leaderPage with time))
NIL)
(SELECTQ access
((INPUT BOTH)
(replace (LeaderPage TimeRead) of leaderPage with time))
NIL)
(* * and write out the refreshed leader page)
(\DFSWriteLeaderPage stream)))])
(\DFSWriteLeaderPage
[LAMBDA (stream) (* hts: "14-Sep-84 10:47")
(PROG ((vol (fetch (DLIONSTREAM VOLUME) of stream)))
(\LvPutPage vol (\DFSFindPageAddr vol (fetch (DLIONSTREAM FILEDESC) of stream)
0)
(fetch (DLIONSTREAM LEADERPAGE) of stream])
(\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])
)
(DEFINEQ
(\DFSCloseFile
[LAMBDA (STREAM) (* hts: "24-Sep-84 21:05")
(* Update EOF in leader page)
(WITH.MONITOR \DFStopMonitor (\CLEARMAP STREAM)
(if (NEQ (fetch ACCESS of STREAM)
(QUOTE INPUT))
then (UNINTERRUPTABLY
(\DFSTrimHelper (fetch (DLIONSTREAM VOLUME) of STREAM)
(fetch (DLIONSTREAM FILEDESC) of STREAM)
(IPLUS (fetch EPAGE of STREAM)
(if (ZEROP (fetch EOFFSET of STREAM))
then 1
else 2)))
(\DFSUpdateLeaderPage STREAM)))
STREAM])
(\DFSTrimHelper
[LAMBDA (vol filePtr targetFileSize) (* hts: " 2-Jul-84 21:46")
(* * Shortens or deletes a file by taking entries out of the BTree and out of the allocation map Removes the pages
of the file between targetFileSize & actualFileSize)
(if (NOT (EQP targetFileSize (fetch (FileDescriptor size) of filePtr)))
then (bind (group ←(create PageGroup
filePage ← targetFileSize
volumePage ← nullVolumePage
nextFilePage ←(fetch (FileDescriptor size) of filePtr)))
until (PROGN (\DFSVFMDeletePageGroup vol filePtr group)
(\DFSVAMFreePageGroup vol filePtr group)
(replace (FileDescriptor size) of filePtr with (fetch (PageGroup
filePage)
of group))
(if (ZEROP (fetch (PageGroup filePage) of group))
then (replace (PageGroup nextFilePage) of group with 0)
(\DFSVFMDeletePageGroup vol filePtr group)
(\DFSVAMFreePageGroup vol filePtr group)
T
else (EQP (fetch (PageGroup filePage) of group)
targetFileSize)))
do (replace (PageGroup nextFilePage) of group with (fetch (PageGroup filePage)
of group))
(replace (PageGroup filePage) of group with targetFileSize))
(\DFSDsplyVolumes])
)
(DEFINEQ
(\DFSDeleteFile
[LAMBDA (fileName dev) (* hts: "24-Sep-84 16:57")
(WITH.MONITOR \DFStopMonitor (PROG ((stream (\DFSGetStreamForFile fileName (QUOTE OLDEST)
(QUOTE BOTH)
NIL)))
(if (OR (NOT stream)
(bind (NAME ←(fetch FULLFILENAME of stream))
thereis stream in \OPENFILES
suchthat (EQ (fetch FULLFILENAME of stream)
NAME)))
then (RETURN))
(UNINTERRUPTABLY
(\DFSRemoveDirEntry stream (GetDirectory
(fetch (DLIONSTREAM VOLUME)
of stream)))
(* * Take the entire file out of the BTree and out of the allocation map)
(\DFSTrimHelper (fetch (DLIONSTREAM VOLUME) of stream)
(fetch (DLIONSTREAM FILEDESC)
of stream)
0))
(RETURN (fetch (STREAM FULLFILENAME) of stream])
)
(DEFINEQ
(\DFSReadPages
[LAMBDA (stream firstPage buffers) (* hts: "24-Sep-84 17:11")
(* add1 is because dlionfs enumeration of file pages starts with the leader page and stream enumeration starts with
the first real page of the file)
(WITH.MONITOR \DFStopMonitor (for buffer inside buffers as page from (ADD1 firstPage)
do (\DFSReadOnePage stream page buffer)
(BLOCK])
(\DFSReadOnePage
[LAMBDA (stream page buffer) (* hts: "24-Sep-84 22:28")
(PROG ((vol (fetch (DLIONSTREAM VOLUME) of stream)))
(* (Assert (OR (ILEQ page (fetch EPAGE of stream)) (AND (IGREATERP (fetch EOFFSET of stream) 0)
(EQP page (ADD1 (fetch EPAGE of stream)))))))
(if [OR (ILEQ page (fetch EPAGE of stream))
(AND (IGREATERP (fetch EOFFSET of stream)
0)
(EQP page (ADD1 (fetch EPAGE of stream]
then (\LvGetPage vol (\DFSFindPageAddr vol (fetch (DLIONSTREAM FILEDESC) of stream)
page)
buffer])
)
(DEFINEQ
(\DFSWritePages
[LAMBDA (stream firstPage buffers) (* hts: "24-Sep-84 17:12")
(* add1 is because dlionfs enumeration of file pages starts with the leader page and stream enumeration starts with
the first real page of the file)
(WITH.MONITOR \DFStopMonitor (for buffer inside buffers as page from (ADD1 firstPage)
do (\DFSWriteOnePage stream page buffer)
(BLOCK])
(\DFSWriteOnePage
[LAMBDA (stream page buffer) (* hts: "24-Sep-84 17:12")
(PROG ((vol (fetch (DLIONSTREAM VOLUME) of stream))
volumePage)
(SETQ volumePage (\DFSFindPageAddr vol (fetch (DLIONSTREAM FILEDESC) of stream)
page
(QUOTE noError)))
(if (NULL volumePage)
then (* if this page is beyond the last allocated page of
the file, extend the file another chunk)
(\DFSExtendFile stream page)
(SETQ volumePage (\DFSFindPageAddr vol (fetch (DLIONSTREAM FILEDESC) of stream)
page)))
(\LvPutPage vol volumePage buffer])
(\DFSExtendFile
[LAMBDA (stream page) (* hts: "10-Oct-84 12:58")
(PROG ((vol (fetch (DLIONSTREAM VOLUME) of stream))
(fileDesc (fetch (DLIONSTREAM FILEDESC) of stream)))
(UNINTERRUPTABLY
[\DFSNewPages vol fileDesc (create PageGroup
filePage ←(fetch (FileDescriptor size) of fileDesc)
volumePage ← 0
nextFilePage ←(MAX page (IPLUS (fetch (FileDescriptor
size)
of fileDesc)
20]
(\DFSUpdateLeaderPage stream))])
)
(DEFINEQ
(\DFSGetFileInfo
[LAMBDA (stream attribute device) (* hts: "24-Sep-84 17:15")
(* Get the value of the attribute for a model44 file.
If stream is a filename, then the file is not open.)
(WITH.MONITOR \DFStopMonitor
(if (OR (type? STREAM stream)
(SETQ stream (\DFSGetStreamForFile stream (QUOTE OLD)
(QUOTE INPUT)
NIL)))
then (PROG ((infoPage (fetch (DLIONSTREAM LEADERPAGE) of stream)))
(RETURN (SELECTQ attribute
(LENGTH (\UPDATEOF stream)
(IPLUS (ITIMES (fetch (STREAM EPAGE)
of stream)
BYTESPERPAGE)
(fetch (STREAM EOFFSET)
of stream)))
(WRITEDATE (GDATE (fetch (LeaderPage TimeWrite)
of infoPage)))
(READDATE (GDATE (fetch (LeaderPage TimeRead)
of infoPage)))
(CREATIONDATE (GDATE (fetch (LeaderPage TimeCreate)
of infoPage)))
(IWRITEDATE (fetch (LeaderPage TimeWrite)
of infoPage))
(IREADDATE (fetch (LeaderPage TimeRead)
of infoPage))
(ICREATIONDATE (fetch (LeaderPage TimeCreate)
of infoPage))
(AUTHOR (fetch (LeaderPage author) of infoPage))
NIL])
)
(DEFINEQ
(\DFSSetFileInfo
[LAMBDA (stream attribute newValue device) (* hts: "24-Sep-84 17:16")
(WITH.MONITOR \DFStopMonitor (if (OR (type? STREAM stream)
(SETQ stream (\DFSGetStreamForFile stream (QUOTE OLD)
(QUOTE INPUT)
NIL)))
then (UNINTERRUPTABLY
(SELECTQ attribute
(CREATIONDATE (replace (LeaderPage TimeCreate)
of (fetch (DLIONSTREAM
LEADERPAGE)
of stream)
with (IDATE newValue))
(\DFSWriteLeaderPage stream)
newValue)
(ICREATIONDATE (replace (LeaderPage TimeCreate)
of (fetch (DLIONSTREAM
LEADERPAGE)
of stream)
with newValue)
(\DFSWriteLeaderPage stream)
newValue)
(AUTHOR (replace (LeaderPage author)
of (fetch (DLIONSTREAM LEADERPAGE)
of stream)
with newValue)
(\DFSWriteLeaderPage stream)
newValue)
NIL))
else NIL])
)
(DEFINEQ
(\DFSGetFileName
[LAMBDA (FileName Recog Dev) (* hts: "24-Sep-84 17:23")
(WITH.MONITOR \DFStopMonitor (PROG ((directory (\DFSFileNameToDirectory FileName)))
(RETURN (if directory
then (\DFSFullFileName (fetch UNAME
of (\DFSFileSpec
FileName
Recog
directory)))
else NIL])
)
(DEFINEQ
(\DFSEventFn
[LAMBDA (Dev Event) (* hts: "24-Sep-84 17:28")
(* * Determines dliondisk fdev behaviour across major system events. Must make the file system wake up properly on
different machines, or even on the same machine with a different disk partitioning.)
(WITH.MONITOR \DFStopMonitor (SELECTQ Event
[(AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(* * Get rid of the directories associated with this device; they will be reopened as necessary)
[for vol in (GetVols)
do (if (GetDirectory vol)
then (UNINTERRUPTABLY
(FORGETPAGES (GetDirectory vol))
(PutDirectory vol NIL))]
(* * Chop out the device to force \DFSDEVICEP to be run)
(UNINTERRUPTABLY
(SETQ \DFSdevice)
(\REMOVEDEVICE Dev))
(* * If on an alien machine, make sure you can't reopen files. \DFSDEVICEP will force reinitialization.)
(if (NOT (\DFSDEVICEP (QUOTE DSK)))
then (replace (FDEV REOPENFILE) of Dev
with (FUNCTION NILL]
(BEFORELOGOUT
(* * BVM claims you should flush open streams associated with this device only before logout)
(\FLUSH.OPEN.STREAMS Dev))
NIL])
)
(DEFINEQ
(\DFSFreeDiskPages
[LAMBDA (volName recompute) (* hts: "24-Sep-84 17:30")
(WITH.MONITOR \DFStopMonitor (PROG ((vol (\DFSGetLVPage volName)))
(if (NULL vol)
then (ERROR (CONCAT "Volume " volName " not on local disk")
))
(if recompute
then (\DFSVAMRecomputeFreePageCount vol)
(\DFSDsplyVolumes))
(RETURN (fetch (LogicalVolumeDescriptor freePageCount)
of vol])
)
(DEFINEQ
(\DFSDirectoryNameP
[LAMBDA (DirSpec) (* hts: "24-Sep-84 21:40")
(* * Implements the DIRECTORYNAMEP method for the dlionfs. If DirSpec is a reasonable directory specification,
returns the canonical form of that directory; otherwise returns NIL)
(WITH.MONITOR \DFStopMonitor (PROG ((directoryInfo (\DFSFirstDirectory DirSpec))
volNum directory subdirectory)
(RETURN (if (SETQ volNum (\DFSVolumeNameToNumber (CAR
directoryInfo)))
then [SETQ directory (PACKFILENAME
(QUOTE HOST)
(QUOTE DSK)
(QUOTE DIRECTORY)
(fetch (LogicalVolumeDescriptor LVlabel)
of (GetVol volNum]
(if (SETQ subdirectory
(SUBSTRING DirSpec (CADDR directoryInfo)
(LASTCHPOS (CHARCODE >)
DirSpec 1)))
then (PACK* directory subdirectory)
else (MKATOM directory))
else NIL])
)
(DEFINEQ
(\DFSHostNameP
[LAMBDA (name) (* hts: "24-Sep-84 21:36")
(* * Implements the HOSTNAMEP method for the dlionfs. If the name given it is one of DSK, the etherhostname, or the
physical volume name, returns the DSK device; otherwise returns NIL.)
(* * Also called by \DFSDEVICEP to determine whether the name given it is a reasonable one. For this purpose, it
will actually create the device if it does not already exist)
(WITH.MONITOR \DFStopMonitor (\DFSEnsureInitialized)
(PROG [(deviceName (MKATOM (U-CASE name]
(RETURN (if (OR (EQ deviceName (ETHERHOSTNAME))
(EQ deviceName (fetch (PhysicalVolumeDescriptor PVlabel)
of \PhysVolumePage))
(EQ deviceName (QUOTE DSK)))
then (OR \DFSdevice (\DFSCreateDevice))
else NIL])
)
(* * Routines for mapping file names onto volumes and directories)
(DEFINEQ
(\DFSFileNameToDirectory
[LAMBDA (fileName) (* hts: "14-Sep-84 16:52")
(* * Finds the directory stream corresponding to fileName (if there is such a directory))
(PROG [(volumeNumber (\DFSVolumeNameToNumber (CAR (\DFSFirstDirectory fileName]
(RETURN (if volumeNumber
then (OR (GetDirectory volumeNumber)
(\DFSOpenDirectory (GetVol volumeNumber)))
else NIL])
(\DFSVolumeNameToNumber
[LAMBDA (volumeName) (* hts: "13-Sep-84 18:59")
(* * Given a name, if that is the name of a lisp file volume, returns the number of that volume;
else returns NIL. Not given a name, it tries to find a default lisp file volume and return its number.
Default volume is the next lisp file volume after the volume containing the currently-running virtual memory.)
(if volumeName
then (PROG ((vol (\DFSGetLVPage volumeName)))
(RETURN (if (AND vol (\DFSLispVolumeP vol))
then (VolumeNumber vol)
else NIL)))
else (PROG ((volumes (GetVols))
(currentVol (\DFSCurrentVol))
nextVolumes defaultVol)
[SETQ nextVolumes (for vols on volumes do (if (EQ currentVol (CAR vols))
then (RETURN (APPEND (CDR vols)
volumes]
(SETQ defaultVol (for vol in nextVolumes thereis (\DFSLispVolumeP vol)))
(RETURN (if defaultVol
then (VolumeNumber defaultVol)
else NIL])
(\DFSFirstDirectory
[LAMBDA (name) (* hts: "13-Sep-84 21:58")
(PROG (endHost restDirectory)
(SETQ endHost (STRPOS "}" name))
(if (NULL endHost)
then (SETQ endHost 0))
(SETQ restDirectory (STRPOS ">" name endHost))
(SETQ restDirectory (ADD1 (if (NULL restDirectory)
then endHost
else restDirectory)))
(RETURN (LIST [MKATOM (U-CASE (SUBSTRING name (IPLUS endHost 2)
(IDIFFERENCE restDirectory 2]
endHost restDirectory])
)
(* * These functions transfer pages to and from the disk)
(DEFINEQ
(\PvTransferPage
[LAMBDA (absoluteDiskAddress BUFFER WRITEFLG) (* hts: "24-Sep-84 16:45")
(* * If WRITEFLG then writes BUFFER onto disk page absoluteDiskAddress; otherwise reads disk page
absoluteDiskAddress onto BUFFER)
[Assert (FIXP absoluteDiskAddress)
(OR (EQ absoluteDiskAddress 0)
(AND (IGREATERP absoluteDiskAddress 0)
(ILEQ absoluteDiskAddress (PROG [(volNum (SUB1 (fetch (PhysicalVolumeDescriptor
subVolumeCount)
of \PhysVolumePage]
(RETURN (IPLUS (LvBasePageAddr volNum)
(MarkerPageAddr volNum]
(Assert (type? Page BUFFER))
(WITH.MONITOR \DFSioMonitor (UNINTERRUPTABLY
(SwapIn&Dirty BUFFER)
(* * \DFSWriteFlg is passed globally since \MISCAPPLY* will take only 2 args. Must be exactly T or NIL, or it might
invoke label reading/writing)
(SETQ \DFSWriteFlg (if WRITEFLG
then T
else NIL))
(* * Call the page reading/writing routine in a special stack environment which will not page fault on frame
extension)
(\MISCAPPLY* (FUNCTION \PvTransferPageNoSwap)
absoluteDiskAddress BUFFER))])
(\PvTransferPageNoSwap
[LAMBDA (absoluteDiskAddress buffer) (* hts: " 9-Jul-84 17:52")
(* 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.TRANSFERPAGE absoluteDiskAddress buffer \DFSWriteFlg])
(\LvGetPage
[LAMBDA (vol pageAddr buffer) (* hts: " 6-Sep-84 21:02")
(* 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.)
(if (type? LogicalVolumeDescriptor vol)
then (SETQ vol (VolumeNumber vol)))
[Assert (FIXP vol)
(IGEQ vol 0)
(ILEQ vol (SUB1 (fetch (PhysicalVolumeDescriptor subVolumeCount) of \PhysVolumePage]
(Assert (FIXP pageAddr)
(IGEQ pageAddr 0)
(ILEQ pageAddr (MarkerPageAddr vol)))
(* * If buffer does not exist, create a new one.)
(if (NULL buffer)
then (SETQ buffer (create Page)))
(Assert (type? Page buffer))
(* * Read the page off the disk)
(\PvTransferPage (IPLUS (LvBasePageAddr vol)
pageAddr)
buffer)
buffer])
(\LvPutPage
[LAMBDA (vol pageAddr buffer) (* hts: " 6-Sep-84 21:02")
(* Writes the contents of PagePtr onto the disk at the
PageAddr'th page of the VolNum'th logical volume.)
(if (type? LogicalVolumeDescriptor vol)
then (SETQ vol (VolumeNumber vol)))
(Assert (FIXP vol))
(Assert (FIXP pageAddr)
(IGEQ pageAddr 0)
(ILEQ pageAddr (MarkerPageAddr vol)))
(Assert (type? Page buffer))
(\PvTransferPage (IPLUS (LvBasePageAddr vol)
pageAddr)
buffer T)
NIL])
)
(DECLARE: DONTEVAL@LOAD
(\LOCKFN (QUOTE \PvTransferPage))
(\LOCKFN (QUOTE \PvTransferPageNoSwap))
(\LOCKVAR (QUOTE \DFSWriteFlg))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DFSWriteFlg \DFSioMonitor)
)
(RPAQ? \DFSioMonitor (CREATE.MONITORLOCK (QUOTE ioMonitor)))
(* * Display stuff)
(DEFINEQ
(VOLUMEDISPLAY
[LAMBDA (newState) (* mjs "10-Aug-84 11:00")
(* 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}))
(SELECTQ (MACHINETYPE)
[DANDELION (UNINTERRUPTABLY
(\DFSEnsureInitialized)
(PROG [(oldState (if (WINDOWP \DFSDISPLAY)
then (QUOTE ON)
else (QUOTE OFF]
(SELECTQ newState
(ON (if (WINDOWP \DFSDISPLAY)
then (CLOSEW \DFSDISPLAY))
(SETQ \DFSDISPLAY T)
(\DFSDsplyVolumes))
(OFF (if (WINDOWP \DFSDISPLAY)
then (CLOSEW \DFSDISPLAY)))
NIL)
(RETURN oldState)))]
NIL])
(\DFSDsplyVolumes
[LAMBDA NIL (* mjs "10-Aug-84 11:15")
(if \DFSDISPLAY
then [if (NOT (WINDOWP \DFSDISPLAY))
then (SETQ \DFSDISPLAY (CREATEW (if (AND (BOUNDP (QUOTE \DFSDsplyVolumes.REGION))
(type? REGION \DFSDsplyVolumes.REGION))
then \DFSDsplyVolumes.REGION
else (create REGION
WIDTH ← 290
HEIGHT ←(IPLUS
45
(ITIMES 15 (fetch (
PhysicalVolumeDescriptor subVolumeCount) of \PhysVolumePage)))
LEFT ← 100
BOTTOM ← 50))
"1108 InterLisp File System"))
[WINDOWPROP \DFSDISPLAY (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (W)
(SETQ \DFSDISPLAY NIL]
(WINDOWPROP \DFSDISPLAY (QUOTE RESHAPEFN)
(FUNCTION RESHAPEBYREPAINTFN))
(WINDOWPROP \DFSDISPLAY (QUOTE REPAINTFN)
(FUNCTION \DFSDsplyVolumes.REPAINTFN))
(WINDOWPROP \DFSDISPLAY (QUOTE RESHAPEFN)
(FUNCTION (LAMBDA (W)
(CLEARW \DFSDISPLAY)
(REDISPLAYW \DFSDISPLAY]
(CLEARW \DFSDISPLAY)
(REDISPLAYW \DFSDISPLAY])
(\DFSDsplyVolumes.REPAINTFN
[LAMBDA (W REG) (* hts: "16-Sep-84 16:19")
(UNINTERRUPTABLY
(CLEARW W)
(DSPXPOSITION 0 W)
(DSPYPOSITION (IPLUS (fetch (REGION TOP) of REG)
(DSPLINEFEED NIL W))
W)
(printout W .FONT \DFSfixedFont "Physical Volume: " .FONT \DFSfixedBold (fetch (
PhysicalVolumeDescriptor PVlabel) of \PhysVolumePage)
.FONT \DFSfixedFont T "Logical Volumes:" T)
(for vol in (GetVols) do (printout W .FONT \DFSfixedFont (if (EQ (fetch (
LogicalVolumeDescriptor type) of vol)
DFSLispVolume)
then "* "
else " ")
(VolumeNumber vol)
" " .FONT \DFSfixedBold (fetch (LogicalVolumeDescriptor
LVlabel)
of vol)
" " .FONT \DFSfixedFont .FR 18 (fetch (
LogicalVolumeDescriptor volumeSize) of vol)
" Pages" .FR 31 (fetch (LogicalVolumeDescriptor
freePageCount)
of vol)
" Free" T)))])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DFSDISPLAY \DFSfixedFont \DFSfixedBold)
)
(RPAQ? \DFSfixedFont (FONTCREATE (QUOTE GACHA)
10
(QUOTE MRR)))
(RPAQ? \DFSfixedBold (FONTCREATE (QUOTE GACHA)
10
(QUOTE BRR)))
(RPAQ? \DFSDISPLAY NIL)
(* * Load other file system modules)
(FILESLOAD VOLUMEDIRECTORY VOLUMEFILEMAP VOLUMEALLOCATIONMAP)
(PUTPROPS DLIONFS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (20265 22213 (DISPLAYPAGE 20275 . 20448) (DISPLAYWORDS 20450 . 20787) (ShowIntervals
20789 . 21445) (REL 21447 . 22211)) (22390 26302 (DFSCREATEDIRECTORY 22400 . 23385) (DFSPURGEDIRECTORY
23387 . 24481) (VOLUMES 24483 . 24777) (VOLUMETYPE 24779 . 25173) (\DFSVolumeType 25175 . 26300)) (
26303 27949 (\DFSCurrentVolume 26313 . 26679) (\DFSCurrentVol 26681 . 27284) (\DFSLispVolumeP 27286 .
27625) (\DFSGetLVPage 27627 . 27947)) (27986 32413 (\DFSDEVICEP 27996 . 28613) (\DFSEnsureDlion 28615
. 28873) (\DFSEnsureInitialized 28875 . 29037) (\DFSInit 29039 . 29678) (\DFSPhysicalVolumeOK 29680
. 30248) (\DFSCreateDevice 30250 . 31453) (\DFSDeviceConflict 31455 . 32411)) (32695 32976 (
\DFSAtLoad 32705 . 32974)) (33017 44743 (\DFSOpenFile 33027 . 34468) (\DFSGetStreamForFile 34470 .
35863) (\DFSOpenOldFile 35865 . 37580) (\DFSGenFileID 37582 . 37886) (\DFSCreateFile 37888 . 39242) (
\DFSNewPages 39244 . 40569) (\DFSMakeLeaderPage 40571 . 41884) (\DFSUpdateLeaderPage 41886 . 43350) (
\DFSWriteLeaderPage 43352 . 43714) (\DFSFindPageAddr 43716 . 44741)) (44744 46979 (\DFSCloseFile 44754
. 45508) (\DFSTrimHelper 45510 . 46977)) (46980 48050 (\DFSDeleteFile 46990 . 48048)) (48051 49244 (
\DFSReadPages 48061 . 48535) (\DFSReadOnePage 48537 . 49242)) (49245 51115 (\DFSWritePages 49255 .
49731) (\DFSWriteOnePage 49733 . 50505) (\DFSExtendFile 50507 . 51113)) (51116 52601 (\DFSGetFileInfo
51126 . 52599)) (52602 53837 (\DFSSetFileInfo 52612 . 53835)) (53838 54286 (\DFSGetFileName 53848 .
54284)) (54287 55780 (\DFSEventFn 54297 . 55778)) (55781 56327 (\DFSFreeDiskPages 55791 . 56325)) (
56328 57431 (\DFSDirectoryNameP 56338 . 57429)) (57432 58388 (\DFSHostNameP 57442 . 58386)) (58462
60819 (\DFSFileNameToDirectory 58472 . 58973) (\DFSVolumeNameToNumber 58975 . 60168) (
\DFSFirstDirectory 60170 . 60817)) (60884 64232 (\PvTransferPage 60894 . 62212) (\PvTransferPageNoSwap
62214 . 62606) (\LvGetPage 62608 . 63564) (\LvPutPage 63566 . 64230)) (64535 67792 (VOLUMEDISPLAY
64545 . 65438) (\DFSDsplyVolumes 65440 . 66683) (\DFSDsplyVolumes.REPAINTFN 66685 . 67790)))))
STOP