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


//	BTreeWrtMS0.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 May 9, 1982  5:24 PM by Taft

get "btree.decl"


external
	[ Allocate	// Defined by OS
	Free
	MoveBlock
	DefaultArgs
	Dvec

	ReadBTreePage	// defined by OpenBTree
	WriteBTreePage
	LockBTreePtr
	UnlockBTreePtr
	BTreeBug

	PathRecLE		// Defined in BTreeRead.bcpl
	BackUpOneRecord
	PopStack
	ReadStack
	ReadStackAndLockBTreePtr
	GetRecord
	]


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


let UpdateRecord(Tree, Key, RecordGenerator, Param, CKR, PathStk, UseExistingPath;
	numargs na) be

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

	let LR = Tree>>TREE.LengthRtn
	let Zone = Tree>>TREE.Zone

	let OrigST = PathRecLE(Tree, PathStk, UseExistingPath, Key, CKR)

	let FoundRecord = Empty
	let FoundRecLen = nil
	if PathStk>>PS.PathStkTop ge 1 then
		[ FoundRecord = GetRecord(Tree, PathStk, false)
		FoundRecLen = LR(FoundRecord)
		unless CKR(Key, FoundRecord) eq 0 do
			[ Free(Zone, FoundRecord); FoundRecord = Empty ]
		]

	let Record = RecordGenerator(FoundRecord, Param)
	let RecLen = LR(Record)

	unless CKR(Key, Record) eq 0 do
		BTreeBug(Tree, ecRecGenReturnedWrongKey)

	// This update may change the tree in ways that invalidate any
	// existing PathStk.
	Tree>>TREE.Version = Tree>>TREE.Version+1

	// To minimize average insertion time, perform the update in one of
	// three ways (in increasing order of difficulty, as measured by amount
	// of temporary storage allocated and amount of data copied):
	// (1) If replacing an existing record of the same size, just overwrite it.
	// (2) If the new record fits on the page (after removing the old record
	//     if any), just slide up the records beyond the insertion point and
	//     insert the new record.
	// (3) Otherwise, leave the new record as an ESE at the appropriate
	//     stack level, and let InsertRecords cope with the problem.

	let PSE = lv (PathStk>>PS.PSE^(PathStk>>PS.PathStkTop))
	if FoundRecord ne Empty & RecLen eq FoundRecLen then
		[ // New record same length as old, just copy it over
		let PagePtr = WriteBTreePage(Tree, PSE>>PSE.PageNo)
		LockBTreePtr(Tree, lv PagePtr)
		MoveBlock(lv (PagePtr+PSE>>PSE.LastOffset)>>BTE.Record,
			Record, RecLen)
		UnlockBTreePtr(Tree, lv PagePtr)
		Free(Zone, Record)
		return
		]

	let OldRecGrPtr = Empty
	test FoundRecord eq Empty
	ifso	[ PathStk>>PS.PathStkTop = OrigST
		PSE = lv (PathStk>>PS.PSE^(PathStk>>PS.PathStkTop))
		Tree>>TREE.RecordCount = Tree>>TREE.RecordCount+1
		Tree>>TREE.StateDirty = true
		]

	ifnot	[ BackUpOneRecord(Tree, PSE)
		Free(Zone, RemoveEntry(Tree, PSE, lv OldRecGrPtr))
		]


	let EntLen = RecLen+(offset BTE.Record/16)

	if EntLen le ReadStack(Tree, PathStk)>>BTP.FreeWords then
		[ // New record fits on the page -- insert it the easy way
		let PagePtr = WriteBTreePage(Tree, PSE>>PSE.PageNo)
		LockBTreePtr(Tree, lv PagePtr)
		let NewEnt = PagePtr + PSE>>PSE.Offset
		let FreeEnt = PagePtr + Tree>>TREE.PageLength -
			PagePtr>>BTP.FreeWords
		while FreeEnt gr NewEnt do
			[ // slide up in chunks -- MoveBlock goes the wrong way
			MoveBlock(FreeEnt, FreeEnt-EntLen, EntLen)
			FreeEnt = FreeEnt - EntLen
			]
		MoveBlock(lv NewEnt>>BTE.Record, Record, RecLen)
		NewEnt>>BTE.GrPtr = OldRecGrPtr
		PagePtr>>BTP.FreeWords = PagePtr>>BTP.FreeWords - EntLen
		UnlockBTreePtr(Tree, lv PagePtr)
		Free(Zone, Record)
		return
		]

	let RecPtr = Allocate(Zone, EntLen)
	MoveBlock(lv (RecPtr>>BTE.Record), Record, RecLen)
	RecPtr>>BTE.GrPtr = OldRecGrPtr
	Free(Zone, Record)
	AppendEntSeqEnt(PSE, MakeEntSeqEnt(Zone, RecPtr, EntLen))

	Free(Zone, RecPtr)

	let IS = FabricateIS(Tree, PathStk)

	while (PathStk>>PS.PathStkTop ge 0) &
		(PathStk>>PS.PSE^(PathStk>>PS.PathStkTop).ESLFront
			ne Empty) do
		[ InsertRecords(Tree, PathStk, IS)
		PopStack(PathStk)
		]

	FreeIS(IS)
	]


and MakeEntSeqEnt(Zone, EntSeq, Length) = valof

	[ let E = Allocate(Zone, (offset ESLE.EntSeq/16)+Length)
	E>>ESLE.EntSeqP = lv E>>ESLE.EntSeq
	E>>ESLE.EntSeqLen = Length
	MoveBlock(lv E>>ESLE.EntSeq, EntSeq, Length)
	resultis E
	]


and AppendEntSeqEnt(PathStkEntry, Entry) be

	[ Entry>>ESLE.FwdP = Empty

	test PathStkEntry>>PSE.ESLRear eq Empty
	ifso	PathStkEntry>>PSE.ESLFront = Entry
	ifnot	(PathStkEntry>>PSE.ESLRear)>>ESLE.FwdP = Entry

	PathStkEntry>>PSE.ESLRear = Entry
	]


and FabricateIS(Tree, PathStk) = valof

	[ let Zone = Tree>>TREE.Zone
	let IS = Allocate(Zone, size IS/16)
	IS>>IS.Tree = Tree

	let MaxFreeWords = Tree>>TREE.PageLength-PageOverhead
	IS>>IS.MaxFreeWords = MaxFreeWords
	IS>>IS.AwfullyFull = (9*MaxFreeWords)/10
	IS>>IS.PrettyFull = (2*MaxFreeWords)/3
	IS>>IS.FairlyFull = MaxFreeWords/2
	IS>>IS.BreathingSpace = MaxFreeWords-IS>>IS.AwfullyFull

	IS>>IS.PathStk = PathStk
	IS>>IS.HeapPtr = Allocate(Zone, size HP/16)
	IS>>IS.ELLPtr = Allocate(Zone, size ELL/16)
	resultis IS
	]


and FreeIS(IS) be

	[ let Zone = (IS>>IS.Tree)>>TREE.Zone
	Free(Zone, IS>>IS.HeapPtr)
	Free(Zone, IS>>IS.ELLPtr)
	Free(Zone, IS)
	]

and InsertRecords(Tree, PathStk, IS) be

	[ let PathStkTop = PathStk>>PS.PathStkTop
	let SP = lv PathStk>>PS.PSE^PathStkTop
	if SP>>PSE.ESLFront eq Empty then return

	let Zone = Tree>>TREE.Zone

	ComputeEntLens(IS, SP)

	if PathStkTop le 0 then

		[ MakeNewRoot(IS, SP, Tree)
		return
		]

	let CurPtr = WriteBTreePage(Tree, SP>>PSE.PageNo)
	LockBTreePtr(Tree, lv CurPtr)

	let FreeWords = CurPtr>>BTP.FreeWords
	let Offset = SP>>PSE.Offset
	let TailBlkPtr = CurPtr+Offset
	let TailBlkLen = (IS>>IS.MaxFreeWords-FreeWords)-
		(Offset-Rec1Offset)

	let NewWords = PageLength(IS, 0)
	if NewWords le FreeWords then

		// All entries fit the current page. Hurrah!

		[ let T = Allocate(Zone, IS>>IS.MaxFreeWords)
		MoveBlock(T, TailBlkPtr, TailBlkLen)

		unless DepositESL(Tree, SP, TailBlkPtr, 
				NewWords) eq NewWords
			do BTreeBug(Tree, ecDepositESLWrong)

		MoveBlock(TailBlkPtr+NewWords, T, TailBlkLen)
		Free(Zone, T)

		CurPtr>>BTP.FreeWords = FreeWords-NewWords
		UnlockBTreePtr(Tree, lv CurPtr)
		return
		]

//	Not all the entries will fit on the current page. This is
//	getting complex.

	let LeftESEnt = MakeEntSeqEnt(Zone,
		 CurPtr+Rec1Offset, Offset-Rec1Offset)
	PushEntSeqEnt(SP, LeftESEnt)
	PushEntSeqEntLens(IS, LeftESEnt)

	let RightESEnt = MakeEntSeqEnt(Zone, TailBlkPtr, TailBlkLen)
	AppendEntSeqEnt(SP, RightESEnt)
	AppendEntSeqEntLens(IS, RightESEnt)

	UnlockBTreePtr(Tree, lv CurPtr)

	let RtBroPg1 = ComplexInsertRecords(Tree, PathStk, IS)

	if RtBroPg1 ne Empty then HairyInsertRecords(Tree, PathStk, IS,
		RtBroPg1)
	]


and ComputeEntLens(IS, PSE) be

	[ IS>>IS.ELLLen = 0
	(IS>>IS.ELLPtr)>>ELL.CumEntLen^0 = 0
	let NextToScan = PSE>>PSE.ESLFront

	while NextToScan ne Empty do
		[ AppendEntSeqEntLens(IS, NextToScan)
		NextToScan = NextToScan>>ESLE.FwdP
		]
	]


and AppendEntSeqEntLens(IS, EntSeqEnt) be

	[ let LR = (IS>>IS.Tree)>>TREE.LengthRtn
	let CurSize = IS>>IS.ELLLen
	let EntLens = IS>>IS.ELLPtr

	let CumLen = EntLens>>ELL.CumEntLen^CurSize
	let WordsLeft = EntSeqEnt>>ESLE.EntSeqLen
	let BTEntry = EntSeqEnt>>ESLE.EntSeqP

	while WordsLeft gr 0 do
		[ CurSize = CurSize+1

		let LengthThisEntry =
			(offset BTE.Record/16)+
			LR(BTEntry+(offset BTE.Record/16))
		CumLen = CumLen+LengthThisEntry
		EntLens>>ELL.CumEntLen^CurSize = CumLen

		BTEntry = BTEntry+LengthThisEntry
		WordsLeft = WordsLeft-LengthThisEntry
		]

	IS>>IS.ELLLen = CurSize
	]


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

	[ if na ls 3 then RightFather = IS>>IS.ELLLen+1
	let EntLens = IS>>IS.ELLPtr
	resultis (EntLens>>ELL.CumEntLen^(RightFather-1)-
		EntLens>>ELL.CumEntLen^LeftFather)
	]


and DepositESL(Tree, PSE, Block, Length) = valof

	[ let LR = Tree>>TREE.LengthRtn

	let OrigLength = Length

	while PSE>>PSE.ESLFront ne Empty do

		[ let ESLFront = PSE>>PSE.ESLFront
		let ESP = ESLFront>>ESLE.EntSeqP
		let ESLen = ESLFront>>ESLE.EntSeqLen

		test ESLen le Length

		ifso	[ MoveBlock(Block, ESP, ESLen)
			Block = Block+ESLen
			Length = Length-ESLen

			PSE>>PSE.ESLFront = ESLFront>>ESLE.FwdP
			Free(Tree>>TREE.Zone, ESLFront)
			]

		ifnot	[ let FirstRecP = lv (ESP>>BTE.Record)
			let FirstEntLen = LR(FirstRecP)+
					(offset BTE.Record/16)

			test FirstEntLen le Length

			ifso	[ MoveBlock(Block, ESP, FirstEntLen)
				Block = Block+FirstEntLen
				Length = Length-FirstEntLen

				ESLFront>>ESLE.EntSeqP =
					ESP+FirstEntLen
				ESLFront>>ESLE.EntSeqLen =
					ESLen-FirstEntLen
				]

			ifnot	resultis OrigLength-Length
			]
		]

	PSE>>PSE.ESLRear = Empty
	resultis OrigLength-Length
	]