// 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
]