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

//	BTreeCheck.bcpl  -- Routines for checking B-Trees

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

get "btree.decl"

external
	[ DefaultArgs
	SysErr
	TruePredicate

	LockBTreePtr	// defined in OpenBTree
	UnlockBTreePtr

	MapTree	// defined in BTreeRead
	]


external
	[
	CheckTree	// outgoing procedues

	GapBetweenChecks // outgoing statics
	]


static	
	[ GapBetweenChecks = 0
	GapToNextCheck = 0
	]


structure CS:
	[ lastRecord word
	RecordCount word
	CompareRecords word
	ErrorRtn word
	]


let CheckTree(Tree, CKRtn, forceCheck, ErrorRtn; numargs na) = valof

	[ DefaultArgs(lv na, -1, Tree>>TREE.CompareKeyRtn, false, SysErr)

	unless forceCheck do
		[ if GapBetweenChecks eq 0 then resultis true
		if GapToNextCheck ne 0 then
			[ GapToNextCheck = GapToNextCheck-1
			resultis true
			]
		GapToNextCheck = GapBetweenChecks-1
		]

	let CS = vec size CS/16
	CS>>CS.lastRecord = Empty
	CS>>CS.RecordCount = 0
	CS>>CS.CompareRecords = CKRtn
	CS>>CS.ErrorRtn = ErrorRtn

	LockBTreePtr(Tree, lv (CS>>CS.lastRecord))
	let result = MapTree(Tree, 0, CheckPair, CS,
		TruePredicate, true)  // TruePredicate always returns -1
	UnlockBTreePtr(Tree, lv (CS>>CS.lastRecord))

	if Tree>>TREE.RecordCount ne CS>>CS.RecordCount then
		[ ErrorRtn(Tree, ecRecordCountsDisagree)
		Tree>>TREE.RecordCount = CS>>CS.RecordCount
		Tree>>TREE.StateDirty = true
		resultis false
		]

	resultis result
	]


and CheckPair(thisRecord, CS, PathStk) = valof

	[ CS>>CS.RecordCount = CS>>CS.RecordCount+1

	if CS>>CS.lastRecord ne Empty then
		if (CS>>CS.CompareRecords)(CS>>CS.lastRecord, thisRecord) ge 0 then
			[ (CS>>CS.ErrorRtn)(PathStk, ecRecordsOutOfOrder)
			resultis false
			]
	CS>>CS.lastRecord = thisRecord
	resultis true
	]