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