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


//	BTreeWrtMS1.bcpl  -- Routines for writing in B-Trees
//		Uses pagination strategy MS to minimize the sum of lengths
//		of records posted to the father page.

//	last edited November 26, 1981  12:38 PM by Taft

get "btree.decl"


external
	[ Allocate	// Defined by OS
	Free
	MoveBlock

	ReadBTreePage	// defined by OpenBTree
	WriteBTreePage
	LockBTreePtr
	UnlockBTreePtr
	AllocateBTreePage
	BTreeBug

	PathRecLE		// Defined in BTreeRead.bcpl
	BackUpOneRecord
	ReadPageAndLockBTreePtr
	]


external
	[ UpdateRecord	// Defined in BTreeWrtMS.bcpl
	InsertRecords
	ComplexInsertRecords
	MakeNewRoot
	PageLength
	EntryLength
	FillLeftPage
	FillRightPage
	AppendEntSeqEnt
	PushEntSeqEnt
	MakeEntSeqEnt
	ComputeEntLens
	PushEntSeqEntLens
	AppendEntSeqEntLens
	DepositESL
	FindRightBrother
	FindLeftBrother
	RemoveEntry
	BasicRemoveEntry
	WriteRightBrother
	WritePage
	AddToHeap
	TrickleDown
	RemoveFromHeap
	SiftUp
	]


let ComplexInsertRecords(Tree, PathStk, IS) = valof

	[
	let PathStkTop = PathStk>>PS.PathStkTop
	let SP = lv PathStk>>PS.PSE^PathStkTop
	let SFP = SP - size PSE/16
	let MaxFreeWords = IS>>IS.MaxFreeWords

//	Not all the entries will fit on the current page. Try
//	spilling over onto the right brother page, or onto the
//	left brother page if there isn't a right brother.

	SFP>>PSE.LeastSon = SP>>PSE.PageNo  // In case this is the
					   // root page splitting

	let RtBroPg1 = Empty
	if PathStkTop gr 1 then
		[ RtBroPg1 = FindRightBrother(IS, SFP, -MaxFreeWords, SP)
		if RtBroPg1 eq Empty then
			RtBroPg1 = FindLeftBrother(IS, SFP, -MaxFreeWords, SP)
		]

	if RtBroPg1 eq Empty then
		RtBroPg1 = AllocateBTreePage(Tree)

	let OneBrotherEnough = false
	if IS>>IS.ELLLen ls 3 then
		BTreeBug(Tree, ecEntryListTooShort)

	let FatherEnt = FillLeftPage(IS, 0)

	let BestFatherEnt = nil
	let BestFatherLen = MaxFreeWords+1 // Causes BestFatherEnt
					//   to be updated the
					//   first time around.

//	The idea next is to send the shortest entry into
//	the father page such that the current page is at least
//	"pretty" full (if we have such a choice).

	while valof
		[ let PL1 = PageLength(IS, FatherEnt)
		if PL1 gr MaxFreeWords then resultis false
		let PL0 = PageLength(IS, 0, FatherEnt)
		resultis (PL0 gr 0) & (PL0+PL1 le
					MaxFreeWords+IS>>IS.AwfullyFull)
		]
	     do
		// Still enough room in brother page. See if this
		// is shortest father entry, and try moving one
		// more entry into brother page.

		[ let FatherLen = EntryLength(IS, FatherEnt)
		if FatherLen ls BestFatherLen then
			[ BestFatherEnt = FatherEnt
			BestFatherLen = FatherLen
			OneBrotherEnough = true
			]
		FatherEnt = FatherEnt-1
		]

	if OneBrotherEnough then
		[ let BreakLen = PageLength(IS, 0, BestFatherEnt)
		let TotLen = PageLength(IS, 0)

		WritePage(IS, SP, SP>>PSE.PageNo, BreakLen)

		PushEntSeqEnt(SFP,
			WriteRightBrother(IS, SP, SFP, RtBroPg1,
				TotLen-BreakLen))
		resultis Empty
		]

//	At this point we know that at least the current page and
//	two brother pages are involved.

	resultis RtBroPg1
 	]


and FindRightBrother(IS, StkFatherPtr, SpaceNeeded, PathStkEntry)
		= valof

	[ let Tree = IS>>IS.Tree
	let LR = Tree>>TREE.LengthRtn
	let FatherEnt = nil
	let FatherPtr = 0
	LockBTreePtr(Tree, lv FatherPtr)

	test StkFatherPtr>>PSE.ESLFront eq Empty
	ifso
		[ FatherPtr = ReadBTreePage(Tree, StkFatherPtr>>PSE.PageNo)
		let FatherFreeWords = FatherPtr>>BTP.FreeWords
		let FatherOffset = StkFatherPtr>>PSE.Offset
		FatherEnt = FatherPtr+FatherOffset

		if ((FatherOffset-Rec1Offset) ge
			(IS>>IS.MaxFreeWords-FatherFreeWords)) then
				[ UnlockBTreePtr(Tree, lv FatherPtr)
				resultis Empty
				]
		]
	ifnot FatherEnt = (StkFatherPtr>>PSE.ESLFront)>>ESLE.EntSeqP

	let  FatherEntLen = (offset BTE.Record/16)+
		LR(lv FatherEnt>>BTE.Record)
	let RtBroPg = FatherEnt>>BTE.GrPtr

	let RtBroPtr = ReadBTreePage(Tree, RtBroPg)
	unless RtBroPtr>>BTP.FreeWords-FatherEntLen ge SpaceNeeded
		do
		[ UnlockBTreePtr(Tree, lv FatherPtr)
		resultis Empty
		]


	LockBTreePtr(Tree, lv RtBroPtr)

	let RtBroLen = IS>>IS.MaxFreeWords-(RtBroPtr>>BTP.
			FreeWords)

	let NewESE = MakeEntSeqEnt(Tree>>TREE.Zone, lv (RtBroPtr>>BTP.BTEBlock),
				RtBroLen)

	let ESE = RemoveEntry(Tree, StkFatherPtr)
	AppendEntSeqEntLens(IS, ESE)
	AppendEntSeqEnt(PathStkEntry, ESE)
	AppendEntSeqEntLens(IS, NewESE)
	AppendEntSeqEnt(PathStkEntry, NewESE)

	WriteBTreePage(Tree, RtBroPg)
	UnlockBTreePtr(Tree, lv FatherPtr)
	UnlockBTreePtr(Tree, lv RtBroPtr)
	resultis RtBroPg
	]


and RemoveEntry(Tree, StkPtr, lvOldGrPtr; numargs na) = valof

	[ let ResultESE = (StkPtr>>PSE.ESLFront eq Empty)?
		BasicRemoveEntry(Tree, StkPtr),
		RemoveESE(Tree, StkPtr)
	let GreaterSonPg = (ResultESE>>ESLE.EntSeqP)>>BTE.GrPtr
	if na eq 3 then @lvOldGrPtr = GreaterSonPg
	(ResultESE>>ESLE.EntSeqP)>>BTE.GrPtr =
		(GreaterSonPg eq Empty)?
			Empty,
			(ReadBTreePage(Tree, GreaterSonPg))>>BTP.MinPtr
				// no need to lock transient reference
	resultis ResultESE
	]


and BasicRemoveEntry(Tree, StkPtr) = valof

	[ let Ptr = WriteBTreePage(Tree, StkPtr>>PSE.PageNo)
	LockBTreePtr(Tree, lv Ptr)

	let Offset = StkPtr>>PSE.Offset
	let Entry = Ptr+Offset
	let EntLen = (offset BTE.Record/16)+
		(Tree>>TREE.LengthRtn)(lv (Entry>>BTE.Record))

	let ResultESE = MakeEntSeqEnt(Tree>>TREE.Zone, Entry, EntLen)

	Ptr>>BTP.FreeWords = Ptr>>BTP.FreeWords+EntLen
	let TailBlkLen =
		(Tree>>TREE.PageLength-Ptr>>BTP.FreeWords)-Offset
	MoveBlock(Entry, Entry+EntLen, TailBlkLen)

	UnlockBTreePtr(Tree, lv Ptr)
	resultis ResultESE
	]


and RemoveESE(Tree, StkPtr) = valof

	[ let Ent = (StkPtr>>PSE.ESLFront)>>
			ESLE.EntSeqP
	let EntLen = (offset BTE.Record/16)+
		(Tree>>TREE.LengthRtn)(lv (Ent>>BTE.Record))

	let ESE = Allocate(Tree>>TREE.Zone,
		(offset ESLE.EntSeq/16)+EntLen)
	ESE>>ESLE.EntSeqP = lv (ESE>>ESLE.EntSeq)
	ESE>>ESLE.EntSeqLen = EntLen
	DepositESL(Tree, StkPtr, lv (ESE>>ESLE.EntSeq), EntLen)
	resultis ESE
	]


and WriteRightBrother(IS, StkPtr, StkFatherPtr, RtBroPg,
					NWords) = valof

	[ let Tree = IS>>IS.Tree

	let ESE = RemoveESE(Tree, StkPtr)
	let WordsLeft = NWords-ESE>>ESLE.EntSeqLen
	let MinPtr = (ESE>>ESLE.EntSeqP)>>BTE.GrPtr
	(ESE>>ESLE.EntSeqP)>>BTE.GrPtr = RtBroPg


	WriteBTreePage(Tree, RtBroPg)>>BTP.MinPtr = MinPtr
	unless WritePage(IS, StkPtr, RtBroPg, WordsLeft) eq
		WordsLeft do BTreeBug(Tree, ecWritePageWrong)
	resultis ESE // for father page
	]


and WritePage(IS, PSE, PageNo, NWords) = valof

	[ let Tree = IS>>IS.Tree
	let PagePtr = WriteBTreePage(Tree, PageNo)
	LockBTreePtr(Tree, lv PagePtr)
	let SentWords = DepositESL(Tree, PSE, lv (PagePtr>>BTP.BTEBlock),
		NWords)
	PagePtr>>BTP.FreeWords = IS>>IS.MaxFreeWords-SentWords
	UnlockBTreePtr(Tree, lv PagePtr)
	resultis SentWords
	]


and EntryLength(IS, Entry) = PageLength(IS, Entry-1, Entry+1)


and FillLeftPage(IS, LeftFather, RightFather; numargs na) = valof

	[ if na ls 3 then RightFather = IS>>IS.ELLLen+1

	let MidFather = LeftFather+2
	while MidFather ls RightFather-2 &
		PageLength(IS, LeftFather, MidFather+1) le IS>>IS.MaxFreeWords
		do MidFather = MidFather+1
	resultis MidFather
	]


and FillRightPage(IS, LeftFather, RightFather; numargs na) = valof

	[ if na ls 3 then RightFather = IS>>IS.ELLLen+1

	let MidFather = RightFather-2
	while MidFather gr LeftFather+2 &
		PageLength(IS, MidFather-1, RightFather) le IS>>IS.MaxFreeWords
		do MidFather = MidFather-1
	resultis MidFather
	]


and PushEntSeqEnt(PathStkEntry, Entry) be

	[ Entry>>ESLE.FwdP = PathStkEntry>>PSE.ESLFront
	PathStkEntry>>PSE.ESLFront = Entry

	if PathStkEntry>>PSE.ESLRear eq Empty then
		PathStkEntry>>PSE.ESLRear = Entry
	]


and PushEntSeqEntLens(IS, EntSeqEnt) be

	[ //	The idea is to add the entries on the tail end and
	// then to take the added bunch of entries and move them
	// to the head end, adjusting cumulative lengths
	// appropriately.

	// N.B. This must never be done while we have an
	// active heap, or disaster will ensue.

	let OldEnd = IS>>IS.ELLLen
	AppendEntSeqEntLens(IS, EntSeqEnt)
	let NewEnd = IS>>IS.ELLLen

	let ELL = IS>>IS.ELLPtr
	let OldLen = ELL>>ELL.CumEntLen^OldEnd
	let NewLen = ELL>>ELL.CumEntLen^NewEnd
	let OldBase = ELL>>ELL.CumEntLen^0

	let Zone = (IS>>IS.Tree)>>TREE.Zone
	let TSize = OldEnd*(size ELE/16)
	let T = Allocate(Zone, TSize)
	MoveBlock(T, lv ELL>>ELL.ELE^1, TSize)
	MoveBlock(lv ELL>>ELL.ELE^1, lv ELL>>ELL.ELE^(OldEnd+1),
		((NewEnd-OldEnd)*(size ELE/16)))
	MoveBlock(lv ELL>>ELL.ELE^(1+NewEnd-OldEnd), T, TSize)
	Free(Zone, T)

	ELL>>ELL.CumEntLen^0 = OldBase-(NewLen-OldLen)
	let Delta = OldBase-NewLen
	for i=1 to NewEnd-OldEnd do
		ELL>>ELL.CumEntLen^i = ELL>>ELL.CumEntLen^i+Delta
	]