// 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, 3000) 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 "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) ]