(FILECREATED "11-Mar-85 17:45:28" {ERIS}<LISP>INTERMEZZO>SOURCES>LFFILEMAP.;3 48667
changes to: (VARS LFFILEMAPCOMS)
previous date: "20-Feb-85 21:08:57" {ERIS}<LISP>INTERMEZZO>SOURCES>LFFILEMAP.;2)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LFFILEMAPCOMS)
(RPAQQ LFFILEMAPCOMS ((* * Implements {idun}<apilot100>pilot>private>VolFileMapImpl.mesa.)
(* * Updated to run on Klamath (Mesa 11)
formatted disks. Might not be quite Klamath-Pilot compatible.)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
LFPILOTFILE)
(FILES DECL)
(RECORDS Key Interval Index BufferArray Buffer)
(RECORDS \BTREEBUF)
(CONSTANTS (maxReadPtr (DIFFERENCE (MESASIZE Buffer)
(MESASIZE Index)))
(treeDepth 5))
(FNS ShowIntervals))
(INITRECORDS \BTREEBUF)
(DECLARE: (LOCALVARS . T)
(IGNOREDECL . T))
(* * Initialization routines)
(FNS \VFMInit)
(* * The following are public entry points to the volume file map module)
(FNS \VFMDeletePageGroup \VFMGetPageGroup \VFMInsertPageGroup)
(* * The following are routines internal to the volume file map module.)
(FNS \VFMContextSet \VFMCreateVPage \VFMDelete \VFMDelete1 \VFMDelete2 \VFMFind \VFMFreeVPage
\VFMGet \VFMGet1 \VFMInsert \VFMInsert1 \VFMLower \VFMMerge \VFMMerge1 \VFMPutNext
\VFMReadNext \VFMSplit \VFMSplit1)
(GLOBALVARS \VFMmaxID \VFMmaxKey \VFMnullKey \VFMvolumeHandle \VFMinterval \VFMold \VFMlow
\VFMhigh \VFMoldPtr \VFMlowPtr \VFMhighPtr \VFMmonitor)
(* * Buffer management)
(FNS \VFMGetBufferFor \VFMSaveBuffer \VFMClearBuffers \VFMKillBuffer \VFMCorrectBufferP
\VFMMarkBufferDirty)
(GLOBALVARS \VFMbufferPool \VFMbufferSize \VFMbuffer \VFMxtraBuffer)
(INITVARS (\VFMbufferSize 10))
(* * Interval cache interface)
(FNS \VFMCreateIntervals \VFMClearIntervals \VFMGetInterval \VFMBlankInterval)
(GLOBALVARS \VFMintervals)
(* * BLT routine that doesn't stomp on itself for overlapping intervals)
(FNS \VFMSmartBLT)
(* * Loading initialization)
(FNS \VFMAtLoad)
(P (\VFMAtLoad))))
(* * Implements {idun}<apilot100>pilot>private>VolFileMapImpl.mesa.)
(* * Updated to run on Klamath (Mesa 11) formatted disks. Might not be quite Klamath-Pilot
compatible.)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
LFPILOTFILE)
(FILESLOAD DECL)
[DECLARE: EVAL@COMPILE
(MESARECORD Key ((fileID SWAPPEDFIXP)
(filePage SWAPPEDFIXP)
(type WORD)))
(MESARECORD Interval ((key Key)
(volumePage SWAPPEDFIXP)
(nextKey Key)))
(MESARECORD Index ((key Key)
(volumePage SWAPPEDFIXP)))
(MESAARRAY BufferArray [(0 (SUB1 (IQUOTIENT WORDSPERPAGE (MESASIZE Index]
Index)
(MESARECORD Buffer ((data BufferArray)
(used WORD)) (* This is the structure for a BTree page)
(CREATE (create Page))
(TYPE? (type? Page DATUM)))
]
[DECLARE: EVAL@COMPILE
(DATATYPE \BTREEBUF ((VOLUME POINTER)
(VOLPAGENUM FIXP)
(PAGE POINTER)
(DIRTY FLAG)))
]
(/DECLAREDATATYPE (QUOTE \BTREEBUF)
(QUOTE (POINTER FIXP POINTER FLAG)))
(DECLARE: EVAL@COMPILE
(RPAQ maxReadPtr (DIFFERENCE (MESASIZE Buffer)
(MESASIZE Index)))
(RPAQQ treeDepth 5)
(CONSTANTS (maxReadPtr (DIFFERENCE (MESASIZE Buffer)
(MESASIZE Index)))
(treeDepth 5))
)
(DEFINEQ
(ShowIntervals
[LAMBDA (vol) (* hts: " 5-Jan-85 16:30")
(bind (intervalCache ←(PROGN (\VFMContextSet vol)
(\VFMGetInterval)))
interval for level from 0 to 5
do (printout T level ":" T "key: ")
(SETQ interval (ELT intervalCache level))
(DISPLAYWORDS (fetch (Interval key) of interval)
(MESASIZE Key))
(printout T "volumePage: " (fetch (Interval volumePage) of interval)
T)
(printout T "nextKey: ")
(DISPLAYWORDS (fetch (Interval nextKey) of interval)
(MESASIZE Key])
)
)
(/DECLAREDATATYPE (QUOTE \BTREEBUF)
(QUOTE (POINTER FIXP POINTER FLAG)))
(DECLARE:
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(RESETSAVE COMPILEIGNOREDECL (QUOTE T))
)
)
(* * Initialization routines)
(DEFINEQ
(\VFMInit
[LAMBDA NIL (* hts: " 5-Jan-85 16:29")
(* * Minimally reinitialize the volume file map state variables)
(WITH.MONITOR \VFMmonitor (UNINTERRUPTABLY
(* * Clear out the BTree interval cache)
(\VFMClearIntervals)
(* * Clear the btree node cache)
(\VFMClearBuffers))])
)
(* * The following are public entry points to the volume file map module)
(DEFINEQ
(\VFMDeletePageGroup
[DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS NIL))
(* hts: "16-Feb-85 18:28")
(* Deletes all or part of a single page group from the volume file map. The page group requested to be deleted need
not correspond to a single run of pages on the disk. It can be part of a single run of pages or stretch over several
runs of pages. In particular it is possible to delete a page or pages out of the middle of a run of pages
(the scavenger uses this capability). The actual page group deleted is returned in the group pointed to by GroupPtr.
Thus GroupPtr points to a modifiable hint. Care must be taken by the caller to insure that the page group to be
deleted exists. If it doesn't, Bug (pageGroupNotFound) is raised. This procedure implements the following funny
features:)
(* 1.0 If the page group to be deleted includes parts of more than one run of pages on the disk, only the last run
(or that part of the last run requested to be deleted) will be deleted.)
(* 2.0 If the page group to be deleted is the last page group left for the file and includes page zero of the file
and at least one following page, page zero will not be deleted. This is a special case that facilitates shrinking a
file to a zero-length file. VolAllocMapImpl has special case code in FreePageGroup for this also.
You can delete this last page of the file by specifying page group "[0..0)".)
(* 3.0 A hole at the beginning of a file is represented as follows: if file F is missing pages
(0..n) and the preceding file in the lexicographic ordering is file E of size m, then the interval in the file map
representing the hole looks like this: (key: (E, m), volumePage: nullVolumePage, nextKey: (F, n)).)
(* 4.0 A hole in the middle of the file (e.g. missing pages (m..n)) looks like this: (key: (F, m), volumePage:
nullVolumePage, nextKey: (F, n)).)
(* 5.0 This procedure does not care whether the page group being deleted corresponds to a hole in a file or to a
real run of pages on the volume, with the exception of a hole at the beginning of a file. If the page group to be
deleted is fully contained in a hole at the beginning of the file, Bug (pageGroupNotFound) is raised.)
[WITH.MONITOR \VFMmonitor
(UNINTERRUPTABLY
(PROG ((key (create Key
fileID ←(fetch (FileDescriptor fileID) of filePtr)
filePage ←(IDIFFERENCE (fetch (PageGroup nextFilePage)
of groupPtr)
(if (EQ (fetch (PageGroup
nextFilePage)
of groupPtr)
0)
then 0
else 1))
type ←(fetch (FileDescriptor type) of filePtr)))
(interval (create Interval))
(fileSize (fetch (FileDescriptor size) of filePtr)))
(ASSERT (LEQ (fetch (PageGroup nextFilePage) of groupPtr)
fileSize))
(\VFMContextSet vol)
(MESASETQ interval (\VFMGet key 0)
Interval) (* get interval containing last page of group)
(if (OR (NOT (EQP (fetch (Key fileID) of (fetch (Interval key)
of interval))
(fetch (FileDescriptor fileID) of filePtr)))
(AND (NOT (EQP (fetch (Key fileID) of (fetch (Interval nextKey)
of interval))
(fetch (FileDescriptor fileID) of filePtr)))
(EQP (fetch (Interval volumePage) of interval)
nullVolumePage)))
then (DiskError "HARD DISK ERROR" "Page group not found"))
(* for a zero-length file, interval.nextKey.fileID #
filePtr.fileID BUT interval.volumePage #
nullVolumePage)
[replace (PageGroup filePage) of groupPtr
with (replace (Key filePage) of key
with (MAX (fetch (Key filePage) of (fetch (Interval key)
of interval))
(fetch (PageGroup filePage) of groupPtr]
[replace (PageGroup volumePage) of groupPtr
with (if (EQP (fetch (Interval volumePage) of interval)
nullVolumePage)
then nullVolumePage
else (IPLUS (fetch (Interval volumePage) of interval)
(IDIFFERENCE (fetch (PageGroup filePage)
of groupPtr)
(fetch (Key filePage)
of (fetch (Interval key)
of interval]
(replace (PageGroup nextFilePage) of groupPtr
with (MIN (fetch (Key filePage) of (fetch (Interval nextKey)
of interval))
(fetch (PageGroup nextFilePage) of groupPtr)))
(* deal with the starting page of the page group first)
(if [AND (MESAEQUAL key (fetch (Interval key) of interval)
Key)
(OR (NOT (EQP (fetch (PageGroup nextFilePage) of groupPtr)
fileSize))
(NOT (ZEROP (fetch (Key filePage) of key]
then (\VFMDelete key 0))
[if (NOT (ZEROP (fetch (Key filePage) of key)))
then (PROG [(previousKey (create Key
fileID ←(fetch (FileDescriptor
fileID)
of filePtr)
filePage ←(SUB1 (fetch (Key filePage)
of key]
(if (EQP (fetch (Key fileID)
of (fetch (Interval key)
of (\VFMGet previousKey 0)))
(fetch (FileDescriptor fileID) of filePtr))
then (* key.filePage is not the first
(existing) page of the file)
(\VFMInsert key nullVolumePage 0]
(* now deal with the ending page of the page group)
(replace (Key filePage) of key with (fetch (PageGroup nextFilePage)
of groupPtr))
(if (EQP (fetch (Key filePage) of key)
fileSize)
then (\VFMDelete key 0))
(if [AND [NOT (EQP (fetch (Key filePage) of key)
(fetch (Key filePage) of (fetch (Interval nextKey)
of interval]
(EQP (fetch (Key fileID) of key)
(fetch (Key fileID) of (fetch (Interval nextKey)
of interval]
then (\VFMInsert key [if (EQP (fetch (PageGroup volumePage)
of groupPtr)
nullVolumePage)
then nullVolumePage
else (IPLUS (fetch (PageGroup volumePage)
of groupPtr)
(IDIFFERENCE (fetch (PageGroup
nextFilePage)
of groupPtr)
(fetch (PageGroup
filePage)
of groupPtr]
0))))]])
(\VFMGetPageGroup
[DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(filePage FIXP)
(RETURNS (ONEOF NIL PageGroup)))
(* hts: "26-Jan-85 15:15")
(* Public)
(* * finds page group containing key (filePage = nextFilePage = size when off end of file))
[WITH.MONITOR \VFMmonitor
(UNINTERRUPTABLY
(PROG ((key (create Key
fileID ←(fetch (FileDescriptor fileID) of filePtr)
filePage ← filePage
type ←(fetch (FileDescriptor type) of filePtr)))
(interval (create Interval)))
(\VFMContextSet vol)
(MESASETQ interval (\VFMGet key 0)
Interval)
[RETURN (AND (EQP (fetch (Key fileID) of (fetch (Interval key)
of interval))
(fetch (FileDescriptor fileID) of filePtr))
(create PageGroup
filePage ←(fetch (Key filePage)
of (fetch (Interval key) of interval))
volumePage ←(fetch (Interval volumePage)
of interval)
nextFilePage ←(fetch (Key filePage)
of
(if
(EQP (fetch (Key fileID)
of (fetch (Interval
nextKey)
of interval))
(fetch (FileDescriptor
fileID)
of filePtr))
then (fetch (Interval nextKey)
of interval)
else (fetch (Interval key)
of interval]
(* covers page zero and size requests)
))]])
(\VFMInsertPageGroup
[DLAMBDA ((vol LogicalVolumeDescriptor)
(filePtr FileDescriptor)
(groupPtr PageGroup)
(RETURNS NIL))
(* hts: "16-Feb-85 18:28")
(* public)
(* * inserts a pageGroup into B-tree (unordered inserts are merged for rebuild))
[WITH.MONITOR \VFMmonitor
(UNINTERRUPTABLY
(PROG ((key (create Key
fileID ←(fetch (FileDescriptor fileID) of filePtr)
filePage ←(fetch (PageGroup filePage) of groupPtr)
type ←(fetch (FileDescriptor type) of filePtr)))
(interval (create Interval)))
(\VFMContextSet vol)
(MESASETQ interval (\VFMGet key 0)
Interval)
(if (MESAEQUAL (fetch (Interval key) of interval)
key Key)
then (\VFMDelete key 0)
(MESASETQ interval (\VFMGet key 0)
Interval))
(if [OR [NOT (EQP (IDIFFERENCE (fetch (Key filePage) of key)
(fetch (Key filePage)
of (fetch (Interval key) of interval)))
(IDIFFERENCE (fetch (PageGroup volumePage)
of groupPtr)
(fetch (Interval volumePage) of interval]
(NOT (EQP (fetch (Key fileID) of key)
(fetch (Key fileID) of (fetch (Interval key)
of interval]
then (* don't merge with previous)
(\VFMInsert key (fetch (PageGroup volumePage) of groupPtr)
0)
(MESASETQ interval (\VFMGet key 0)
Interval))
(replace (Key filePage) of key with (fetch (PageGroup nextFilePage)
of groupPtr))
(if [AND (NOT (MESAEQUAL (fetch (Interval nextKey) of interval)
key Key))
(NOT (EQP (fetch (PageGroup filePage) of groupPtr)
(fetch (PageGroup nextFilePage) of groupPtr]
then (\VFMInsert key nullVolumePage 0))
(if [AND (MESAEQUAL (fetch (Interval nextKey) of interval)
key Key)
(EQP (fetch (Interval volumePage) of (\VFMGet key 0))
(IPLUS (fetch (Interval volumePage) of interval)
(IDIFFERENCE (fetch (Key filePage)
of (fetch (Interval nextKey)
of interval))
(fetch (Key filePage)
of (fetch (Interval key)
of interval]
then (\VFMDelete key 0) (* merge with following))))]])
)
(* * The following are routines internal to the volume file map module.)
(DEFINEQ
(\VFMContextSet
[LAMBDA (vol) (* hts: " 5-Jan-85 16:24")
(* vol: LogicalVolumeDescriptor)
(* Internal)
(SETQ \VFMvolumeHandle vol])
(\VFMCreateVPage
[LAMBDA NIL (* hts: " 9-Jan-85 17:32")
(* Returns SWAPPEDFIXP)
(* Internal)
(* * Calls VolAllocMap.AllocPageGroup to get a new page for the vfm B-tree. Returns its volume-relative page
number.)
(with LogicalVolumeDescriptor \VFMvolumeHandle
(PROG [(group (create PageGroup
filePage ← 0
volumePage ← 0
nextFilePage ← 1))
(vfmFileD (ELT \PFFileMapFileD (\PFVolumeNumber \VFMvolumeHandle]
(\VAMAllocPageGroup \VFMvolumeHandle vfmFileD group)
(RETURN (fetch (PageGroup volumePage) of group])
(\VFMDelete
[LAMBDA (deleteKey deleteLevel) (* hts: "24-Jan-85 16:23")
(* key: Key, level: SMALLP)
(* Internal)
(* * Deletes the index corresponding to key. Error if no such index. No merging is done here explicitly;
it happens as a side-effect of (Find ...))
(DECLARE (SPECVARS deleteKey deleteLevel))
(PROG (firstFlag lastFlag volumePage (nextKey (create Key)))
(DECLARE (SPECVARS firstFlag lastFlag volumePage nextKey))
(* * volumePage is the page holding the key (delete if firstFlag AND lastFlag) -
nextKey is the following key; must be slid down over deleted key)
(\VFMFind deleteKey deleteLevel (FUNCTION \VFMDelete1))
[if firstFlag
then
(* * Since this is the first entry in a page, there is a reference to it in the next higher level.
If the current page will become empty due to the delete, we simply delete the reference in the higher page.
Otherwise we must replace the reference with the new first entry of the current page.)
(\VFMDelete deleteKey (ADD1 deleteLevel))
(if lastFlag
then (\VFMFreeVPage volumePage)
else (\VFMInsert nextKey volumePage (ADD1 deleteLevel]
(\VFMFind deleteKey deleteLevel (FUNCTION \VFMDelete2)))
(* Get the preceding index)
])
(\VFMDelete1
[LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(* * Save the following Index in nextKey; set firstFlag, lastFlag, and volumePage. Shift entries if at beginning of
page.)
(SETQ firstFlag (EQP \VFMlowPtr 0))
(SETQ lastFlag (EQP \VFMhighPtr (fetch (Buffer used) of \VFMbuffer)))
(SETQ volumePage (fetch (Interval volumePage) of \VFMinterval))
(MESASETQ nextKey (fetch (Index key) of \VFMhigh)
Key)
(ASSERT (MESAEQUAL (fetch (Index key) of \VFMlow)
deleteKey Key))
(if (AND firstFlag (NOT lastFlag))
then (\VFMSmartBLT \VFMbuffer (\ADDBASE \VFMbuffer \VFMhighPtr)
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE
(fetch (Buffer used)
of \VFMbuffer)
\VFMhighPtr)))
(\VFMMarkBufferDirty \VFMbuffer])
(\VFMDelete2
[LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(* * Slide the entries down over nextKey, and then reinsert nextKey in place of the deleted entry.
Be careful to preserve the correct volumePage.)
(replace (Index key) of \VFMhigh with nextKey)
(replace (Index volumePage) of \VFMhigh with (fetch (Index volumePage) of \VFMlow))
(MESASETQ \VFMlow \VFMold Index)
(SETQ \VFMlowPtr \VFMoldPtr)
(\VFMSmartBLT (\ADDBASE \VFMbuffer (IPLUS \VFMlowPtr (MESASIZE Index)))
(\ADDBASE \VFMbuffer \VFMhighPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMhighPtr))
(\VFMPutNext (fetch (Index key) of \VFMhigh)
(fetch (Index volumePage) of \VFMhigh)
deleteLevel)
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE (IPLUS \VFMlowPtr (fetch (Buffer used)
of \VFMbuffer))
\VFMhighPtr))
(\VFMMarkBufferDirty \VFMbuffer])
(\VFMFind
[LAMBDA (key level proc) (* hts: "25-Jan-85 11:46")
(* key: Key, level: SMALLP, proc: FUNCTION)
(* Internal)
(* executes proc with context
(buffer, low, \VFMhigh) surrounding key
(merges too))
(MESASETQ \VFMinterval (\VFMGet key (ADD1 level))
Interval)
(SETQ \VFMbuffer (\VFMGetBufferFor (fetch (Interval volumePage) of \VFMinterval)))
(* * Initialize reader)
(replace (Index key) of \VFMhigh with (fetch (Interval key) of \VFMinterval))
(replace (Index volumePage) of \VFMhigh with nullVolumePage)
(MESASETQ \VFMold (MESASETQ \VFMlow \VFMhigh Index)
Index)
(SETQ \VFMoldPtr (SETQ \VFMlowPtr (SETQ \VFMhighPtr 0)))
(* * Scan this page till key is passed)
(repeatuntil (\VFMLower key (fetch (Index key) of \VFMhigh)) do (\VFMReadNext))
(APPLY proc)
(if (AND (ILEQ (fetch (Buffer used) of \VFMbuffer)
(IQUOTIENT (MESASIZE Buffer)
3))
(NOT (MESAEQUAL (fetch (Interval nextKey) of \VFMinterval)
\VFMmaxKey Key)))
then (\VFMMerge (fetch (Index key) of \VFMold)
level])
(\VFMFreeVPage
[LAMBDA (volumePage) (* hts: " 9-Jan-85 17:31")
(* volumePage: SWAPPEDFIXP)
(* Internal)
(* * calls VolAllocMap.FreePageGroup to free a page of the vfm BTree)
(with LogicalVolumeDescriptor \VFMvolumeHandle
(PROG [(group (create PageGroup
filePage ← volumePage
volumePage ← volumePage
nextFilePage ←(ADD1 volumePage)))
(vfmFileD (ELT \PFFileMapFileD (\PFVolumeNumber \VFMvolumeHandle]
(\VAMFreePageGroup \VFMvolumeHandle vfmFileD group)))
(\VFMKillBuffer volumePage])
(\VFMGet
[LAMBDA (getKey getLevel) (* hts: "26-Jan-85 18:58")
(* key: Key, level: SMALLP; returns Interval)
(* Internal)
(DECLARE (SPECVARS getKey getLevel))
(if (GREATERP getLevel treeDepth)
then (DiskError "HARD DISK ERROR" "Can't find BTree entry"))
(if (EQ getLevel treeDepth)
then
(* * If you've run out of interval cache to check, just return the widest possible interval)
(create Interval
key ← \VFMnullKey
volumePage ←(fetch (LogicalVolumeDescriptor vfmStart) of \VFMvolumeHandle)
nextKey ← \VFMmaxKey)
else (MESASETQ \VFMinterval (ELT (\VFMGetInterval)
getLevel)
Interval)
(if [OR (\VFMLower getKey (fetch (Interval key) of \VFMinterval))
(NOT (\VFMLower getKey (fetch (Interval nextKey) of \VFMinterval]
then
(* * If the cached interval for the current level isn't the one you were looking for, then search one level closer
to the root of the btree)
(\VFMFind getKey getLevel (FUNCTION \VFMGet1)))
(ELT (\VFMGetInterval)
getLevel])
(\VFMGet1
[LAMBDA NIL (* hts: " 5-Jan-85 16:30")
(* Internal)
(PROG ((interval (ELT (\VFMGetInterval)
getLevel)))
(if interval
then (replace (Interval key) of interval with (fetch (Index key) of \VFMlow))
(replace (Interval volumePage) of interval with (fetch (Index volumePage)
of \VFMhigh))
(replace (Interval nextKey) of interval with (fetch (Index key) of \VFMhigh])
(\VFMInsert
[LAMBDA (insertKey insertVolumePage insertLevel) (* hts: "24-Jan-85 17:44")
(* key: Key, volumePage: PageNumber, level: Level)
(* Internal)
(* * Inserts an Index containing key and volumePage, calling Split if necessary.)
(DECLARE (SPECVARS insertKey insertVolumePage insertLevel))
(PROG (splitFlag)
(DECLARE (SPECVARS splitFlag))
(* * Try the insert.)
(\VFMFind insertKey insertLevel (FUNCTION \VFMInsert1))
(* * If there wasn't enough space to insert, split the page and retry the insertion.)
(if splitFlag
then (\VFMSplit insertKey insertLevel)
(\VFMFind insertKey insertLevel (FUNCTION \VFMInsert1])
(\VFMInsert1
[LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(PROG NIL
(if (SETQ splitFlag (IGREATERP (fetch (Buffer used) of \VFMbuffer)
maxReadPtr))
then (RETURN))
(if (ILESSP \VFMlowPtr (fetch (Buffer used) of \VFMbuffer))
then (\VFMSmartBLT (\ADDBASE \VFMbuffer (IPLUS \VFMlowPtr (TIMES (MESASIZE Index)
2)))
(\ADDBASE \VFMbuffer \VFMhighPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMhighPtr))
(\VFMPutNext insertKey (fetch (Index volumePage) of \VFMhigh)
insertLevel)
else (\VFMSmartBLT (\ADDBASE \VFMbuffer (IPLUS \VFMlowPtr (MESASIZE Index)))
(\ADDBASE \VFMbuffer \VFMhighPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMhighPtr)))
(\VFMPutNext (fetch (Index key) of \VFMhigh)
insertVolumePage insertLevel)
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE (IPLUS \VFMlowPtr
(fetch (Buffer used)
of \VFMbuffer))
\VFMhighPtr))
(\VFMMarkBufferDirty \VFMbuffer])
(\VFMLower
[LAMBDA (a b) (* hts: " 5-Jan-85 16:23")
(* a: Key, b: Key; returns BOOLEAN)
(* Internal)
(* * Compares two keys for ordering; maxKey < maxKey to close key space)
(* * somewhat icky because fileids are 32 bit #s where high bit set means high positive number, not negative.)
(PROG ((AFILE (fetch (Key fileID) of a))
(BFILE (fetch (Key fileID) of b))
(APAGE (fetch (Key filePage) of a))
(BPAGE (fetch (Key filePage) of b)))
(RETURN (OR [if (GEQ AFILE 0)
then (if (LESSP BFILE 0)
then T
else (AND (GEQ BFILE 0)
(LESSP AFILE BFILE)))
else (if (GEQ BFILE 0)
then NIL
else (AND (LESSP BFILE 0)
(GREATERP AFILE BFILE]
(AND (EQP AFILE BFILE)
(OR (ILESSP APAGE BPAGE)
(MESAEQUAL b \VFMmaxKey Key])
(\VFMMerge
[LAMBDA (mergeKey mergeLevel) (* hts: "25-Jan-85 12:17")
(* key: Key, level: SMALLP)
(* Internal)
(* * Tries to merge page of oldInterval with next page at same mergeLevel or with root; cannot merge last page of
any mergeLevel except rootlevel)
(DECLARE (SPECVARS mergeKey mergeLevel))
(PROG (mergeFlag (leftInterval (create Interval))
(rightInterval (create Interval)))
(DECLARE (SPECVARS mergeFlag leftInterval rightInterval))
(* * get a valid volumePage)
(MESASETQ leftInterval (\VFMGet mergeKey (ADD1 mergeLevel))
Interval)
(\VFMFind (fetch (Interval nextKey) of leftInterval)
mergeLevel
(FUNCTION \VFMMerge1)) (* beware the merging)
(* * Get rid of the old reference to the merging page.)
(\VFMDelete (fetch (Interval nextKey) of leftInterval)
(ADD1 mergeLevel))
(* * If the page was not actually merged, insert the new Index, else free up the merged page.)
(if mergeFlag
then (\VFMFreeVPage (fetch (Interval volumePage) of rightInterval))
else (\VFMInsert (fetch (Interval key) of rightInterval)
(fetch (Interval volumePage) of rightInterval)
(ADD1 mergeLevel])
(\VFMMerge1
[LAMBDA NIL (* hts: "29-Jan-85 20:50")
(* Internal)
(PROG (xtraBufferUsed)
(MESASETQ rightInterval \VFMinterval Interval)
(SETQ \VFMxtraBuffer (\VFMGetBufferFor (fetch (Interval volumePage) of leftInterval)))
(SETQ xtraBufferUsed (fetch (Buffer used) of \VFMxtraBuffer))
(* xtraBufferUsed used to solve stack modeling error)
(if (EQ mergeLevel (SUB1 treeDepth))
then (replace (Buffer used) of \VFMxtraBuffer with 0))
(if (SETQ mergeFlag (ILESSP (IPLUS (fetch (Buffer used) of \VFMbuffer)
(fetch (Buffer used) of \VFMxtraBuffer))
(MESASIZE Buffer)))
then
(* * If merging possible then merge pages. Merge buffer with aux buffer.)
(\VFMSmartBLT (\ADDBASE \VFMxtraBuffer xtraBufferUsed)
\VFMbuffer
(fetch (Buffer used) of \VFMbuffer))
(replace (Buffer used) of \VFMxtraBuffer with (IPLUS (fetch (Buffer used)
of \VFMxtraBuffer)
(fetch (Buffer used)
of \VFMbuffer)))
(* buffer.used remains to prevent Find from attempting
a merge)
else
(* * otherwise balance pages simply to provide hysteresis against futile merge attempts. First find middle.)
(while (ILESSP \VFMlowPtr (IQUOTIENT (IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
(fetch (Buffer used) of
\VFMxtraBuffer))
2))
do (\VFMReadNext))
(* * move first of \VFMbuffer to xtra)
(\VFMSmartBLT (\ADDBASE \VFMxtraBuffer xtraBufferUsed)
\VFMbuffer \VFMlowPtr)
(* * slide down the rest of \VFMbuffer)
(\VFMSmartBLT \VFMbuffer (\ADDBASE \VFMbuffer \VFMlowPtr)
(IDIFFERENCE (fetch (Buffer used) of \VFMbuffer)
\VFMlowPtr))
(* * Straighten out end-of-node info.)
(replace (Buffer used) of \VFMxtraBuffer with (IPLUS (fetch (Buffer used)
of \VFMxtraBuffer)
\VFMlowPtr))
(replace (Buffer used) of \VFMbuffer with (IDIFFERENCE (fetch (Buffer used)
of \VFMbuffer)
\VFMlowPtr))
(* * use \VFMlow to insert while it is still valid)
(replace (Interval key) of rightInterval with (fetch (Index key) of \VFMlow)))
(* * Finish up.)
(\VFMMarkBufferDirty \VFMbuffer)
(\VFMMarkBufferDirty \VFMxtraBuffer)
(SETQ \VFMxtraBuffer NIL])
(\VFMPutNext
[LAMBDA (key volumePage level) (* hts: "25-Jan-85 15:25")
(* key: Key, volumePage: SWAPPEDFIXP, level: SMALLP)
(* Internal)
(* Compresses item in the context of low. Note the side effect on \VFMlow but not on high!! No compression is
implemented in this version, but useful one would include: front compression (especially to shrink page groups back
to 2 fields))
(MESASETQ \VFMold \VFMlow Index)
(SETQ \VFMoldPtr \VFMlowPtr)
(replace (Index key) of \VFMlow with key)
(replace (Index volumePage) of \VFMlow with volumePage)
(MESASETQ (\ADDBASE (fetch (Buffer data) of \VFMbuffer)
\VFMlowPtr)
\VFMlow Index)
(SETQ \VFMlowPtr (IPLUS \VFMoldPtr (MESASIZE Index)))
(* * keep cache up to date in the face of changes)
(SETA (\VFMGetInterval)
level
(create Interval
key ←(fetch (Index key) of \VFMold)
volumePage ←(fetch (Index volumePage) of \VFMlow)
nextKey ←(fetch (Index key) of \VFMlow)))
(* * Mark buffer dirty)
(\VFMMarkBufferDirty \VFMbuffer])
(\VFMReadNext
[LAMBDA NIL (* hts: "26-Jan-85 15:24")
(* * Internal)
(* * Decompresses item at \VFMhigh to become \VFMlow & bumps high. Note the side effect on \VFMlow and not high.
No compression is implemented in this version)
(OR (LEQ \VFMhighPtr (fetch (Buffer used) of \VFMbuffer))
(DiskError "HARD DISK ERROR" "Read too far in ReadNext"))
(MESASETQ \VFMold \VFMlow Index)
(SETQ \VFMoldPtr \VFMlowPtr)
(MESASETQ \VFMlow \VFMhigh Index)
(SETQ \VFMlowPtr \VFMhighPtr)
(if (ILESSP \VFMhighPtr (fetch (Buffer used) of \VFMbuffer))
then (* Loophole)
(MESASETQ \VFMhigh (\ADDBASE (fetch (Buffer data) of \VFMbuffer)
\VFMhighPtr)
Index)
(SETQ \VFMhighPtr (IPLUS \VFMhighPtr (MESASIZE Index)))
else (* Leave ptr alone)
(replace (Index key) of \VFMhigh with \VFMmaxKey)
(replace (Index volumePage) of \VFMhigh with nullVolumePage])
(\VFMSplit
[LAMBDA (splitKey splitLevel) (* hts: " 5-Jan-85 16:29")
(* key: Key, level: SMALLP)
(* Internal)
(* * moves half of \DFSVFMbuffer (or root) to xtraBuffer, creating new page of tree)
(DECLARE (SPECVARS splitKey splitLevel))
(PROG ((keyStone (create Key))
(page (\VFMCreateVPage))) (* keyStone is the half way mark)
(DECLARE (SPECVARS keyStone page))
(\VFMFind splitKey splitLevel (FUNCTION \VFMSplit1))
(\VFMInsert keyStone page (ADD1 splitLevel])
(\VFMSplit1
[LAMBDA NIL (* hts: "25-Jan-85 12:01")
(* Internal)
(* * Read in an extra page into which to copy the second half of the current node)
(SETQ \VFMxtraBuffer (\VFMGetBufferFor page))
(* * Find the middle of the page to split)
(SETQ \VFMhighPtr 0)
(replace (Index key) of \VFMhigh with (fetch (Interval key) of \VFMinterval))
(replace (Index volumePage) of \VFMhigh with nullVolumePage)
(repeatuntil (IGREATERP \VFMhighPtr (IQUOTIENT (fetch (Buffer used) of \VFMbuffer)
2))
do (\VFMReadNext))
(* * Move the last half of buffer to extra buffer.)
(\BLT \VFMxtraBuffer (\ADDBASE (fetch (Buffer data) of \VFMbuffer)
\VFMlowPtr)
(replace (Buffer used) of \VFMxtraBuffer with (IDIFFERENCE (fetch (Buffer used)
of \VFMbuffer)
\VFMlowPtr)))
(replace (Buffer used) of \VFMbuffer with \VFMlowPtr)
(MESASETQ keyStone (fetch (Index key) of \VFMlow)
Key)
(* * Mark buffers dirty so that they will be flushed out to disk, and clear the extra buffer holder
(just to prevent confusion))
(\VFMMarkBufferDirty \VFMbuffer)
(\VFMMarkBufferDirty \VFMxtraBuffer)
(SETQ \VFMxtraBuffer NIL])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VFMmaxID \VFMmaxKey \VFMnullKey \VFMvolumeHandle \VFMinterval \VFMold \VFMlow \VFMhigh
\VFMoldPtr \VFMlowPtr \VFMhighPtr \VFMmonitor)
)
(* * Buffer management)
(DEFINEQ
(\VFMGetBufferFor
[DLAMBDA ((VOLPAGENUM FIXP)
(RETURNS Buffer))
(* hts: "25-Jan-85 15:23")
(* page: SWAPPEDFIXP)
(* Internal)
(* * Try to find btree page in buffer pool. If there, move to front of buffer pool. Otherwise, read in the requred
page and put it at the front of the pool. If buffer pool is > maxbufferpoolsize then flush the last page in the
pool)
(DPROG ((BUFFER (\VFMKillBuffer VOLPAGENUM) (ONEOF NIL \BTREEBUF))
(LAST NIL LST)
(FLUSH NIL LST))
(if BUFFER
then
(* * Move buffer to front of buffer list)
(push \VFMbufferPool BUFFER)
else
(* * Create and read in new buffer)
(push \VFMbufferPool (SETQ BUFFER
(create \BTREEBUF
VOLUME ← \VFMvolumeHandle
VOLPAGENUM ← VOLPAGENUM
PAGE ←(create Buffer)
DIRTY ← NIL)))
(\PFGetFileMapPage \VFMvolumeHandle VOLPAGENUM (fetch (\BTREEBUF PAGE) of BUFFER))
(* * Shorten buffer pool if necessary)
(if [SETQ FLUSH (CDR (SETQ LAST (FNTH \VFMbufferPool \VFMbufferSize]
then (RPLACD LAST NIL)
(\VFMSaveBuffer T FLUSH)))
(* * Finally set the main buffer page to be the selected buffer page.)
(RETURN (fetch (\BTREEBUF PAGE) of BUFFER)))])
(\VFMSaveBuffer
[DLAMBDA ((notAll BOOL)
(whichBuffers LST)
(evenIfNotDirty BOOL)
(RETURNS NIL))
(* mjs "20-Feb-85 21:00")
(* * Flushes dirty buffers. If notAll is true, then it is to save only the specified buffers)
(OR notAll (SETQ whichBuffers \VFMbufferPool))
(for BUF inside whichBuffers when (OR (fetch (\BTREEBUF DIRTY) of BUF)
evenIfNotDirty)
do (\PFPutFileMapPage (fetch (\BTREEBUF VOLUME) of BUF)
(fetch (\BTREEBUF VOLPAGENUM) of BUF)
(fetch (\BTREEBUF PAGE) of BUF))
(replace (\BTREEBUF DIRTY) of BUF with NIL))])
(\VFMClearBuffers
[LAMBDA NIL (* hts: "16-Nov-84 15:38")
(* * Clear the btree node cache)
(SETQ \VFMbufferPool NIL])
(\VFMKillBuffer
[DLAMBDA ((VOLPAGENUM FIXP)
(RETURNS (ONEOF NIL \BTREEBUF)))
(* hts: "23-Jan-85 16:19")
(* * Remove the buffer for a btree node which is being decommissioned.)
(* * return the removed node)
[if (AND (LISTP \VFMbufferPool)
(\VFMCorrectBufferP (CAR \VFMbufferPool)
VOLPAGENUM))
then (PROG1 (CAR \VFMbufferPool)
(SETQ \VFMbufferPool (CDR \VFMbufferPool)))
else (bind CURRENT for PREV on \VFMbufferPool do (if (AND (LISTP (SETQ CURRENT (CDR PREV)))
(\VFMCorrectBufferP (CAR CURRENT)
VOLPAGENUM))
then (RETURN (PROG1 (CAR CURRENT)
(RPLACD PREV
(CDR CURRENT]])
(\VFMCorrectBufferP
[LAMBDA (BUFFER VOLPAGENUM) (* hts: " 9-Jan-85 18:20")
(* * True iff BUFFER is the right buffer for VOLPAGENUM)
(AND (EQ (fetch (\BTREEBUF VOLUME) of BUFFER)
\VFMvolumeHandle)
(EQ (fetch (\BTREEBUF VOLPAGENUM) of BUFFER)
VOLPAGENUM])
(\VFMMarkBufferDirty
[DLAMBDA ((BUFFERPAGE Buffer)
(RETURNS NIL))
(* hts: "25-Jan-85 11:44")
(* * Note that the specified buffer has been written into and will have to be flushed out to disk.)
(replace (\BTREEBUF DIRTY) of (for BUF in \VFMbufferPool thereis (EQ BUFFERPAGE
(fetch (\BTREEBUF PAGE)
of BUF)))
with T)
NIL])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VFMbufferPool \VFMbufferSize \VFMbuffer \VFMxtraBuffer)
)
(RPAQ? \VFMbufferSize 10)
(* * Interval cache interface)
(DEFINEQ
(\VFMCreateIntervals
[LAMBDA NIL (* hts: " 5-Jan-85 16:25")
(* * Conditionally create array to hold interval cache for each volume. Conditional so that loadfroming this file
will not destroy state.)
(* * Interval cache for each volume keeps a finger into the BTree: traces a correct path through the BTree, which
need be only partially backtracked (if at all) to find any given interval in the BTree. Saves reading one page at
each level of the BTree every time you want to look for an interval.)
(if [NOT (AND (BOUNDP (QUOTE \VFMintervals))
(type? ARRAYP \VFMintervals)
(ZEROP (ARRAYORIG \VFMintervals))
(EQ maxLogicalVolumes (ARRAYSIZE \VFMintervals]
then (SETQ \VFMintervals (ARRAY maxLogicalVolumes NIL NIL 0])
(\VFMClearIntervals
[LAMBDA NIL (* hts: " 5-Jan-85 16:25")
(* * Clears the BTree interval cache so that it will be correctly reinitialized should this lisp image wake up on an
alien machine)
(for volume from 0 to (SUB1 maxLogicalVolumes) do (SETA \VFMintervals volume NIL])
(\VFMGetInterval
[LAMBDA NIL (* hts: "26-Jan-85 18:56")
(* * Returns the interval cache for the current volume. If this interval cache is empty, initializes with a leftmost
path through the BTree for that volume.)
(PROG ((volNum (\PFVolumeNumber \VFMvolumeHandle)))
(RETURN (OR (ELT \VFMintervals volNum)
(SETA \VFMintervals volNum
(bind (intervalArray ←(ARRAY treeDepth NIL NIL 0))
(BTreePageNum ←(fetch (LogicalVolumeDescriptor vfmStart)
of \VFMvolumeHandle))
for level from (SUB1 treeDepth) to 0 by -1
do (SETQ \VFMbuffer (\VFMGetBufferFor BTreePageNum))
[SETQ BTreePageNum
(fetch (Interval volumePage)
of (SETA intervalArray level
(create Interval
key ← \VFMnullKey
volumePage ←(fetch (Index volumePage)
of \VFMbuffer)
nextKey ←(fetch (Index key) of \VFMbuffer]
finally (RETURN intervalArray])
(\VFMBlankInterval
[LAMBDA NIL (* hts: "26-Jan-85 18:57")
(* * Returns the interval cache for the current volume. If this interval cache is empty, initializes with a blank
set of intervals with InitMap will fill with a leftmost path through the BTree for that volume.)
(* * Should be called by InitMap only.)
(PROG ((volNum (\PFVolumeNumber \VFMvolumeHandle)))
(RETURN (OR (ELT \VFMintervals volNum)
(SETA \VFMintervals volNum (PROG ((intervalCache (ARRAY treeDepth NIL NIL 0)))
(for level from 0 to (SUB1 treeDepth)
do (SETA intervalCache level (create
Interval)))
(RETURN intervalCache])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \VFMintervals)
)
(* * BLT routine that doesn't stomp on itself for overlapping intervals)
(DEFINEQ
(\VFMSmartBLT
[LAMBDA (DBASE SBASE NWORDS) (* hts: "24-Jun-84 15:57")
(* This is necessary because \BLT will not copy
overlapping intervals correctly in one direction.)
(if (AND (PTRGTP SBASE DBASE)
(PTRGTP (\ADDBASE DBASE NWORDS)
SBASE))
then (for i from 0 to (SUB1 NWORDS) do (\PUTBASE DBASE i (\GETBASE SBASE i)))
DBASE
else (\BLT DBASE SBASE NWORDS])
)
(* * Loading initialization)
(DEFINEQ
(\VFMAtLoad
[LAMBDA NIL (* hts: "25-Jan-85 11:50")
(* * Initialize global variables for the volume file map)
(SETQ \VFMmaxID -1)
(SETQ \VFMmaxKey (create Key
fileID ← \VFMmaxID
filePage ← lastPageNumber))
(SETQ \VFMnullKey (create Key))
(SETQ \VFMvolumeHandle NIL)
(SETQ \VFMinterval (create Interval))
(SETQ \VFMold (create Index))
(SETQ \VFMlow (create Index))
(SETQ \VFMhigh (create Index))
(SETQ \VFMoldPtr 0)
(SETQ \VFMlowPtr 0)
(SETQ \VFMhighPtr 0)
(\VFMCreateIntervals)
(SETQ \VFMmonitor (CREATE.MONITORLOCK (QUOTE \VFMmonitor])
)
(\VFMAtLoad)
(PUTPROPS LFFILEMAP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3406 4068 (ShowIntervals 3416 . 4066)) (4342 4759 (\VFMInit 4352 . 4757)) (4840 16922 (
\VFMDeletePageGroup 4850 . 12289) (\VFMGetPageGroup 12291 . 14131) (\VFMInsertPageGroup 14133 . 16920)
) (17002 39086 (\VFMContextSet 17012 . 17336) (\VFMCreateVPage 17338 . 18130) (\VFMDelete 18132 .
19777) (\VFMDelete1 19779 . 20845) (\VFMDelete2 20847 . 22013) (\VFMFind 22015 . 23525) (\VFMFreeVPage
23527 . 24270) (\VFMGet 24272 . 25636) (\VFMGet1 25638 . 26260) (\VFMInsert 26262 . 27176) (
\VFMInsert1 27178 . 28561) (\VFMLower 28563 . 29712) (\VFMMerge 29714 . 31294) (\VFMMerge1 31296 .
34271) (\VFMPutNext 34273 . 35613) (\VFMReadNext 35615 . 36805) (\VFMSplit 36807 . 37565) (\VFMSplit1
37567 . 39084)) (39307 43620 (\VFMGetBufferFor 39317 . 40903) (\VFMSaveBuffer 40905 . 41669) (
\VFMClearBuffers 41671 . 41869) (\VFMKillBuffer 41871 . 42763) (\VFMCorrectBufferP 42765 . 43122) (
\VFMMarkBufferDirty 43124 . 43618)) (43795 47051 (\VFMCreateIntervals 43805 . 44703) (
\VFMClearIntervals 44705 . 45087) (\VFMGetInterval 45089 . 46225) (\VFMBlankInterval 46227 . 47049)) (
47195 47765 (\VFMSmartBLT 47205 . 47763)) (47801 48574 (\VFMAtLoad 47811 . 48572)))))
STOP