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


//	BTREEDEL.BCPL  -- Routines for deleting from B-Trees

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

get "btree.decl"

external
	[ Allocate	// Defined by OS
	Free
	DefaultArgs
	Dvec

	ReadBTreePage	// defined by OpenBTree
	WriteBTreePage
	LockBTreePtr
	UnlockBTreePtr
	FreeBTreePage
	BTreeBug

	PathRecLE	// Defined by BTreeRead.bcpl
	ReadPageAndLockBTreePtr
	PopStack
	RepairOffsets
	BackUpOneRecord

	RemoveEntry	// Defined by BTreeWrt.bcpl
	MakeEntSeqEnt
	AppendEntSeqEnt
	PushEntSeqEnt
	InsertRecords
	FabricateIS
	FreeIS
	]

external
	[ DeleteKey	// Defined in BTREEDEL.BCPL
	]


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

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

	PathRecLE(Tree, PathStk, UseExistingPath, Key, CKRtn)

	let OrigPathStkTop = PathStk>>PS.PathStkTop
	if OrigPathStkTop eq 0 then resultis false

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

	let PagePtr = nil
	ReadPageAndLockBTreePtr(Tree, SP>>PSE.PageNo, lv PagePtr)
	if CKRtn(Key, lv ((PagePtr+SP>>PSE.LastOffset)
			>>BTE.Record)) ne 0 then
		[ UnlockBTreePtr(Tree, lv PagePtr)
		resultis false
		]

	Tree>>TREE.RecordCount = Tree>>TREE.RecordCount-1
	Tree>>TREE.StateDirty = true
	Tree>>TREE.Version = Tree>>TREE.Version+1

	BackUpOneRecord(Tree, SP) // offset should index deletion victim
	let DescendantPg = (PagePtr+SP>>PSE.LastOffset)>>BTE.GrPtr
	let DSP = SP

	while DescendantPg ne Empty do
		[ // deletion surrogate is greatest key less than victim's
		PathStk>>PS.PathStkTop = PathStk>>PS.PathStkTop+1
		DSP = lv (PathStk>>PS.PSE^(PathStk>>PS.PathStkTop))
		DSP>>PSE.PageNo = DescendantPg
		PagePtr = 0
		PagePtr = ReadBTreePage(Tree, DescendantPg)
		DSP>>PSE.Offset = (Tree>>TREE.PageLength)-
			(PagePtr>>BTP.FreeWords)
		DSP>>PSE.LastOffset = Rec1Offset
		DSP>>PSE.NextToLastOffset = Rec0Offset
		RepairOffsets(Tree, DSP)
		DSP>>PSE.ESLFront = Empty
		DSP>>PSE.ESLRear = Empty
		DSP>>PSE.LeastSon = Empty

		DescendantPg = (PagePtr+DSP>>PSE.LastOffset)>>BTE.GrPtr
		]

	UnlockBTreePtr(Tree, lv PagePtr)

	test PathStk>>PS.PathStkTop gr OrigPathStkTop
	ifso	[ BackUpOneRecord(Tree, DSP) // offset should index surrogate
		let LeafPageESE = RemoveEntry(Tree, DSP)
		let NonLeafPageESE = RemoveEntry(Tree, SP,
			lv (LeafPageESE>>ESLE.EntSeqP)>>BTE.GrPtr)
		AppendEntSeqEnt(SP, LeafPageESE)
		Free(Tree>>TREE.Zone, NonLeafPageESE)
		]
	ifnot	[ Free(Tree>>TREE.Zone, RemoveEntry(Tree, SP))
		]

	let IS = FabricateIS(Tree, PathStk)

	while PathStk>>PS.PathStkTop ge 0 &
		(FatherMayNeedWork(Tree, PathStk, IS)?
			true,
			PathStk>>PS.PathStkTop gr OrigPathStkTop)
		do
		[ PopStack(PathStk)
		]

	FreeIS(IS)
	PathStk>>PS.PathStkTop = 0
	resultis true
	]


and FatherMayNeedWork(Tree, PathStk, IS) = valof

	[ // This code assumes that
	// the son page is pointed to by the father page's
	// LastOffset index's GrPtr, and that this condition is
	// preserved by InsertRecords.
	

	let NeedsWork = ChangeInFather(Tree, PathStk, IS)

	let PathStkTop = PathStk>>PS.PathStkTop
	let SP = lv (PathStk>>PS.PSE^PathStkTop)
	let CurPage = SP>>PSE.PageNo
	let CurPtr = nil
	ReadPageAndLockBTreePtr(Tree, SP>>PSE.PageNo, lv CurPtr)
	let FreeWords = CurPtr>>BTP.FreeWords

	if PathStkTop eq 1 & FreeWords eq IS>>IS.MaxFreeWords then
		// Bye-bye, old root page!
		[ Tree>>TREE.RootPage = CurPtr>>BTP.MinPtr
		Tree>>TREE.StateDirty = true
		UnlockBTreePtr(Tree, lv CurPtr)
		FreeBTreePage(Tree, SP>>PSE.PageNo)
		resultis false
		]

	if PathStkTop eq 1 %
		(IS>>IS.MaxFreeWords-FreeWords) ge IS>>IS.PrettyFull then
			[ UnlockBTreePtr(Tree, lv CurPtr)
			resultis NeedsWork
			]

	AppendEntSeqEnt(SP,
			MakeEntSeqEnt(Tree>>TREE.Zone, CurPtr+Rec1Offset,
				IS>>IS.MaxFreeWords-FreeWords))

	let SFP = lv (PathStk>>PS.PSE^(PathStkTop-1))
	let OtherPtr = nil
	ReadPageAndLockBTreePtr(Tree, SFP>>PSE.PageNo, lv OtherPtr)
	let FatherOffset = SFP>>PSE.Offset
	let FatherFreeWords = OtherPtr>>BTP.FreeWords

	test ((FatherOffset-Rec1Offset) ls (IS>>IS.MaxFreeWords-
		FatherFreeWords)) % (SFP>>PSE.ESLFront ne Empty)

	ifso	// The current page has a right brother
		[ let RtBroPg = nil
		AppendEntSeqEnt(SP, RemoveEntry(Tree, SFP, lv RtBroPg))

		if (OtherPtr+SFP>>PSE.LastOffset)>>BTE.GrPtr ne CurPage then
			BTreeBug(Tree, ecMcCreightWasWrong)
		(OtherPtr+SFP>>PSE.LastOffset)>>BTE.GrPtr = RtBroPg

		OtherPtr = 0
		OtherPtr = WriteBTreePage(Tree, RtBroPg)
		OtherPtr>>BTP.MinPtr = CurPtr>>BTP.MinPtr

		SP>>PSE.PageNo = RtBroPg
		SP>>PSE.Offset = Rec1Offset
		SP>>PSE.LastOffset = Rec0Offset
		SP>>PSE.NextToLastOffset = Empty

		CurPtr = 0
		FreeBTreePage(Tree, CurPage)
		]

	ifnot	// The current page surely has a left brother.
		[ BackUpOneRecord(Tree, SFP) // offset should index last rec
		PushEntSeqEnt(SP, RemoveEntry(Tree, SFP))

		CurPtr = 0
		FreeBTreePage(Tree, CurPage)

		CurPage = (OtherPtr+SFP>>PSE.LastOffset)
					>>BTE.GrPtr
		SP>>PSE.PageNo = CurPage
		CurPtr = ReadBTreePage(Tree, CurPage)
		SP>>PSE.Offset = Rec1Offset+
			(IS>>IS.MaxFreeWords-CurPtr>>BTP.FreeWords)
		SP>>PSE.LastOffset = Rec1Offset
		SP>>PSE.NextToLastOffset = Rec0Offset
		RepairOffsets(Tree, SP)
		]

	UnlockBTreePtr(Tree, lv OtherPtr)
	UnlockBTreePtr(Tree, lv CurPtr)
	ChangeInFather(Tree, PathStk, IS)
	resultis true
	]


and ChangeInFather(Tree, PathStk, IS) = valof

	[ let SP = lv (PathStk>>PS.PSE^(PathStk>>PS.PathStkTop))
	if SP>>PSE.ESLFront eq Empty then resultis false
	InsertRecords(Tree, PathStk, IS)
	if PathStk>>PS.PathStkTop eq 0 then resultis false
	resultis PathStk>>PS.PSE^(PathStk>>PS.PathStkTop-1).ESLFront ne Empty
	]