//	B-Tree Maintenance Routines
// Copyright Xerox Corporation 1979, 1981, 1982

//	BTreeRead.bcpl  -- Routines for reading B-Trees

//	last edited May 9, 1982  5:25 PM by Taft

get "BTree.decl"

external
	[ MoveBlock
	Allocate
	Free
	DefaultArgs
	Zero
	Dvec

	ReadBTreePage	// defined in OpenBTree
	WriteBTreePage
	LockBTreePtr
	UnlockBTreePtr
	]


external
	[
	ReadRecLE	// outgoing procedues
	MapTree
	PathRecLE
	BackUpOneRecord
	RepairOffsets
	ReadStackAndLockBTreePtr
	ReadPageAndLockBTreePtr
	ReadStack
	PopStack
	GetRecord
	]


// For the externally-called procedures (ReadRecLE, MapTree, UpdateRecord,
// and DeleteKey), if caller supplies a PathStk and UseExistingPath
// is true, then the caller asserts that the supplied PathStk was the result
// of a previous call with the same Key.  (Note that the B-Tree package is
// responsible for determining whether or not the tree has changed since
// the PathStk was computed, so the caller need not worry about that.)
// In any event, if caller supplies a PathStk then it is filled in with
// the path to the entry returned by ReadRecLE or the last entry enumerated
// by MapTree; UpdateRecord and DeleteKey invalidate the supplied PathStk.


let ReadRecLE(Tree, Key, CKRtn, dontCopy, PathStk, UseExistingPath;
	numargs na) = valof

	[
	DefaultArgs(lv na, -2, Tree>>TREE.CompareKeyRtn, false,
		size PS/16, false)
	if PathStk eq size PS/16 then
		[ Dvec(ReadRecLE, lv PathStk); UseExistingPath = false ]

	PathRecLE(Tree, PathStk, UseExistingPath, Key, CKRtn)
	resultis GetRecord(Tree, PathStk, dontCopy)
	]


and MapTree(Tree, StartKey, Function, Param, CKRtn, dontCopy, PathStk, UseExistingPath;
	numargs na) = valof

	[ DefaultArgs(lv na, -3, 0, Tree>>TREE.CompareKeyRtn, false,
		size PS/16, false)
	if PathStk eq size PS/16 then
		[ Dvec(MapTree, lv PathStk); UseExistingPath = false ]

	let LeafStkTop = PathRecLE(Tree, PathStk, UseExistingPath, StartKey, CKRtn)

	if PathStk>>PS.PathStkTop eq 0 then

		// Key is less than any existing record in the tree.
		// Set PathStk to first record in leftmost leaf page.

		[ if LeafStkTop eq 0 then resultis true  // empty tree
		PathStk>>PS.PathStkTop = LeafStkTop
		PathStk>>PS.PSE^LeafStkTop.LastOffset = Rec1Offset
		]

	let SP = lv PathStk>>PS.PSE^(PathStk>>PS.PathStkTop)

	let PagePtr = 0
	LockBTreePtr(Tree, lv PagePtr)

	[ // repeat
	let Offset = SP>>PSE.LastOffset

	if PagePtr eq 0 then
		PagePtr = ReadBTreePage(Tree, SP>>PSE.PageNo)

	test Offset ge Tree>>TREE.PageLength - PagePtr>>BTP.FreeWords

	ifso	// Ran off end of page.  Pop up a level and do the next
		// entry in the father page.

		[ PagePtr = 0
		PathStk>>PS.PathStkTop = PathStk>>PS.PathStkTop-1
		if PathStk>>PS.PathStkTop le 0 then
			// Ran off end of tree.  PathStk is no longer valid.
			[ UnlockBTreePtr(Tree, lv PagePtr)
			PathStk>>PS.Version = Tree>>TREE.Version-1
			resultis true
			]
		SP = SP - size PSE/16
		]

	ifnot	// Do next entry in current page.

		[ let NxtPgNo = (PagePtr+Offset)>>BTE.GrPtr
		let RecPtr = lv (PagePtr+Offset)>>BTE.Record
		let RecLen = (Tree>>TREE.LengthRtn)(RecPtr)
		SP>>PSE.Offset = Offset+(offset BTE.Record/16)+RecLen
	
		unless dontCopy do
			[ let CopyRec = Allocate(Tree>>TREE.Zone, RecLen)
			MoveBlock(CopyRec, RecPtr, RecLen)
			RecPtr = CopyRec
			PagePtr = 0	// unlock the B-Tree page
			]

		unless Function(RecPtr, Param, PathStk) do
			[ UnlockBTreePtr(Tree, lv PagePtr)
			resultis false
			]

		// If we are in a non-leaf page, find the leftmost
		// right descendant of the entry we just did.
		while NxtPgNo ne Empty do
			[ PathStk>>PS.PathStkTop = PathStk>>PS.PathStkTop+1
			SP = SP + size PSE/16
			SP>>PSE.PageNo = NxtPgNo
			SP>>PSE.NextToLastOffset = Empty
			SP>>PSE.LastOffset = Rec0Offset
			SP>>PSE.Offset = Rec1Offset
			PagePtr = ReadBTreePage(Tree, NxtPgNo)
			NxtPgNo = PagePtr>>BTP.MinPtr
			]
		]

	SP>>PSE.NextToLastOffset = SP>>PSE.LastOffset
	SP>>PSE.LastOffset = SP>>PSE.Offset

	] repeat

	]


and PathRecLE(Tree, PathStk, UseExistingPath, Key, CKR) = valof

// Computes a PathStk for the supplied Key such that at each level
// PSE.LastOffset refers to an entry less than or equal to Key and
// PSE.Offset refers to an entry strictly greater than Key, if any
// such entries exist.  Sets PathStk>>PS.PathStkTop to the deepest level
// in which PSE.LastOffset refers to a real entry (i.e., not Rec0Offset),
// unless no such entry exists in the entire tree, in which case sets
// PathStkTop to zero.  Returns the depth of the tree, i.e., the
// PathStkTop for the leaf page (which is either the page containing
// the LE entry or its leftmost right descendant page).

	[ if UseExistingPath &
		PathStk>>PS.Version eq Tree>>TREE.Version then

		// Supplied PathStk still valid; no need to search tree.

		[ let PathStkTop = PathStk>>PS.PathStkTop
		while PathStk>>PS.PSE^PathStkTop.LeastSon ne Empty do
			PathStkTop = PathStkTop+1
		resultis PathStkTop
		]

	Zero(PathStk, (offset PS.PSE^1)/16)  // overhead and dummy PSE
	PathStk>>PS.Version = Tree>>TREE.Version

	let offsetTable = Allocate(Tree>>TREE.Zone, maxRecordsPerPage+3)
	MoveBlock(offsetTable, table [ Empty; Rec0Offset; Rec1Offset ], 3)

	let PathStkTop = 0
	let SP = lv PathStk>>PS.PSE^0

	let CurPtr = 0
	LockBTreePtr(Tree, lv CurPtr)

	let CurPage = Tree>>TREE.RootPage
	while CurPage ne Empty do

		[ PathStkTop = PathStkTop+1
		SP = SP + size PSE/16
		SP>>PSE.PageNo = CurPage

		CurPtr = 0
		CurPtr = ReadBTreePage(Tree, CurPage)

		let firstGr = BinSearchPage(Tree, CurPtr, offsetTable, CKR, Key)
		SP>>PSE.Offset = offsetTable!firstGr
		SP>>PSE.LastOffset = offsetTable!(firstGr-1)
		SP>>PSE.NextToLastOffset = offsetTable!(firstGr-2)
		SP>>PSE.LeastSon = CurPtr>>BTP.MinPtr
		if firstGr gr 2 then PathStk>>PS.PathStkTop = PathStkTop

		SP>>PSE.ESLFront = 0
		SP>>PSE.ESLRear = 0

		CurPage = (CurPtr+(SP>>PSE.LastOffset))>>BTE.GrPtr
		]

	UnlockBTreePtr(Tree, lv CurPtr)
	Free(Tree>>TREE.Zone, offsetTable)
	resultis PathStkTop
	]


and BinSearchPage(Tree, curPtr, offsetTable, CKR, Key) = valof

//	Returns an index r such that offsetTable!r is the offset of
//	the first record strictly greater than Key, and fills in
//	offsetTable!2 through offsetTable!r with the offsets of
//	all records up to and including that one.

	[ let LR = Tree>>TREE.LengthRtn
	let firstBadOffset = Tree>>TREE.PageLength-curPtr>>BTP.FreeWords
	let midOffset = firstBadOffset rshift 1
	let curOffset = Rec1Offset
	let l = 2
	let r = 2

//	Scan records linearly and build offsetTable until half the in-use
//	portion of the B-Tree page has been examined.  Then do one
//	key comparison to determine which half of the page to direct our
//	attention to, and build the rest of offsetTable only if necessary.
//	On the average this saves 25% of the work of building offsetTables,
//	and costs no extra comparisons since the first comparison would
//	examine a middle record anyway (not necessarily the same one).

	[ // repeat
	if curOffset ge midOffset then
		[
		if curOffset ge firstBadOffset %
		 CKR(Key, lv (curPtr+curOffset)>>BTE.Record) ls 0 then
			break
		midOffset = firstBadOffset
		l = r
		]

	curOffset = curOffset + offset BTE.Record/16
	curOffset = curOffset + LR(curPtr+curOffset)
	r = r + 1
	offsetTable!r = curOffset
	] repeat

//	At this point, offsetTable!r is the offset of the first non-record,
//	which we assume to have an infinite key (that we shall never test).
//	We shall leave r pointing at the offset of the first record whose
//	key is greater than Key.

	while l ls r do
		[ let m = (l+r) rshift 1
		switchon CKR(Key, lv (curPtr+offsetTable!m)>>BTE.Record) into
			[
			case 1: l = m+1; loop	// Key > record
			case 0: resultis m+1	// Key = record
			case -1: r = m; loop	// Key < record
			]
		]

	resultis r
	]


and GetRecord(Tree, PathStk, dontCopy) = valof

	[ let PathStkTop = PathStk>>PS.PathStkTop

	if PathStkTop eq 0 then resultis Empty

	let SP = lv (PathStk>>PS.PSE^PathStkTop)
	let PagePtr = 0
	ReadStackAndLockBTreePtr(Tree, PathStk, lv PagePtr)
	let BestRecPtr = lv ((PagePtr+SP>>PSE.LastOffset)>>
				BTE.Record)

	unless dontCopy do
		[ let BestRecLen = (Tree>>TREE.LengthRtn)(BestRecPtr)
		let BestRec = Allocate(Tree>>TREE.Zone, BestRecLen)
		MoveBlock(BestRec, BestRecPtr, BestRecLen)
		BestRecPtr = BestRec
		]

	UnlockBTreePtr(Tree, lv PagePtr)

	resultis BestRecPtr	// recipient responsible for locking
	]


and BackUpOneRecord(Tree, PathStkEnt) be

	[ RepairOffsets(Tree, PathStkEnt)
	PathStkEnt>>PSE.Offset = PathStkEnt>>PSE.LastOffset
	RepairOffsets(Tree, PathStkEnt)
	]


and RepairOffsets(Tree, PathStkEnt) be

	[ let Ptr = nil
	ReadPageAndLockBTreePtr(Tree, PathStkEnt>>PSE.PageNo, lv Ptr)
	let Offset = PathStkEnt>>PSE.Offset
	let LastOffset = PathStkEnt>>PSE.LastOffset
	let NextToLastOffset = PathStkEnt>>PSE.NextToLastOffset

	unless CheckProgression(Tree, Ptr, LastOffset, Offset) &
		CheckProgression(Tree, Ptr, NextToLastOffset, LastOffset) do

		[ let newOffset = Rec1Offset
		LastOffset = Rec0Offset
		NextToLastOffset = Empty

		while newOffset ne Offset do
			[ NextToLastOffset = LastOffset
			LastOffset = newOffset
			newOffset = newOffset+
				(offset BTE.Record/16)+
				(Tree>>TREE.LengthRtn)(lv ((Ptr+newOffset)>>
					BTE.Record))
			]

		PathStkEnt>>PSE.LastOffset = LastOffset
		PathStkEnt>>PSE.NextToLastOffset = NextToLastOffset
		]

	UnlockBTreePtr(Tree, lv Ptr)
	]


and CheckProgression(Tree, Ptr, Offset1, Offset2) = 

	selecton Offset2 into
		[ case Rec0Offset: Offset1 eq Empty
		case Rec1Offset: Offset1 eq Rec0Offset
		default: (Offset1 ge Offset2)? false,
			(Offset1+(offset BTE.Record/16)+
			(Tree>>TREE.LengthRtn)(
			 lv (Ptr+Offset1)>>BTE.Record))
			eq Offset2
		]


and ReadStack(Tree, PathStk) =
	ReadBTreePage(Tree,
		PathStk>>PS.PSE^(PathStk>>PS.PathStkTop).PageNo)


and ReadPageAndLockBTreePtr(Tree, pageNo, pPtr) be

	[ @pPtr = ReadBTreePage(Tree, pageNo)
	LockBTreePtr(Tree, pPtr)
	]


and ReadStackAndLockBTreePtr(Tree, PathStk, pPtr) be

	[ @pPtr = ReadStack(Tree, PathStk)
	LockBTreePtr(Tree, pPtr)
	]


and PopStack(PathStk) be

	PathStk>>PS.PathStkTop = PathStk>>PS.PathStkTop-1