// IfsBTreeSwap.bcpl -- Swappable portion of IFS interface to B-Tree package
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified November 26, 1981 12:19 PM by Taft
get "BTree.decl"
get "IfsVMem.decl"
get "AltoFileSys.d"
get "Disks.d"
external
[
// Outgoing procedures
OpenFPTree; FlushBTreeState
BtAllocPage; BtFreePage; CloseIFSTree
ReadBTreePage; WriteBTreePage; LockBTreePtr; UnlockBTreePtr
AllocateBTreePage; FreeBTreePage; BTreeBug; CloseBTree
// Incoming procedures
SysAllocate; SysAllocateZero; SysFree; MoveBlock; DefaultArgs
BVWRP; BVRRP; BtLockCell; BtUnlockCell
OpenVFileFromFP; CloseVFile; PurgeVMem; CallProc
IFSError; Usc; Enqueue; Unqueue; Max; SysErr
Call0; Call1; Call2; Call3; Call4; Call5; Call6; Call7
// Outgoing statics
lenFMap
// Incoming statics
sysZone
]
static
[
btQ
ReadBTreePage; WriteBTreePage; LockBTreePtr; UnlockBTreePtr
AllocateBTreePage; FreeBTreePage; BTreeBug; CloseBTree
lenFMap = 100
]
//----------------------------------------------------------------------------
structure IFSTREE: // BTree as Queue Element
//----------------------------------------------------------------------------
[
link word
tree @TREE
]
//----------------------------------------------------------------------------
structure FCE: // Free chain entry for disk pages of a B-Tree file
//----------------------------------------------------------------------------
[
FreeMarker word // negative if page is free; shares storage
// with BTP>>FreeWords
next word // next page on free list - 0 means none
]
manifest
[
pageQuantum = 20 // must be a multiple of 4
]
//----------------------------------------------------------------------------
let OpenFPTree(fp, disk, CompareKeyRtn, LengthRtn, initializeTree,
diskPages, logBTreePageLength; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -4, false, 2048, disk>>DSK.lnPageSize)
let qTree = SysAllocate(size IFSTREE/16)
let tree = lv (qTree>>IFSTREE.tree)
tree>>TREE.CompareKeyRtn = CompareKeyRtn
tree>>TREE.LengthRtn = LengthRtn
tree>>TREE.BVRRP = BVRRP
tree>>TREE.BVWRP = BVWRP
tree>>TREE.BVAP = BtAllocPage
tree>>TREE.BVFP = BtFreePage
tree>>TREE.BLockCell = BtLockCell
tree>>TREE.BUnlockCell = BtUnlockCell
tree>>TREE.BTClose = CloseIFSTree
tree>>TREE.BTBug = SysErr
ReadBTreePage = Call0
WriteBTreePage = Call1
LockBTreePtr = Call2
UnlockBTreePtr = Call3
AllocateBTreePage = Call4
FreeBTreePage = Call5
BTreeBug = Call6
CloseBTree = Call7
tree>>TREE.Zone = sysZone
tree>>TREE.vmd = OpenVFileFromFP(fp, disk, diskPages, lenFMap, true)
test initializeTree
ifso
[
SetBTreePageLength(tree, logBTreePageLength)
tree>>TREE.RootPage = 1
tree>>TREE.GreatestPage = 1
tree>>TREE.FirstFreePage = Empty
tree>>TREE.RecordCount = 0
let statePageP = WriteBTreePage(tree, 0, 0, true)
MoveBlock(lv statePageP>>TS, lv tree>>TREE.TS, lTS)
let rootPageP = WriteBTreePage(tree, 1, 0, true)
rootPageP>>BTP.MinPtr = Empty
rootPageP>>BTP.FreeWords = tree>>TREE.PageLength-PageOverhead
]
ifnot // copy tree state from state page
[
SetBTreePageLength(tree, disk>>DSK.lnPageSize) // until open
let statePageP = ReadBTreePage(tree, 0)
MoveBlock(lv tree>>TREE.TS, lv statePageP>>TS, lTS)
// Must invalidate the hash map before changing page group size
PurgeVMem(tree>>TREE.vmd)
if tree>>TREE.LogPageLength ne 0 then
SetBTreePageLength(tree, tree>>TREE.LogPageLength)
]
tree>>TREE.StateDirty = false
if btQ eq 0 then btQ = SysAllocateZero(2)
Enqueue(btQ, qTree)
resultis tree
]
//----------------------------------------------------------------------------
and SetBTreePageLength(tree, logBTreePageLength) be
//----------------------------------------------------------------------------
// Sets the "logical" page length in the tree and in its vmd, and
// sets the page group size to be the greater of the number
// of vmem pages per disk page and the number of vmem pages
// per logical B-Tree page.
[
tree>>TREE.LogPageLength = logBTreePageLength
tree>>TREE.PageLength = 1 lshift logBTreePageLength
tree>>TREE.vmd>>FVMD.logPageGroupSize = Max(
logBTreePageLength - logVMPageLength,
tree>>TREE.vmd>>FVMD.logVPagesPerDiskPage)
]
//----------------------------------------------------------------------------
and CloseIFSTree(tree) = valof
//----------------------------------------------------------------------------
[
Unqueue(btQ, tree-(offset IFSTREE.tree/16))
WriteStatePage(tree)
CloseVFile(tree>>TREE.vmd)
resultis SysFree(tree-(offset IFSTREE.tree/16))
]
//----------------------------------------------------------------------------
and FlushBTreeState() be
//----------------------------------------------------------------------------
[
let qTree = btQ!0
while qTree ne 0 do
[
WriteStatePage(lv qTree>>IFSTREE.tree)
qTree = qTree>>IFSTREE.link
]
]
//----------------------------------------------------------------------------
and WriteStatePage(tree) be
//----------------------------------------------------------------------------
[
if tree>>TREE.StateDirty then
[
let statePageP = WriteBTreePage(tree, 0)
MoveBlock(lv statePageP>>TS, lv tree>>TREE.TS, lTS)
tree>>TREE.StateDirty = false
]
]
//----------------------------------------------------------------------------
and BtAllocPage(tree) = valof
//----------------------------------------------------------------------------
[
if tree>>TREE.FirstFreePage eq Empty then
[
let gp = tree>>TREE.GreatestPage
let ngp = gp+pageQuantum
tree>>TREE.GreatestPage = ngp
for newFreePage = gp+1 to ngp do CallProc(FreeBTreePage, tree, newFreePage)
]
let newPage = tree>>TREE.FirstFreePage
let page = WriteBTreePage(tree, newPage, 0, true)
tree>>TREE.FirstFreePage = page>>FCE.next
page>>FCE.FreeMarker = 0
tree>>TREE.StateDirty = true
resultis newPage
]
//----------------------------------------------------------------------------
and BtFreePage(tree, freePage) be
//----------------------------------------------------------------------------
[
let page = WriteBTreePage(tree, freePage, 0, true)
page>>FCE.next = tree>>TREE.FirstFreePage
page>>FCE.FreeMarker = -1
tree>>TREE.FirstFreePage = freePage
tree>>TREE.StateDirty = true
]