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


//	BTreeWrtMS2.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:43 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
	ReadPageAndLockBTreePtr
	BackUpOneRecord
	RepairOffsets
	]


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


let HairyInsertRecords(Tree, PathStk, IS, RtBroPg1) be

	[
//	From this point on, we know that at least the current page
//	and two right brother pages are involved. First we
//	calculate the minimum space required in the second right
//	brother in order that he can handle our overflow. Then
//	we see if our second brother exists and has that
//	much space.

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

	if IS>>IS.ELLLen ls 5 then
		BTreeBug(Tree, ecEntryListTooShort)

//	See how much space our second brother page would have to
//	contain in order to handle the overflow. This is done
//	by pretending to fill up this page and the first right brother
//	page and seeing what is left over.

	let FatherEnt = FillLeftPage(IS, 0)
	let FatherEnt2 = FillLeftPage(IS, FatherEnt)

//	CurPage can't be the root, because
//	one brother would surely have been enough in that
//	case, so we don't have to pussyfoot when calling 
//	FindRightBrother.

	let RtBroPg2 = FindRightBrother(IS, SFP,
		PageLength(IS, FatherEnt2)+
			2*(IS>>IS.BreathingSpace), SP)

	if RtBroPg2 eq Empty then
		// No luck. Try the left brother.
		[ let FE2 = FillRightPage(IS, 0)
		let FE = FillRightPage(IS, 0, FE2)
		RtBroPg2 = FindLeftBrother(IS, SFP, PageLength(IS, 0, FE)+
						2*(IS>>IS.BreathingSpace),
						SP)

		test RtBroPg2 eq Empty

		ifso	// Still no luck, get empty page
			RtBroPg2 = AllocateBTreePage(Tree)

		ifnot	// Left brother had space, but
			//	FatherEnt's are now invalid
			[ FatherEnt = FillLeftPage(IS, 0)
			FatherEnt2 = FillLeftPage(IS, FatherEnt)
			]
		]

	let MaxFeasEnt = FatherEnt2
	while PageLength(IS, MaxFeasEnt) le IS>>IS.FairlyFull do
		MaxFeasEnt = MaxFeasEnt-1
	let MinFeasEnt = MaxFeasEnt+1

	let TwoBrothersEnough = false
	let BestFatherEnt = nil
	let BestFatherEnt2 = nil
	let BestFatherLenSum = MaxFreeWords+1
	IS>>IS.HeapSize = 0

	while (PageLength(IS, 0, FatherEnt) ge IS>>IS.PrettyFull) %
		(not TwoBrothersEnough &
			(PageLength(IS, 0, FatherEnt) gr 0))
		do

		[ while (PageLength(IS, FatherEnt, MinFeasEnt-1) gr 0) &
			(PageLength(IS, MinFeasEnt-1) le
			MaxFreeWords) do

				[ MinFeasEnt = MinFeasEnt-1
				if MinFeasEnt le MaxFeasEnt then
					AddToHeap(IS, MinFeasEnt)
				]

		while PageLength(IS, FatherEnt, MaxFeasEnt) gr
			MaxFreeWords do

				[ if MaxFeasEnt ge MinFeasEnt then
					RemoveFromHeap(IS, MaxFeasEnt)
				MaxFeasEnt = MaxFeasEnt-1
				]


		if IS>>IS.HeapSize gr 0 then
			[ FatherEnt2 = (IS>>IS.HeapPtr)>>HP.HeapEnt^1
			let SL = EntryLength(IS, FatherEnt)+
					EntryLength(IS, FatherEnt2)

			if SL ls BestFatherLenSum then
				[ TwoBrothersEnough = true
				BestFatherLenSum = SL
				BestFatherEnt = FatherEnt
				BestFatherEnt2 = FatherEnt2
				]
			]

		FatherEnt = FatherEnt-1
		]

	unless TwoBrothersEnough do
		BTreeBug(Tree, ecTwoBrothersNotEnough)

	let BreakLen1 = PageLength(IS, 0, BestFatherEnt)
	let BreakLen2 = PageLength(IS, 0, BestFatherEnt2)
	let TotLen = PageLength(IS, 0)

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

	let t = WriteRightBrother(IS, SP, SFP, RtBroPg1,
				BreakLen2-BreakLen1)

	PushEntSeqEnt(SFP,
		WriteRightBrother(IS, SP, SFP, RtBroPg2,
				TotLen-BreakLen2))
	PushEntSeqEnt(SFP, t)
	]


and MakeNewRoot(IS, SP, Tree) be

	[ let NewWords = PageLength(IS, 0)

	if NewWords gr IS>>IS.MaxFreeWords then
		BTreeBug(Tree, ecNewRootOverflow)

	let NewRootPage = AllocateBTreePage(Tree)

	WriteBTreePage(Tree, NewRootPage)>>BTP.MinPtr = SP>>PSE.LeastSon

	unless WritePage(IS, SP, NewRootPage, NewWords) eq NewWords
		do BTreeBug(Tree, ecWritePageWrong)

	Tree>>TREE.RootPage = NewRootPage
	Tree>>TREE.StateDirty = true
	]


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

	[ let Tree = IS>>IS.Tree
	let FatherPg = StkFatherPtr>>PSE.PageNo
	let FatherPtr = nil
	ReadPageAndLockBTreePtr(Tree, FatherPg, lv FatherPtr)
	let FatherFreeWords = FatherPtr>>BTP.FreeWords
	let FatherOffset = StkFatherPtr>>PSE.Offset
	let FatherLOffset = StkFatherPtr>>PSE.LastOffset
	let FatherNTLOffset = StkFatherPtr>>PSE.NextToLastOffset

	if (FatherOffset le Rec1Offset) then
		[ UnlockBTreePtr(Tree, lv FatherPtr)
		resultis Empty
		]

	let FatherEnt = FatherPtr+FatherLOffset
	let FatherEntLen = (Tree>>TREE.LengthRtn)(lv FatherEnt>>BTE.Record)+
		offset BTE.Record/16
	let LFatherEnt = FatherPtr+FatherNTLOffset
	let LeftBroPg = LFatherEnt>>BTE.GrPtr
	let LeftBroPtr = ReadBTreePage(Tree, LeftBroPg)
	unless LeftBroPtr>>BTP.FreeWords-FatherEntLen ge
		SpaceNeeded do
		[ UnlockBTreePtr(Tree, lv FatherPtr)
		resultis Empty
		]

	LockBTreePtr(Tree, lv LeftBroPtr)
	WriteBTreePage(Tree, FatherPg)
	WriteBTreePage(Tree, LeftBroPg)

	let LeftBroLen = IS>>IS.MaxFreeWords-(LeftBroPtr>>BTP.
			FreeWords)

	let NewESE = MakeEntSeqEnt(Tree>>TREE.Zone,
		lv (LeftBroPtr>>BTP.BTEBlock), LeftBroLen)

	let RightBroPg = FatherEnt>>BTE.GrPtr
	LFatherEnt>>BTE.GrPtr = RightBroPg

	BackUpOneRecord(Tree, StkFatherPtr)
	let ESE = BasicRemoveEntry(Tree, StkFatherPtr)
	let RightBroPtr = WriteBTreePage(Tree, RightBroPg)
	(ESE>>ESLE.EntSeqP)>>BTE.GrPtr = RightBroPtr>>BTP.MinPtr
	RightBroPtr>>BTP.MinPtr = LeftBroPtr>>BTP.MinPtr

	PushEntSeqEntLens(IS, ESE)
	PushEntSeqEnt(PathStkEntry, ESE)
	PushEntSeqEntLens(IS, NewESE)
	PushEntSeqEnt(PathStkEntry, NewESE)

	UnlockBTreePtr(Tree, lv LeftBroPtr)
	UnlockBTreePtr(Tree, lv FatherPtr)
	resultis LeftBroPg
	]


and AddToHeap(IS, Entry) be

	[ IS>>IS.HeapSize = IS>>IS.HeapSize+1
	TrickleDown(IS, IS>>IS.HeapSize, Entry)
	]


and TrickleDown(IS, EmptyLoc, Entry) be

	[ let Heap = IS>>IS.HeapPtr
	let EntLens = IS>>IS.ELLPtr

	let SonLen = EntryLength(IS, Entry)

	let Son = EmptyLoc
	let Father = nil
	let FE = nil

	while valof
		[ Father = Son rshift 1	// Son/2
		if Father le 0 then resultis false
		FE = Heap>>HP.HeapEnt^Father
		resultis (EntryLength(IS, FE) gr SonLen)
		]
	    do
		[ Heap>>HP.HeapEnt^Son = FE
		EntLens>>ELL.HeapPos^FE = Son
		Son = Father
		]

	Heap>>HP.HeapEnt^Son = Entry
	EntLens>>ELL.HeapPos^Entry = Son
	]


and RemoveFromHeap(IS, Entry) be

	[ let Heap = IS>>IS.HeapPtr
	let EntLens = IS>>IS.ELLPtr

	let HeapPos = EntLens>>ELL.HeapPos^Entry
	IS>>IS.HeapSize = IS>>IS.HeapSize-1
	if HeapPos gr IS>>IS.HeapSize then return	// Our guy was last

	let ReplacementEntry = Heap>>HP.HeapEnt^(IS>>IS.HeapSize+1)
	test EntryLength(IS, ReplacementEntry) le
		EntryLength(IS, Entry)

	ifso	TrickleDown(IS, HeapPos, ReplacementEntry)
	ifnot	SiftUp(IS, HeapPos, ReplacementEntry)
	]


and SiftUp(IS, EmptyLoc, Entry) be

	[ let Heap = IS>>IS.HeapPtr
	let HeapSize = IS>>IS.HeapSize
	let EntLens = IS>>IS.ELLPtr

	let EELen = EntryLength(IS, Entry)

	while true do
		[ let Son = EmptyLoc+EmptyLoc
		let ERSon = nil

		if Son gr HeapSize then break

		let ESon = Heap>>HP.HeapEnt^Son
		if Son ls HeapSize then
			[ let ERSon = Heap>>HP.HeapEnt^(Son+1)
			if EntryLength(IS, ERSon) ls
				EntryLength(IS, ESon) do
					[ Son = Son+1
					ESon = ERSon
					]
			]

		if EntryLength(IS, Heap>>HP.HeapEnt^Son) ge EELen then
			break

		Heap>>HP.HeapEnt^EmptyLoc = ESon
		EntLens>>ELL.HeapPos^ESon = EmptyLoc

		EmptyLoc = Son
		]

	Heap>>HP.HeapEnt^EmptyLoc = Entry
	EntLens>>ELL.HeapPos^Entry = EmptyLoc
	]