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