// IfsScav2-2.bcpl - Pass 2 Phase 2
// Copyright Xerox Corporation 1979, 1980
// Last modified November 15, 1980 10:01 PM by Boggs
get "BTree.decl"
get "IfsIsf.d"
get "IfsScavenger.decl"
external
[
// outgoing procedures
Pass2Phase2
// incoming procedures
Zero; Usc; IFSError; CallSwat
Allocate; Free; ReadCalendar
OpenFile; Closes; Gets; Puts; SetFilePos
Ws; PutTemplate; ScavConfirm; PrintTime
OpenFPTree; CloseIFSTree
ReadBTreePage; FreeBTreePage
LockBTreePtr; UnlockBTreePtr; FlushBuffers
// incoming statics
dsp; keys; debugFlag; sysZone
scavDisk; initTreeFlag; phase; numPages; tree
]
static [ bitTable; maxLevel; lastRecord; numRecords ]
//----------------------------------------------------------------------------
let Pass2Phase2() = valof
//----------------------------------------------------------------------------
// This phase verifies the directory B-Tree (Ifs.dir).
// If the tree is damaged beyond the ability of this phase to fix,
// it is initialized to empty.
[
phase = 2
Ws("*N[2-2]"); if debugFlag then Gets(keys)
let fpIfsDir = vec lFP; Zero(fpIfsDir, lFP)
let ifsDir = OpenFile("Ifs.dir", 0, 0, 0, fpIfsDir, 0, 0, 0, scavDisk)
if ifsDir eq 0 then IFSError(ecScavengeeFile, "Ifs.dir")
// invalidate file map by zapping its seal
SetFilePos(ifsDir, 0, offset FM0.seal/8)
Puts(ifsDir, 0)
Closes(ifsDir)
let treeOK = nil
test initTreeFlag
ifnot
[
tree = OpenFPTree(fpIfsDir, scavDisk, CallSwat, CallSwat, false)
treeOK = tree>>TREE.LogPageLength eq 10
]
ifso
[
tree = 0
treeOK = false
]
if treeOK then
[
maxLevel, numPages, numRecords, lastRecord = 0, 0, 0, 0
let lenBitTable = (tree>>TREE.GreatestPage+15)/16
bitTable = Allocate(sysZone, lenBitTable); Zero(bitTable, lenBitTable)
Ws("*N[2-2] PostOrder"); if debugFlag then Gets(keys)
let startTime = vec 1; ReadCalendar(startTime)
LockBTreePtr(tree, lv lastRecord)
treeOK = FollowPtr(tree>>TREE.RootPage, 0)
UnlockBTreePtr(tree, lv lastRecord)
PrintTime(startTime)
]
// Pass2Phase2 (cont'd)
if treeOK then
[
if numRecords ne tree>>TREE.RecordCount then
Ws("*N[2-2] Record counts disagree")
tree>>TREE.RecordCount = numRecords
tree>>TREE.StateDirty = true
// reconstruct the free list
let numFreePages = 0
tree>>TREE.FirstFreePage = 0
tree>>TREE.StateDirty = true
for i = 1 to tree>>TREE.GreatestPage do
if (bitTable!(i/16) & (1 lshift (i rem 16))) eq 0 then
[
numFreePages = numFreePages +1
FreeBTreePage(tree, i)
]
PutTemplate(dsp, "*N[2-2] $UD levels, $UD pages allocated, $UD used, $UD free.",
maxLevel, tree>>TREE.GreatestPage, numPages, numFreePages)
]
if bitTable ne 0 then Free(sysZone, bitTable)
if tree ne 0 then CloseIFSTree(tree)
unless treeOK do
if (initTreeFlag? true, ScavConfirm("*N[2-2] May I initialize the tree?")) then
[
CloseIFSTree(OpenFPTree(fpIfsDir, scavDisk, CallSwat, CallSwat, true))
initTreeFlag = true
treeOK = true
]
FlushBuffers()
resultis treeOK
]
//---------------------------------------------------------------------------
and FollowPtr(ptr, level) = valof
//---------------------------------------------------------------------------
// ptr purports to be a pointer to (ie a page number of) a page at 'level'.
// The root page is at level 0. Check and follow ptr if it appears ok.
[
if ptr eq 0 then //we touched bottom
[
if maxLevel eq 0 then maxLevel = level //first time only
test level eq maxLevel //do we always touch bottom at the same level?
ifso resultis true
ifnot [ Ws("*N[2-2] Tree is not of uniform depth"); resultis false ]
]
// mark the page as accessible in the bit table
if Usc(ptr, tree>>TREE.GreatestPage) gr 0 then
[ Ws("*N[2-2] Pointer gr TREE.GreatestPage"); resultis false ]
let bitWord = bitTable!(ptr/16)
let pageBit = 1 lshift (ptr rem 16)
test (bitWord & pageBit) eq 0
ifso bitTable!(ptr/16) = bitWord % pageBit
ifnot [ Ws("*N[2-2] Two pointers to same B-Tree page"); resultis false ]
let page = 0; LockBTreePtr(tree, lv page)
let ok = valof //ptr seems reasonable, follow it.
[
page = ReadBTreePage(tree, ptr)
numPages = numPages +1
if page>>BTP.FreeWords ls 0 then
[ Ws("*N[2-2] Free page encountered"); resultis false ]
let pageLength = 1 lshift tree>>TREE.LogPageLength
if page>>BTP.FreeWords gr 2*pageLength/3 & level ne 0 & debugFlag then
Ws("*N[2-2] Page is < 1/3 full") //non fatal according to EMM
if page>>BTP.FreeWords gr pageLength-PageOverhead then
[ Ws("*N[2-2] BTP.Freewords > maxFreeWords"); resultis false ]
unless FollowPtr(page>>BTP.MinPtr, level+1) resultis false
let recordsOnThisPage = 0
let bte = lv page>>BTP.BTEBlock
let end = (page + pageLength) - page>>BTP.FreeWords
while Usc(bte, end) ls 0 do
[
numRecords = numRecords +1
recordsOnThisPage = recordsOnThisPage +1
let record = lv bte>>BTE.Record
if (record>>DR.header & drHeaderMask) ne 0 then
[ Ws("*N[2-2] Malformed dr"); resultis false ]
if lastRecord ne 0 then
if CompareRecords(lastRecord, record) ge 0 then
[ Ws("*N[2-2] Records out of order"); resultis false ]
lastRecord = record
unless FollowPtr(bte>>BTE.GrPtr, level+1) resultis false
bte = bte + 1 + record>>DR.length
]
if bte ne end then [ Ws("*N[2-2] BTE overflow"); resultis false ]
if level ne 0 & recordsOnThisPage ls 4 & debugFlag then
Ws("*N[2-2] Page has < 4 records") //non fatal according to EMM
resultis true
]
UnlockBTreePtr(tree, lv page)
resultis ok
]
//---------------------------------------------------------------------------
and CompareRecords(r1, r2) = valof
//---------------------------------------------------------------------------
// Compares two B-Tree records in the same manner as DirCompareKey.
// This differs from DirCompareKey in that it compares two records
// rather than a key and a record.
// If a dr is malformed, return 0, which will terminate the scan.
// Returning 0 will cause a bogus "Records out of order" message.
[
// find position of last "!" in first record
let lenBodyString = nil
for i = r1>>DR.pathName.length to 1 by -1 do
if r1>>DR.pathName.char↑i eq $! then [ lenBodyString = i; break ]
// Compare chars in the "<dir>name!" (string) portion
let lenR2 = r2>>DR.pathName.length
for i = 1 to lenBodyString do
[
// If we run off the end of r2 then r1 is greater.
if i gr lenR2 resultis 1
let c1 = r1>>DR.pathName.char↑i
let c2 = r2>>DR.pathName.char↑i
if c1 ne c2 then
[
// Lower-case alphabetics collate with upper-case
if c1 ge $a & c1 le $z then c1 = c1-($a-$A)
if c2 ge $a & c2 le $z then c2 = c2-($a-$A)
if c1 ne c2 then
[
// Definitely a mismatch. If all remaining characters of the
// record are digits then the record body is an initial substring
// of the key and we declare the key to be greater. Otherwise we
// return the result of comparing the mismatching character codes.
if c1 ls c2 then
for j = i to lenR2 do
[
let digit = r2>>DR.pathName.char↑j - $0
if digit ls 0 % digit gr 9 resultis Usc(c1, c2)
]
resultis 1
]
]
]
// bodies equal, now parse the version strings and compare them numerically.
// It must be possible to parse r1's version; if not, the record is malformed.
// If the attempt at parsing r2's version is unsuccessful, then
// return -1 so that, e.g., "foo!123" collates before "foo!xyz!1".
let v1 = 0
for i = lenBodyString+1 to r1>>DR.pathName.length do
[
let digit = r1>>DR.pathName.char↑i - $0
if digit ls 0 % digit gr 9 then
[ Ws("*N[2-2] Malformed dr"); resultis 0 ] //see comment above
v1 = 10*v1+digit
]
let v2 = 0
for i = lenBodyString+1 to lenR2 do
[
let digit = r2>>DR.pathName.char↑i - $0
if digit ls 0 % digit gr 9 resultis -1 //non-digit encountered
v2 = 10*v2+digit
]
resultis Usc(v1, v2)
]