<> <> <> DIRECTORY BTree, BTreeInternal, PrincOpsUtils USING [LongCopy, LongMove]; BTreeWrite: PROGRAM IMPORTS BTree, BTreeInternal, PrincOpsUtils EXPORTS BTree, BTreeInternal = BEGIN OPEN BTree, BTreeInternal; <> Tree: TYPE = REF TreeObject; TreeObject: PUBLIC TYPE = BTreeInternal.TreeObject; PathStk: TYPE = REF PathStkObject; PathStkObject: PUBLIC TYPE = BTreeInternal.PathStkObject; UpdateRecord: PUBLIC SAFE PROCEDURE [tree: Tree, key: Key, pathStk: PathStk _ NIL, useExistingPath: BOOLEAN _ FALSE, record: Record, updateType: UpdateType _ insertOrReplace] = TRUSTED BEGIN ProduceEntry: PROCEDURE [entry: Entry] = {PrincOpsUtils.LongCopy[to: entry, from: tree.EntryFromRecord[record], nwords: words]}; words: EntSize = tree.EntrySize[tree.EntryFromRecord[record]]; UpdateEntry[tree: tree, key: key, pathStk: pathStk, useExistingPath: useExistingPath, words: words, Proc: ProduceEntry, updateType: updateType]; END; UpdateEntry: PUBLIC PROCEDURE [tree: Tree, key: Key, pathStk: PathStk _ NIL, useExistingPath: BOOLEAN _ FALSE, words: EntSize, Proc: UNSAFE PROCEDURE [entry: Entry], updateType: UpdateType _ insertOrReplace] = BEGIN CallEntryProc: PROCEDURE [entry: Entry] = BEGIN Proc[entry]; IF tree.EntrySize[entry]#words OR tree.Compare[key, entry]#equal THEN ERROR Error[wrongEntryProduced]; END; pathStkWasNil: BOOLEAN _ pathStk=NIL; tree.Lock[update]; IF pathStkWasNil THEN BEGIN IF useExistingPath THEN ERROR Error[nilPathStk]; pathStk _ tree.GetDefaultPathStk[]; END; <> BEGIN ENABLE UNWIND => {IF pathStkWasNil THEN tree.ReturnDefaultPathStk[pathStk]; tree.Unlock[]}; leafStkTop: PathStkIndex; equal: BOOLEAN; pse: LONG POINTER TO PathStkEntry; pagePtr: BTreePagePtr _ NIL; foundEntSize: CARDINAL _ 0; -- zero means there is not an existing entry with this key IF CARDINAL[words+entryOverhead] NOT IN [1+entryOverhead..tree.maxFreeWords] THEN ERROR Error[entrySizesWrong]; [equal: equal, depth: leafStkTop] _ tree.PathEntryLE[key: key, pathStk: pathStk, useExistingPath: useExistingPath]; IF equal THEN BEGIN IF updateType=insert THEN ERROR Error[wrongUpdateType]; [pse: pse, ptr: pagePtr] _ tree.ReferenceStack[pathStk]; foundEntSize _ tree.EntrySize[@pagePtr[pse.lastOffset].entry]; tree.ReleasePage[pse.pageNumber]; END ELSE IF updateType=replace THEN ERROR Error[wrongUpdateType]; <> <<1. If replacing an existing entry of the same size, just overwrite it.>> <<2. If the new entry fits on the page (after removing the old entry if any), just slide up the entries beyond the insertion point and insert the new entry.>> <<3. Otherwise, leave the new entry as an EntSeqRecord at the appropriate stack level, and let InsertRecords cope with the problem.>> <> tree.version _ tree.version+1; -- invalidate existing PathStks that refer to this tree pse _ @pathStk.path[pathStk.top]; IF words=foundEntSize THEN BEGIN -- new record same length as old; just copy it over tree.AdjustTreeState[update: unchanged, deltaEntryCount: 0]; pagePtr _ tree.ReferencePage[pse.pageNumber, write]; CallEntryProc[@pagePtr[pse.lastOffset].entry]; tree.ReleasePage[pse.pageNumber, IF tree.longUpdate THEN unchanged ELSE endOfUpdate]; END ELSE BEGIN removedEntGrPage: PageNumber _ nilPage; newEntryFits: BOOLEAN _ FALSE; IF foundEntSize=0 THEN BEGIN -- no old entry to remove, and we will insert at the leaf level pathStk.top _ leafStkTop; pse _ @pathStk.path[pathStk.top]; END; <> IF pathStk.top>0 THEN BEGIN pagePtr _ tree.ReferencePage[pse.pageNumber]; newEntryFits _ CARDINAL[words+entryOverhead] <= CARDINAL[pagePtr.freeWords + (IF foundEntSize=0 THEN 0 ELSE foundEntSize+entryOverhead)]; tree.ReleasePage[pse.pageNumber]; END; tree.AdjustTreeState[update: IF newEntryFits THEN unchanged ELSE startOfUpdate, deltaEntryCount: IF foundEntSize=0 THEN 1 ELSE 0]; IF pathStk.top>0 THEN pagePtr _ tree.ReferencePage[pse.pageNumber, write]; IF foundEntSize#0 THEN <> [grPage: removedEntGrPage] _ tree.BackUpAndRemoveEntry[pse]; IF newEntryFits THEN BEGIN -- new entry fits on the page; slide the greater entries out of the way and drop the new entry in entPtr: LONG POINTER TO BTreeEntry _ @pagePtr[pse.offset]; LongMove[to: entPtr+words+entryOverhead, from: entPtr, nWords: nilOffset+(tree.state.pageSize-pagePtr.freeWords)-pse.offset]; CallEntryProc[@entPtr.entry]; entPtr.grPage _ removedEntGrPage; pagePtr.freeWords _ pagePtr.freeWords - (words+entryOverhead); tree.ReleasePage[pse.pageNumber, IF tree.longUpdate THEN unchanged ELSE endOfUpdate]; END ELSE BEGIN -- new entry does not fit (or there isn't yet a page to fit it into) esr: REF EntSeqRecord _ NEW[EntSeqRecord[words+entryOverhead]]; esr.entSeqP _ LOOPHOLE[BASE[DESCRIPTOR[esr.entSeq]]]; esr.entSeqLen _ words+entryOverhead; CallEntryProc[@esr.entSeqP.entry]; esr.entSeqP.grPage _ removedEntGrPage; AppendEntSeqRecord[pse: pse, esr: esr]; IF pathStk.top>0 THEN tree.ReleasePage[pse.pageNumber]; tree.GetHeapAndTable[pathStk]; WHILE pathStk.path[pathStk.top].eslFront#NIL DO tree.InsertRecords[pathStk ! UNWIND => tree.ReturnHeapAndTable[pathStk]]; IF pathStk.top=0 THEN EXIT ELSE pathStk.top _ pathStk.top-1; ENDLOOP; tree.ReturnHeapAndTable[pathStk]; tree.AdjustTreeState[update: endOfUpdate, deltaEntryCount: 0]; END; END; END; IF pathStkWasNil THEN tree.ReturnDefaultPathStk[pathStk]; tree.Unlock[]; END; SetUpdateInProgress: PUBLIC SAFE PROCEDURE [tree: Tree, updateInProgress: BOOLEAN] = TRUSTED BEGIN tree.Lock[update]; tree.longUpdate _ updateInProgress; tree.AdjustTreeState[update: IF updateInProgress THEN startOfUpdate ELSE endOfUpdate, deltaEntryCount: 0]; tree.Unlock[]; END; <> AdjustTreeState: PUBLIC PROCEDURE [tree: Tree, update: UpdateState, deltaEntryCount: INTEGER] = BEGIN IF tree.maintainRecomputableState THEN BEGIN -- normal update IF tree.state.entryCount#LAST[LONG CARDINAL] THEN tree.state.entryCount _ tree.state.entryCount+deltaEntryCount; IF update#unchanged AND ~(tree.state.updateInProgress AND tree.longUpdate) THEN BEGIN tree.state.updateInProgress _ update=startOfUpdate OR tree.longUpdate; tree.WriteStatePage[update: update]; END; END ELSE IF deltaEntryCount#0 AND tree.state.entryCount#LAST[LONG CARDINAL] THEN BEGIN -- remember that the entryCount is no longer being maintained tree.state.entryCount _ LAST[LONG CARDINAL]; tree.WriteStatePage[]; END; END; InsertRecords: PUBLIC PROCEDURE [tree: Tree, pathStk: PathStk] = BEGIN pse: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top]; IF pse.eslFront#NIL THEN BEGIN pathStk.entryTable.length _ 0; pathStk.entryTable.map[0].cumEntSize _ 0; FOR esr: REF EntSeqRecord _ pse.eslFront, esr.fwdP UNTIL esr=NIL DO AppendEntSeqLengths[tree: tree, pathStk: pathStk, esr: esr]; ENDLOOP; IF pathStk.top=0 THEN MakeNewRoot[tree: tree, pathStk: pathStk] ELSE BEGIN pagePtr: BTreePagePtr = tree.ReferencePage[pse.pageNumber, write]; tailBlkPtr: LONG POINTER TO BTreeEntry = @pagePtr[pse.offset]; tailBlkLen: CARDINAL = (nilOffset+tree.state.pageSize-pagePtr.freeWords)-pse.offset; wordsToInsert: CARDINAL = EntryIntervalSize[pathStk: pathStk]; IF wordsToInsert<=pagePtr.freeWords THEN BEGIN -- all entries fit the current page. Hurrah! LongMove[to: tailBlkPtr+wordsToInsert, from: tailBlkPtr, nWords: nilOffset+(tree.state.pageSize-pagePtr.freeWords)-pse.offset]; DepositESL[tree: tree, pse: pse, block: tailBlkPtr, length: wordsToInsert]; pagePtr.freeWords _ pagePtr.freeWords-wordsToInsert; tree.ReleasePage[pse.pageNumber]; END ELSE BEGIN -- not all the entries will fit on the current page. This is getting complex. rtBroPg1: PageNumber; esr: REF EntSeqRecord _ MakeEntSeqRecord[@pagePtr[entry1Offset], pse.offset-entry1Offset]; PushEntSeqRecord[pse: pse, esr: esr]; PushEntSeqLengths[tree: tree, pathStk: pathStk, esr: esr]; esr _ MakeEntSeqRecord[tailBlkPtr, tailBlkLen]; AppendEntSeqRecord[pse: pse, esr: esr]; AppendEntSeqLengths[tree: tree, pathStk: pathStk, esr: esr]; tree.ReleasePage[pse.pageNumber]; rtBroPg1 _ ComplexInsertRecords[tree: tree, pathStk: pathStk]; IF rtBroPg1#nilPage THEN HairyInsertRecords[tree: tree, pathStk: pathStk, rtBroPg1: rtBroPg1]; END; END; IF pse.eslFront#NIL THEN ERROR Bug[entriesLeftOver]; END; END; MakeEntSeqRecord: PUBLIC PROCEDURE [entSeq: LONG POINTER TO BTreeEntry, length: CARDINAL] RETURNS [esr: REF EntSeqRecord] = BEGIN IF length=0 THEN RETURN [NIL]; esr _ NEW[EntSeqRecord[length]]; esr.entSeqP _ LOOPHOLE[BASE[DESCRIPTOR[esr.entSeq]]]; esr.entSeqLen _ length; PrincOpsUtils.LongCopy[to: esr.entSeqP, from: entSeq, nwords: length]; END; AppendEntSeqRecord: PUBLIC PROCEDURE [pse: LONG POINTER TO PathStkEntry, esr: REF EntSeqRecord] = BEGIN IF esr#NIL THEN BEGIN esr.fwdP _ NIL; IF pse.eslRear=NIL THEN AssignRefESR[@pse.eslFront, esr] ELSE pse.eslRear.fwdP _ esr; AssignRefESR[@pse.eslRear, esr]; END; END; PushEntSeqRecord: PUBLIC PROCEDURE [pse: LONG POINTER TO PathStkEntry, esr: REF EntSeqRecord] = BEGIN IF esr#NIL THEN BEGIN esr.fwdP _ pse.eslFront; AssignRefESR[@pse.eslFront, esr]; IF pse.eslRear=NIL THEN AssignRefESR[@pse.eslRear, esr]; END; END; RemoveEntry: PUBLIC PROCEDURE [tree: Tree, pse: LONG POINTER TO PathStkEntry, ignoreESL: BOOLEAN _ FALSE] RETURNS [esr: REF EntSeqRecord, grPage: PageNumber] = BEGIN BasicRemoveEntry: PROCEDURE RETURNS [esr: REF EntSeqRecord] = <> BEGIN pagePtr: BTreePagePtr = tree.ReferencePage[pse.pageNumber, write]; entSize: CARDINAL = tree.BTreeEntrySize[@pagePtr[pse.offset]]; esr _ MakeEntSeqRecord[entSeq: @pagePtr[pse.offset], length: entSize]; pagePtr.freeWords _ pagePtr.freeWords+entSize; PrincOpsUtils.LongCopy[to: @pagePtr[pse.offset], from: @pagePtr[pse.offset]+entSize, nwords: nilOffset+(tree.state.pageSize-pagePtr.freeWords)-pse.offset]; tree.ReleasePage[pse.pageNumber]; END; RemoveFromEntSeqRecord: PROCEDURE RETURNS [esr: REF EntSeqRecord] = <> BEGIN entSize: CARDINAL = tree.BTreeEntrySize[pse.eslFront.entSeqP]; esr _ NEW[EntSeqRecord[entSize]]; esr.entSeqP _ LOOPHOLE[BASE[DESCRIPTOR[esr.entSeq]]]; esr.entSeqLen _ entSize; DepositESL[tree: tree, pse: pse, block: esr.entSeqP, length: entSize]; END; esr _ IF ignoreESL OR pse.eslFront=NIL THEN BasicRemoveEntry[] ELSE RemoveFromEntSeqRecord[]; grPage _ esr.entSeqP.grPage; esr.entSeqP.grPage _ nilPage; IF grPage#nilPage THEN BEGIN pagePtr: BTreePagePtr = tree.ReferencePage[grPage]; esr.entSeqP.grPage _ pagePtr.minPage; tree.ReleasePage[grPage]; END; END; BackUpAndRemoveEntry: PUBLIC PROCEDURE [tree: Tree, pse: LONG POINTER TO PathStkEntry] RETURNS [esr: REF EntSeqRecord, grPage: PageNumber] = BEGIN tree.BackUpOneEntry[pse]; [esr: esr, grPage: grPage] _ tree.RemoveEntry[pse: pse, ignoreESL: TRUE]; END; AllocatePage: PUBLIC SAFE PROCEDURE [tree: Tree] RETURNS [number: PageNumber] = TRUSTED BEGIN pagePtr: BTreePagePtr; IF tree.state.firstFreePage=nilPage THEN BEGIN number _ (tree.state.greatestPage _ tree.state.greatestPage+1); pagePtr _ tree.ReferencePage[number, new]; END ELSE BEGIN number _ tree.state.firstFreePage; pagePtr _ tree.ReferencePage[number, write]; IF pagePtr.freeWords#freePageMarker THEN ERROR Bug[pageNotFree]; tree.state.firstFreePage _ pagePtr.minPage; END; pagePtr.freeWords _ tree.maxFreeWords; tree.ReleasePage[number]; END; FreePage: PUBLIC SAFE PROCEDURE [tree: Tree, number: PageNumber] = TRUSTED BEGIN pagePtr: BTreePagePtr = tree.ReferencePage[number, write]; IF pagePtr.freeWords=freePageMarker THEN ERROR Bug[pageAlreadyFree]; pagePtr.freeWords _ freePageMarker; pagePtr.minPage _ tree.state.firstFreePage; tree.state.firstFreePage _ number; tree.ReleasePage[number]; END; LongMove: PUBLIC PROCEDURE [to, from: LONG POINTER, nWords: CARDINAL] = BEGIN PrincOpsUtils.LongMove[to: to, from: from, nwords: nWords]; END; <> AppendEntSeqLengths: PROCEDURE [tree: Tree, pathStk: PathStk, esr: REF EntSeqRecord] = <> BEGIN IF esr#NIL THEN BEGIN entryTable: REF EntryTable _ pathStk.entryTable; index: EntryOrdinal _ entryTable.length; wordsLeft: CARDINAL _ esr.entSeqLen; entry: LONG POINTER TO BTreeEntry _ esr.entSeqP; WHILE wordsLeft>0 DO entrySize: CARDINAL = tree.BTreeEntrySize[entry]; index _ index+1; IF index >= entryTable.maxLength THEN ERROR Bug[tooManyEntriesInPage]; entryTable.map[index].cumEntSize _ entryTable.map[index-1].cumEntSize+entrySize; entry _ entry+entrySize; wordsLeft _ wordsLeft-entrySize; ENDLOOP; entryTable.length _ index; END; END; PushEntSeqLengths: PROCEDURE [tree: Tree, pathStk: PathStk, esr: REF EntSeqRecord] = <> BEGIN IF esr#NIL THEN BEGIN entryTable: REF EntryTable = pathStk.entryTable; oldLen: EntryOrdinal = entryTable.length; tempFirstOldIndex: EntryOrdinal = entryTable.maxLength-oldLen; newLen: EntryOrdinal; delta: CARDINAL; <> LongMove[to: @entryTable.map[tempFirstOldIndex], from: @entryTable.map[1], nWords: oldLen*SIZE[EntryTableRec]]; <> entryTable.length _ 0; AppendEntSeqLengths[tree: tree, pathStk: pathStk, esr: esr]; newLen _ entryTable.length; IF newLen >= tempFirstOldIndex THEN ERROR Bug[tooManyEntriesInPage]; entryTable.length _ newLen+oldLen; <> delta _ entryTable.map[newLen].cumEntSize; FOR i: EntryOrdinal IN [0..oldLen) DO entryTable.map[newLen+1+i].cumEntSize _ entryTable.map[tempFirstOldIndex+i].cumEntSize+delta; ENDLOOP; END; END; DepositESL: PROCEDURE [tree: Tree, pse: LONG POINTER TO PathStkEntry, block: LONG POINTER TO BTreeEntry, length: CARDINAL] = <> BEGIN WHILE length#0 AND pse.eslFront#NIL DO esr: REF EntSeqRecord _ pse.eslFront; entSeqP: LONG POINTER TO BTreeEntry = esr.entSeqP; IF esr.entSeqLen <= length THEN BEGIN PrincOpsUtils.LongCopy[to: block, from: entSeqP, nwords: esr.entSeqLen]; block _ block+esr.entSeqLen; length _ length-esr.entSeqLen; AssignRefESR[@pse.eslFront, esr.fwdP]; esr.fwdP _ NIL; END ELSE BEGIN firstEntSize: CARDINAL = tree.BTreeEntrySize[entSeqP]; IF firstEntSize <= length THEN BEGIN PrincOpsUtils.LongCopy[to: block, from: entSeqP, nwords: firstEntSize]; block _ block+firstEntSize; length _ length-firstEntSize; esr.entSeqP _ entSeqP+firstEntSize; esr.entSeqLen _ esr.entSeqLen-firstEntSize; END ELSE ERROR Bug[depositESL]; -- block would end in middle of entry END; ENDLOOP; IF length#0 THEN ERROR Bug[depositESL]; -- ESL exhausted IF pse.eslFront=NIL THEN AssignRefESR[@pse.eslRear, NIL]; END; EntryIntervalSize: PROCEDURE [pathStk: PathStk, leftFather, rightFather: EntryOrdinal _ 0] RETURNS [words: CARDINAL] = <> BEGIN IF rightFather=0 THEN rightFather _ pathStk.entryTable.length+1; RETURN [pathStk.entryTable.map[rightFather-1].cumEntSize - pathStk.entryTable.map[leftFather].cumEntSize]; END; <> <> MakeNewRoot: PROCEDURE [tree: Tree, pathStk: PathStk] = <> BEGIN wordsToInsert: CARDINAL = EntryIntervalSize[pathStk: pathStk, leftFather: 0]; newRootPage: PageNumber = tree.AllocatePage[]; pagePtr: BTreePagePtr = tree.ReferencePage[newRootPage, write]; IF tree.state.depth >= maxLevelsInTree THEN ERROR Error[depthExceeded]; pagePtr.minPage _ pathStk.path[0].leastSon; tree.ReleasePage[newRootPage]; IF wordsToInsert > tree.maxFreeWords THEN ERROR Bug[newRootOverflow]; WritePage[tree: tree, pse: @pathStk.path[0], number: newRootPage, words: wordsToInsert]; tree.state.rootPage _ newRootPage; tree.state.depth _ tree.state.depth+1; END; ComplexInsertRecords: PROCEDURE [tree: Tree, pathStk: PathStk] RETURNS [rtBroPg1: PageNumber] = <> BEGIN pse: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top]; fatherPSE: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top-1]; entryTable: REF EntryTable = pathStk.entryTable; oneBrotherEnough: BOOLEAN _ FALSE; fatherIndex, bestFatherIndex: EntryOrdinal; bestFatherSize: CARDINAL _ tree.maxFreeWords+1; fatherPSE.leastSon _ pse.pageNumber; -- in case this is the root page splitting rtBroPg1 _ nilPage; IF pathStk.top>1 THEN BEGIN rtBroPg1 _ FindRightBrother[tree: tree, pathStk: pathStk, spaceNeeded: -tree.maxFreeWords]; IF rtBroPg1=nilPage THEN <> rtBroPg1 _ FindLeftBrother[tree: tree, pathStk: pathStk, spaceNeeded: -tree.maxFreeWords]; END; IF rtBroPg1=nilPage THEN rtBroPg1 _ tree.AllocatePage[]; <> IF entryTable.length<3 THEN ERROR Bug[tooFewEntries]; -- there must be at least one entry each from this page, the brother page, and the father page fatherIndex _ FillLeftPage[tree: tree, pathStk: pathStk]; <> DO pl0, pl1, fatherSize: CARDINAL; pl1 _ EntryIntervalSize[pathStk: pathStk, leftFather: fatherIndex]; IF pl1 > tree.maxFreeWords THEN EXIT; pl0 _ EntryIntervalSize[pathStk: pathStk, rightFather: fatherIndex]; IF pl0=0 OR pl0+pl1 > tree.maxFreeWords+tree.awfullyFull THEN EXIT; <> fatherSize _ IndexedEntrySize[pathStk: pathStk, index: fatherIndex]; IF fatherSize> BEGIN AddToHeap: PROCEDURE [entry: EntryOrdinal] = BEGIN heap.length _ heap.length+1; TrickleDown[emptyIndex: heap.length, entry: entry]; END; -- AddToHeap RemoveFromHeap: PROCEDURE [entry: EntryOrdinal] = BEGIN heapPos: HeapIndex = entryTable.map[entry].heapPos; heap.length _ heap.length-1; IF heapPos <= heap.length THEN BEGIN replacementEntry: EntryOrdinal = heap.entries[heap.length+1]; IF IndexedEntrySize[pathStk: pathStk, index: replacementEntry] <= IndexedEntrySize[pathStk: pathStk, index: entry] THEN TrickleDown[emptyIndex: heapPos, entry: replacementEntry] ELSE SiftUp[emptyIndex: heapPos, entry: replacementEntry]; END; END; -- RemoveFromHeap TrickleDown: PROCEDURE [emptyIndex: HeapIndex, entry: EntryOrdinal] = BEGIN sonSize: CARDINAL = IndexedEntrySize[pathStk: pathStk, index: entry]; son: HeapIndex _ emptyIndex; DO father: HeapIndex _ son/2; fatherEnt: EntryOrdinal; IF father<=0 THEN EXIT; fatherEnt _ heap.entries[father]; IF IndexedEntrySize[pathStk: pathStk, index: fatherEnt] <= sonSize THEN EXIT; heap.entries[son] _ fatherEnt; entryTable.map[fatherEnt].heapPos _ son; son _ father; ENDLOOP; heap.entries[son] _ entry; entryTable.map[entry].heapPos _ son; END; -- TrickleDown SiftUp: PROCEDURE [emptyIndex: HeapIndex, entry: EntryOrdinal] = BEGIN entrySize: CARDINAL = IndexedEntrySize[pathStk: pathStk, index: entry]; DO son: HeapIndex _ emptyIndex*2; sonEntry: EntryOrdinal; IF son > heap.length THEN EXIT; sonEntry _ heap.entries[son]; IF son < heap.length AND IndexedEntrySize[pathStk: pathStk, index: heap.entries[son+1]] < IndexedEntrySize[pathStk: pathStk, index: sonEntry] THEN { son _ son+1; sonEntry _ heap.entries[son] }; IF IndexedEntrySize[pathStk: pathStk, index: sonEntry] >= entrySize THEN EXIT; heap.entries[emptyIndex] _ sonEntry; entryTable.map[sonEntry].heapPos _ emptyIndex; emptyIndex _ son; ENDLOOP; heap.entries[emptyIndex] _ entry; entryTable.map[entry].heapPos _ emptyIndex; END; -- SiftUp entryTable: REF EntryTable = pathStk.entryTable; heap: REF Heap = pathStk.heap; pse: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top]; fatherPSE: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top-1]; -- father's pse rtBroPg2: PageNumber; fatherIndex, fatherIndex2, bestFatherIndex, bestFatherIndex2: EntryOrdinal; minFeasIndex, maxFeasIndex: EntryOrdinal; bestFatherSizeSum: CARDINAL _ 2*tree.maxFreeWords + 1; twoBrothersEnough: BOOLEAN _ FALSE; breakSize1, breakSize2, totalSize: CARDINAL; fatherESR: REF EntSeqRecord; <> fatherIndex _ FillLeftPage[tree: tree, pathStk: pathStk]; fatherIndex2 _ FillLeftPage[tree: tree, pathStk: pathStk, leftFather: fatherIndex]; <> rtBroPg2 _ FindRightBrother[tree: tree, pathStk: pathStk, spaceNeeded: EntryIntervalSize[pathStk: pathStk, leftFather: fatherIndex2] + 2*tree.breathingSpace]; IF rtBroPg2=nilPage THEN BEGIN -- no luck, try the left brother fe2: EntryOrdinal = FillRightPage[tree: tree, pathStk: pathStk]; fe: EntryOrdinal = FillRightPage[tree: tree, pathStk: pathStk, rightFather: fe2]; rtBroPg2 _ FindLeftBrother[tree: tree, pathStk: pathStk, spaceNeeded: EntryIntervalSize[pathStk: pathStk, leftFather: 0, rightFather: fe] + 2*tree.breathingSpace]; IF rtBroPg2=nilPage THEN rtBroPg2 _ tree.AllocatePage[] -- still no luck, allocate new page ELSE BEGIN -- left brother had space, but fatherIndexes are now invalid fatherIndex _ FillLeftPage[tree: tree, pathStk: pathStk]; fatherIndex2 _ FillLeftPage[tree: tree, pathStk: pathStk, leftFather: fatherIndex]; END; END; IF entryTable.length<5 THEN ERROR Bug[tooFewEntries]; -- there must be two entries from the father page and at least one entry each from this page and the two brother pages <> heap.length _ 0; maxFeasIndex _ fatherIndex2; WHILE EntryIntervalSize[pathStk: pathStk, leftFather: maxFeasIndex] <= tree.fairlyFull DO maxFeasIndex _ maxFeasIndex-1; ENDLOOP; minFeasIndex _ maxFeasIndex+1; WHILE EntryIntervalSize[pathStk: pathStk, rightFather: fatherIndex] > (IF twoBrothersEnough THEN tree.prettyFull ELSE 0) DO WHILE EntryIntervalSize[pathStk: pathStk, leftFather: fatherIndex, rightFather: minFeasIndex-1] > 0 AND EntryIntervalSize[pathStk: pathStk, leftFather: minFeasIndex-1] <= tree.maxFreeWords DO minFeasIndex _ minFeasIndex-1; IF minFeasIndex <= maxFeasIndex THEN AddToHeap[minFeasIndex]; ENDLOOP; WHILE EntryIntervalSize[pathStk: pathStk, leftFather: fatherIndex, rightFather: maxFeasIndex] > tree.maxFreeWords DO IF maxFeasIndex >= minFeasIndex THEN RemoveFromHeap[maxFeasIndex]; maxFeasIndex _ maxFeasIndex-1; ENDLOOP; IF heap.length>0 THEN BEGIN fatherSizeSum: CARDINAL; fatherIndex2 _ heap.entries[1]; fatherSizeSum _ IndexedEntrySize[pathStk: pathStk, index: fatherIndex] + IndexedEntrySize[pathStk: pathStk, index: fatherIndex2]; IF fatherSizeSum> breakSize1 _ EntryIntervalSize[pathStk: pathStk, rightFather: bestFatherIndex]; breakSize2 _ EntryIntervalSize[pathStk: pathStk, rightFather: bestFatherIndex2]; totalSize _ EntryIntervalSize[pathStk: pathStk]; WritePage[tree: tree, pse: pse, number: pse.pageNumber, words: breakSize1]; fatherESR _ WriteRightBrother[tree: tree, pse: pse, rtBroPg: rtBroPg1, words: breakSize2-breakSize1]; PushEntSeqRecord[pse: fatherPSE, esr: WriteRightBrother[tree: tree, pse: pse, rtBroPg: rtBroPg2, words: totalSize-breakSize2]]; PushEntSeqRecord[pse: fatherPSE, esr: fatherESR]; END; FindRightBrother: PROCEDURE [tree: Tree, pathStk: PathStk, spaceNeeded: INTEGER] RETURNS [rtBroPg: PageNumber] = <> BEGIN pse: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top]; fatherPSE: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top-1]; fatherEntSize: CARDINAL; pagePtr: BTreePagePtr; fatherESR, rtBroESR: REF EntSeqRecord; IF fatherPSE.eslFront=NIL THEN BEGIN pagePtr _ tree.ReferencePage[fatherPSE.pageNumber]; IF fatherPSE.offset = nilOffset+(tree.state.pageSize-pagePtr.freeWords) THEN { tree.ReleasePage[fatherPSE.pageNumber]; RETURN [nilPage] }; -- no right brother fatherEntSize _ tree.BTreeEntrySize[@pagePtr[fatherPSE.offset]]; rtBroPg _ pagePtr[fatherPSE.offset].grPage; tree.ReleasePage[fatherPSE.pageNumber]; END ELSE BEGIN fatherEntSize _ tree.BTreeEntrySize[fatherPSE.eslFront.entSeqP]; rtBroPg _ fatherPSE.eslFront.entSeqP.grPage; END; pagePtr _ tree.ReferencePage[rtBroPg]; IF LOOPHOLE[pagePtr.freeWords-fatherEntSize, INTEGER] < spaceNeeded THEN { tree.ReleasePage[rtBroPg]; RETURN [nilPage] }; -- right brother too full rtBroESR _ MakeEntSeqRecord[entSeq: @pagePtr.entries, length: tree.maxFreeWords-pagePtr.freeWords]; tree.ReleasePage[rtBroPg]; [esr: fatherESR] _ tree.RemoveEntry[pse: fatherPSE]; AppendEntSeqLengths[tree: tree, pathStk: pathStk, esr: fatherESR]; AppendEntSeqRecord[pse: pse, esr: fatherESR]; AppendEntSeqLengths[tree: tree, pathStk: pathStk, esr: rtBroESR]; AppendEntSeqRecord[pse: pse, esr: rtBroESR]; END; FindLeftBrother: PROCEDURE [tree: Tree, pathStk: PathStk, spaceNeeded: INTEGER] RETURNS [ltBroPg: PageNumber] = <> BEGIN pse: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top]; fatherPSE: LONG POINTER TO PathStkEntry = @pathStk.path[pathStk.top-1]; fatherPagePtr, ltBroPagePtr, rtBroPagePtr: BTreePagePtr; fatherESR, ltBroESR: REF EntSeqRecord; fatherEntSize: CARDINAL; rtBroOfLtBroPg: PageNumber; IF fatherPSE.offset <= entry1Offset THEN RETURN [nilPage]; fatherPagePtr _ tree.ReferencePage[fatherPSE.pageNumber]; ltBroPg _ fatherPagePtr[fatherPSE.nextToLastOffset].grPage; rtBroOfLtBroPg _ fatherPagePtr[fatherPSE.lastOffset].grPage; fatherEntSize _ tree.BTreeEntrySize[@fatherPagePtr[fatherPSE.lastOffset]]; tree.ReleasePage[fatherPSE.pageNumber]; ltBroPagePtr _ tree.ReferencePage[ltBroPg]; IF LOOPHOLE[ltBroPagePtr.freeWords-fatherEntSize, INTEGER] < spaceNeeded THEN { tree.ReleasePage[ltBroPg]; RETURN [nilPage] }; ltBroESR _ MakeEntSeqRecord[entSeq: @ltBroPagePtr.entries, length: tree.maxFreeWords-ltBroPagePtr.freeWords]; fatherPagePtr _ tree.ReferencePage[fatherPSE.pageNumber, write]; fatherPagePtr[fatherPSE.nextToLastOffset].grPage _ rtBroOfLtBroPg; tree.ReleasePage[fatherPSE.pageNumber]; [esr: fatherESR] _ tree.BackUpAndRemoveEntry[pse: fatherPSE]; rtBroPagePtr _ tree.ReferencePage[rtBroOfLtBroPg, write]; fatherESR.entSeqP.grPage _ rtBroPagePtr.minPage; rtBroPagePtr.minPage _ ltBroPagePtr.minPage; tree.ReleasePage[rtBroOfLtBroPg]; tree.ReleasePage[ltBroPg]; PushEntSeqLengths[tree: tree, pathStk: pathStk, esr: fatherESR]; PushEntSeqRecord[pse: pse, esr: fatherESR]; PushEntSeqLengths[tree: tree, pathStk: pathStk, esr: ltBroESR]; PushEntSeqRecord[pse: pse, esr: ltBroESR]; END; WriteRightBrother: PROCEDURE [tree: Tree, pse: LONG POINTER TO PathStkEntry, rtBroPg: PageNumber, words: CARDINAL] RETURNS [fatherESR: REF EntSeqRecord] = <> BEGIN pagePtr: BTreePagePtr; minPage: PageNumber; [esr: fatherESR, grPage: minPage] _ tree.RemoveEntry[pse: pse]; words _ words-fatherESR.entSeqLen; pagePtr _ tree.ReferencePage[rtBroPg, write]; pagePtr.minPage _ minPage; tree.ReleasePage[rtBroPg]; WritePage[tree: tree, pse: pse, number: rtBroPg, words: words]; fatherESR.entSeqP.grPage _ rtBroPg; END; WritePage: PROCEDURE [tree: Tree, pse: LONG POINTER TO PathStkEntry, number: PageNumber, words: CARDINAL] = <> BEGIN pagePtr: BTreePagePtr = tree.ReferencePage[number, write]; DepositESL[tree: tree, pse: pse, block: @pagePtr.entries, length: words]; pagePtr.freeWords _ tree.maxFreeWords-words; tree.ReleasePage[number]; END; IndexedEntrySize: PROCEDURE [pathStk: PathStk, index: EntryOrdinal] RETURNS [words: CARDINAL] = INLINE { RETURN [EntryIntervalSize[pathStk: pathStk, leftFather: index-1, rightFather: index+1]] }; FillLeftPage: PROCEDURE [tree: Tree, pathStk: PathStk, leftFather, rightFather: EntryOrdinal _ 0] RETURNS [midFather: EntryOrdinal] = <> BEGIN IF rightFather=0 THEN rightFather _ pathStk.entryTable.length+1; midFather _ leftFather+2; WHILE midFather> BEGIN IF rightFather=0 THEN rightFather _ pathStk.entryTable.length+1; midFather _ rightFather-2; WHILE midFather>leftFather+2 AND EntryIntervalSize[pathStk: pathStk, leftFather: midFather-1, rightFather: rightFather] <= tree.maxFreeWords DO midFather _ midFather-1; ENDLOOP; END; END.