// ScavScan.bcpl -- analyzes the disk
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified April 29, 1982  10:32 AM by Boggs

// This is one of two implementations of the Scan pass of the Scavenger.
// This version uses a bounded amount of storage at the cost of possibly
//  running very slowly.  FChain runs in time proportional to the square
//  of the number of pages in a file.  This is fine for files up to a few
//  hundred pages, but Lisp.VirtualMem (6,000 pages) can take 1/2 hour!

get "AltoFileSys.d"
get "AltoDefs.d"
get "Streams.d"
get "Disks.d"
get "BFS.d"
get "Scavenger.decl"

external
[
// outgoing procedures
ScanDisk; CreateD; MapFiles

// incoming procedures
XferPage; XferError; GetBit; SetBit; Ws
GetString; Confirm; FChain; DoubleUsc

VirtualDiskDA; InitializeDiskCBZ
GetDiskCb; DoDiskCommand
Idle; Noop; Zero; SetBlock; MoveBlock; TruePredicate
Allocate; Free; Enqueue; Dequeue
PutTemplate

// outgoing statics
usedBT; badBT; fdbQ

// incoming statics
sysZone; sysDisk; dsp; log
maxVDA; alterFlag; data
logFlag; pt
]

static
[
usedBT; badBT
backBT; banzaiFlag; nFD; fdbQ
]

manifest
[
free = 77777b
bad = 77776b
good = 77775b
incor = 77774b
]

structure String [ length byte; char^1,1 byte ]

// pt!i may be good, bad, free, incor, or
// a nextP from the disk <40000b, or
// 100000b % i where i is the index of a file descriptor.
structure NP:		// Next pointer array element
[
lastPage bit 1
fdi bit 15		// fd index
]

//-----------------------------------------------------------------------------------------
let ScanDisk() be
//-----------------------------------------------------------------------------------------
[
Zero(pt, maxVDA+1)
backBT = Allocate(sysZone, maxVDA/16+1); Zero(backBT, maxVDA/16+1)
// N.B. pt is a word array but backBT is a bit array

// Phase 1: Sweep the disk and record all the nextPs
//          in pt and mark confirmed backPs in backBT
SweepDisk(ScanCleanup, TruePredicate, lv ScanError)

// Phase 2: check all the linkages 
SweepDisk(CheckBackPs, UnConfirmed)
// bit i of backBT is set if page i is a leader page (backP=0) or if
//  the page pointed to by i's backP points at page i (via its nextP)
for i = 1 to maxVDA if 1 ule pt!i & pt!i ule maxVDA test pt!(pt!i) eq free
   ifso pt!(pt!i) = bad
   ifnot if GetBit(backBT, pt!i) eq 0 then pt!i = bad
Free(sysZone, backBT)
// At this point all wfc's are represented by chains through pt
// which have no converging pointers since each link is confirmed
// by a back-pointer.  The cell pointed to by the last cell
// of a wfc is either bad or 0.  Circular wfc's are possible.
// pt!i = 0 => i is a plausible last page
//      = free => i is free (definitely)
//      = bad => i is bad
//      = incor => i is effectively bad during phase 3
//      = x => i>>NEXTP is a legal disk address and is
//		confirmed by the backP. i is part of a wfc.

// Phase 3: Discover all the wff's by sweeping the disk again.
//  We need only consider pages which are part of wfc's or
//  have pt!i = 0; others cannot be part of a wff.
// Invariant: let l be the page pointed to by the last page of a
//  wfc. If pt!l is bad then the wfc is not part of a wff. Otherwise
//  pt!l = 0 or pt!l<<NP.lastPage = 1. In the latter case pt!l<<NP.fdi
//  is a pointer to a file descriptor. All the pages on the wfc
//  (plus page l) so far encountered are consistent with this file
//  descriptor. If FD.firstVDA is 0 the first page of the file has not
//  been seen yet. Each active file descriptor is pointed to by just
//  one cell and represents a tentative wff.
fdbQ = Allocate(sysZone, 2); fdbQ!0 = 0
SweepDisk(CheckPage, Alive)

// Phase 4: Construct bit tables
MapFiles(MarkGood)

// Create used-page and bad-page bit-tables
usedBT = Allocate(sysZone, maxVDA/16+1); Zero(usedBT, maxVDA/16+1)
badBT = Allocate(sysZone, maxVDA/16+1); Zero(badBT, maxVDA/16+1)
for vda = 1 to maxVDA do
   [
   let p = pt!vda
   test p eq free
      ifso sysDisk>>BFSDSK.freePages = sysDisk>>BFSDSK.freePages +1
      ifnot SetBit(usedBT, vda, true)
   unless p eq good % p eq free % p eq incor do
      [ SetBit(badBT, vda, true); logFlag = true ]
   ]
SetBit(usedBT, 0, true)  //page zero, Sys.Boot's boot loader, is special
for vda = maxVDA+1 to (maxVDA/16)*16+15 do SetBit(usedBT, vda, true)
]

//-----------------------------------------------------------------------------------------
and ScanCleanup(disk, cb, cbz) be
//-----------------------------------------------------------------------------------------
[
let vda = VirtualDiskDA(sysDisk, lv cb>>CB.diskAddress)
let dl = cb>>CB.labelAddress

// Check for special labels
let fid = lv dl>>DL.fileId
if fid!0 eq -1 & fid!1 eq -1 & fid!2 eq -1 then [ pt!vda = free; return ]
if fid!0 eq -2 & fid!1 eq -2 & fid!2 eq -2 then [ pt!vda = incor; return ]

let pn = dl>>DL.pageNumber
let nc = dl>>DL.numChars
let nextP = CheckedVDA(lv dl>>DL.next)
let backP = CheckedVDA(lv dl>>DL.previous)
pt!vda = nextP eq eofDA? 0, nextP

// Check for obvious damage
if nc ugr 512 % pn ugr maxVDA % nextP eq vda % backP eq vda %
 nextP eq eofDA & (nc eq 512 % pn eq 0 % backP eq eofDA) %
 backP eq eofDA & (nc ne 512 % pn ne 0) %
 nextP ne eofDA & (nc ne 512 % nextP ugr maxVDA) %
 backP ne eofDA & (pn eq 0 % backP ugr maxVDA) then [ pt!vda = bad; return ]

test backP eq eofDA
  ifso SetBit(backBT, vda, true)
  ifnot if backP uls vda test pt!backP eq vda
     ifso SetBit(backBT, vda, true)
     ifnot pt!vda = bad
]

//-----------------------------------------------------------------------------------------
and ScanError(nil, cb, nil) be
//-----------------------------------------------------------------------------------------
[
XferError(nil, cb, nil)
let vda = VirtualDiskDA(sysDisk, lv cb>>CB.diskAddress)
let header, label, data = vec 2, cb>>CB.labelAddress, cb>>CB.dataAddress
if cb>>CB.status<<DST.finalStatus eq checkError then
   [  //header check error
   XferPage(DCreadHLD, vda, data, label, header, lv Noop)
   if (cb>>CB.diskAddress xor 2) eq header>>DH.diskAddress & 
    not banzaiFlag then
      [
      PutTemplate(dsp, "*NThe disk in drive $D looks like disk $D ",
       cb>>CB.diskAddress.disk, header>>DH.diskAddress.disk)
      banzaiFlag = Banzai("of a file system.")
      ]
   ]
if alterFlag then if Confirm("*NMay I rewrite the page?") then
   [
   XferPage(DCwriteHLD, vda, data, label, 0, lv Noop)
   if (XferPage(DCreadD, vda, data, label, 0, lv Noop) &
    DSTgoodStatusMask) ne DSTgoodStatus then
      [
      Ws(".  It's incorrigable.")
      SetBlock(lv label>>DL.fileId, -2, lFID)
      XferPage(DCwriteHLD, vda, data, label, 0, lv Noop)
      ]
   ]
]

//-----------------------------------------------------------------------------------------
and CheckedVDA(lvRealDA) = valof
//-----------------------------------------------------------------------------------------
[
if lvRealDA>>DA.restore ne 0 resultis -3
if lvRealDA>>DA.sector ge sysDisk>>BFSDSK.nSectors resultis -3
if lvRealDA>>DA.track ge sysDisk>>BFSDSK.nTracks resultis -3
if lvRealDA>>DA.disk ge sysDisk>>BFSDSK.nDisks then
   [
   unless banzaiFlag do
      [
      Ws("*NThis looks like part of a two disk file system, ")
      banzaiFlag = Banzai("but you are scavenging a single disk.")
      ]
   resultis -3
   ]
resultis VirtualDiskDA(sysDisk, lvRealDA)
]

//-----------------------------------------------------------------------------------------
and Banzai(string) = valof
//-----------------------------------------------------------------------------------------
[
Ws(string)
Ws("*NCheck your disks, then type *"BANZAI!*" ")
let answer = GetString("if you wish to continue scavenging: ")
let banzai = "BANZAI!"
if answer>>String.length ne banzai>>String.length finish
for i = 1 to banzai>>String.length do
   [
   let c1 = answer>>String.char^i
   if c1 ge $a & c1 le $z then c1 = c1-($a-$A)
   let c2 = banzai>>String.char^i
   if c2 ge $a & c2 le $z then c2 = c2-($a-$A)
   if c1 ne c2 finish
   ]
Free(sysZone, answer)
resultis true
]

//-----------------------------------------------------------------------------------------
and CheckBackPs(disk, cb, cbz) be
//-----------------------------------------------------------------------------------------
[
let vda = VirtualDiskDA(sysDisk, lv cb>>CB.diskAddress)
test pt!VirtualDiskDA(sysDisk, lv cb>>CB.label.previous) eq vda
   ifso SetBit(backBT, vda, true)
   ifnot pt!vda = bad
]

//-----------------------------------------------------------------------------------------
and UnConfirmed(vda) = 0 ule pt!vda & pt!vda ule maxVDA & GetBit(backBT, vda) eq 0
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and CheckPage(disk, cb, cbz) be
//-----------------------------------------------------------------------------------------
[
let vda = VirtualDiskDA(sysDisk, lv cb>>CB.diskAddress)
let sn = lv cb>>CB.label.fileId.serialNumber
let pn = cb>>CB.label.pageNumber
let lvLast = FChain(pt, vda, lv pn)

if lvLast ne 0 then  //fd found
   [
   let fd = nil
   test @lvLast eq 0 //first encounter with file?
      ifso
         [
         fd = CreateD()
         @lvLast = nFD
         MoveBlock(lv fd>>FD.sn, sn, 2)
         fd>>FD.lastPN = pn
         lvLast>>NP.lastPage = 1
         ]
      ifnot //check
         [
         let fdb, fdi, i = fdbQ!0, lvLast>>NP.fdi, 1
         while fdb ne 0 test i le fdi & fdi ls i+fdb>>DB.ptr
            ifnot [ i = i+fdb>>DB.ptr; fdb = fdb>>DB.link ]
            ifso [ fd = fdb+lenDB+(fdi-i)*lenFD; break ]
         unless fd>>FD.lastPN eq pn & DoubleUsc(lv fd>>FD.sn, sn) eq 0 do
            [ fd>>FD.firstVDA = 0; @lvLast = bad ]
         ]
   if cb>>CB.label.previous eq 0 then fd>>FD.firstVDA = vda
   if cb>>CB.label.next eq 0 then
      [
      fd>>FD.lastVDA = vda
      fd>>FD.lastNumChars = cb>>CB.label.numChars
      ]
   ]
]

//-----------------------------------------------------------------------------------------
and Alive(vda) = 0 ule pt!vda & pt!vda ule maxVDA
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and MarkGood(fd) be
//-----------------------------------------------------------------------------------------
[
let vda = fd>>FD.firstVDA
test fd>>FD.lastPN eq 0 // wff must have 2 pages
   ifso fd>>FD.firstVDA = 0
   ifnot [ let t = pt!vda; pt!vda = good; vda = t ] repeatuntil vda ls 0
]

//-----------------------------------------------------------------------------------------
and CreateD() = valof
//-----------------------------------------------------------------------------------------
// Returns an FD.
[
manifest dbSize = 240 + lenDB  //divisible by lenFD and lenRD
let fdb = fdbQ!1
if fdbQ!0 eq 0 % fdb>>DB.ptr eq (dbSize-lenDB)/lenFD then
   [
   fdb = Allocate(sysZone, dbSize); Zero(fdb, dbSize)
   Enqueue(fdbQ, fdb)
   ]
let fd = fdb + lenDB + fdb>>DB.ptr*lenFD
fdb>>DB.ptr = fdb>>DB.ptr +1
nFD = nFD +1
resultis fd
]

//-----------------------------------------------------------------------------------------
and MapFiles(Proc) be
//-----------------------------------------------------------------------------------------
// Enumerates all active FDs and calls Proc(fd)
[
let fdb = fdbQ!0
while fdb ne 0 do
   [
   for i = 0 to fdb>>DB.ptr-1 do
      [
      let fd = fdb + lenDB + i*lenFD
      if fd>>FD.firstVDA then Proc(fd)
      ]
   fdb = fdb>>DB.link
   ]
]

//-----------------------------------------------------------------------------------------
and SweepDisk(Proc, Live, lvError; numargs na) be
//-----------------------------------------------------------------------------------------
[
let zoneLength = sysDisk>>DSK.lengthCBZ +
 2*sysDisk>>BFSDSK.nSectors*sysDisk>>DSK.lengthCB
let cbz = Allocate(sysZone, zoneLength)
InitializeDiskCBZ(sysDisk, cbz, 0, zoneLength, SweepRetry,
 (na gr 2? lvError, lv XferError))
cbz>>CBZ.cleanupRoutine = Proc
cbz>>CBZ.errorDA = 1

SweepRetry: let sweepVDA = cbz>>CBZ.errorDA
while sweepVDA le maxVDA do
   [
   if Live(sweepVDA) then DoDiskCommand(sysDisk, GetDiskCb(sysDisk, cbz),
    data, sweepVDA, 0, 0, DCreadLD)
   sweepVDA = sweepVDA +1
   if (sweepVDA & 77b) eq 0 then Idle()
   ]

while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(sysDisk, cbz)
Free(sysZone, cbz)
]