// ScavScan.bcpl -- analyzes the disk
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified September 29, 1982  1:30 AM by Boggs

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

external
[
// outgoing procedures
ScanDisk; CreateD; ForAllFDs; CheckedVDA

// incoming procedures
XferPage; XferError; GetBit; SetBit
GetString; Confirm; Ws; SysErr

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

// outgoing statics
usedBT; badBT; fdbQ
banzaiFlag

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

static
[
usedBT; badBT; fdbQ; rdbQ
banzaiFlag; restartFlag
]

manifest 
[
// pt reserved values:
ptFree = -1
ptIncor = -2
ptGood = -3
ptBad = -4
ptToBeChecked = -5
]

structure RD:		// Run Descriptor
[
fd word			// -> fd for this file
firstBack word		// backP of first page of run
firstPN word		// PN of first page of run
lastNext word		// nextP of last page of run
used bit		// this RD is part of a chain starting from an FD
lastPN bit 15		// PN of last page of run
]
manifest lenRD = size RD/16

structure DB:		// File or Run Descriptor Block
[
link word		// -> next DB or zero if none
ptr word		// DB-relative ptr to next available word
max word		// DB-relative ptr to first word not in DB
]
manifest lenDB = size DB/16

structure DQ:		// Queue of DBs
[
head word		// head of queue of DBs
tail word		// tail of queue of DBs
lenD word		// length of Ds in a DB on this queue
]
manifest lenDQ = size DQ/16

structure String [ length byte; char^1,1 byte ]

//-----------------------------------------------------------------------------------------
let ScanDisk() be
//-----------------------------------------------------------------------------------------
[
Zero(pt, maxVDA+1); pt!0 = ptGood  //page zero
Zero(bt, maxVDA/8+1)
fdbQ = Allocate(sysZone, lenDQ); Zero(fdbQ, lenDQ); fdbQ>>DQ.lenD = lenFD
rdbQ = Allocate(sysZone, lenDQ); Zero(rdbQ, lenDQ); rdbQ>>DQ.lenD = lenRD

sysZone!2 = ScanOutOfSpace
   [
   // Scan the disk building data structures and doing page-level checks
   restartFlag = false
   let zoneLength = sysDisk>>DSK.lengthCBZ + 28*sysDisk>>DSK.lengthCB
   let cbz = Allocate(sysZone, zoneLength)
   InitializeDiskCBZ(sysDisk, cbz, 0, zoneLength, ScanRetry, lv ScanError)
   cbz>>CBZ.cleanupRoutine = ScanCleanup
   ScanRetry: let scanVDA = cbz>>CBZ.errorDA
   while scanVDA le maxVDA & not restartFlag do
      [
      if pt!scanVDA eq 0 then
         DoDiskCommand(sysDisk, GetDiskCb(sysDisk, cbz), data, scanVDA, 0, 0, DCreadLD)
      if (scanVDA & 77b) eq 0 then Idle()
      scanVDA = scanVDA +1
      ]
   while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(sysDisk, cbz)
   Free(sysZone, cbz)
   if restartFlag loop
   for vda = 0 to maxVDA if pt!vda eq ptToBeChecked then pt!vda = 0

   // Do file-level checks
   restartFlag = false
   ForAllFDs(CheckFile)
   CompactDBs()
   ] repeatwhile restartFlag
sysZone!2 = SysErr
Free(sysZone, rdbQ)

// Create used-page and bad-page bit-tables
usedBT = bt; Zero(usedBT, maxVDA/16+1)
badBT = bt+maxVDA/16+1; Zero(badBT, maxVDA/16+1)
for vda = 0 to maxVDA do
   [
   let p = pt!vda
   test p eq ptFree
      ifso sysDisk>>BFSDSK.freePages = sysDisk>>BFSDSK.freePages +1
      ifnot SetBit(usedBT, vda, true)
   unless p eq ptGood % p eq ptFree % p eq ptIncor do
      [ SetBit(badBT, vda, true); logFlag = true ]
   ]
for vda = maxVDA+1 to (maxVDA/16)*16+15 do SetBit(usedBT, vda, true)
]

//-----------------------------------------------------------------------------------------
and ScanCleanup(disk, cb, cbz) be
//-----------------------------------------------------------------------------------------
[
if restartFlag return
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 = ptFree; return ]
if fid!0 eq -2 & fid!1 eq -2 & fid!2 eq -2 then [ pt!vda = ptIncor; 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)

// 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 = ptBad; return ]

// Work on the FD
let sn = lv dl>>DL.fileId.serialNumber
let best, duplicate = 0, false
let ha = (sn>>SN.word2 & 77777b) rem (maxVDA/8+1)
let fd = valof
   [
   let f = bt!ha; if f eq 0 resultis best
   if f>>FD.sn.word2 eq sn>>SN.word2 & f>>FD.sn.word1 eq sn>>SN.word1 then
      [
      if backP ne eofDA resultis f
      if f>>FD.firstVDA eq vda resultis f
      test f>>FD.firstVDA eq 0
         ifso best = f
         ifnot [ f>>FD.duplicate = true; duplicate = true ]
      ]
   ha = ha eq maxVDA/8? 0, ha+1
   ] repeat
if fd eq 0 then
   [
   fd = CreateD(fdbQ); if fd eq 0 return
   let ha = (sn>>SN.word2 & 77777b) rem (maxVDA/8+1)
      [
      if bt!ha eq 0 then [ bt!ha = fd; break ]  //insert
      ha = ha eq maxVDA/8? 0, ha+1  //collision; reprobe
      ] repeat
   fd>>FD.sn.word1 = sn>>SN.word1
   fd>>FD.sn.word2 = sn>>SN.word2
   fd>>FD.duplicate = duplicate
   ]
if backP eq eofDA then fd>>FD.firstVDA = vda
if nextP eq eofDA then
   [
   fd>>FD.lastVDA = vda
   fd>>FD.lastPN = pn
   fd>>FD.lastNumChars = nc
   ]
unless fd>>FD.state eq fdBeingChecked % fd>>FD.duplicate return

// ScanCleanup (cont'd)

// Work on the RD
let rd = pt!(vda-1)
if rd eq 0 % rd uge 177000b % rd>>RD.fd ne fd % backP ne vda-1 %
 rd>>RD.lastPN+1 ne pn % rd>>RD.lastNext ne vda then
   [
   rd = CreateD(rdbQ); if rd eq 0 return
   rd>>RD.fd = fd
   rd>>RD.firstBack = backP
   rd>>RD.firstPN = pn
   ]
rd>>RD.lastNext = nextP
rd>>RD.lastPN = pn

// enter page in pt
test nextP eq eofDA & rd>>RD.firstBack eq eofDA
   ifso  //single-run file: abandon RD
      [
      fd>>FD.state = fdGood
      for v = fd>>FD.firstVDA to fd>>FD.lastVDA do pt!v = ptGood
      rdbQ>>DQ.tail>>DB.ptr = rdbQ>>DQ.tail>>DB.ptr - lenRD
      ]
   ifnot pt!vda = rd
]

//-----------------------------------------------------------------------------------------
and ScanOutOfSpace(zn, ec, lSbData) = valof
//-----------------------------------------------------------------------------------------
[
// set every other fd in state fdBeingChecked to state fdToBeChecked
restartFlag = 0
ForAllFDs(RemoveHalf)

// flush all RDs
for vda = 0 to maxVDA do
   [
   let rd = pt!vda
   if rd ne 0 & rd uls 177000b then
      pt!vda = rd>>RD.fd>>FD.state eq fdToBeChecked? ptToBeChecked, 0
   ]
CompactDBs()

resultis 0
]

//-----------------------------------------------------------------------------------------
and RemoveHalf(fd, nil) be
//-----------------------------------------------------------------------------------------
[
if fd>>FD.state eq fdBeingChecked then
   [
   if (restartFlag & 1) ne 0 then fd>>FD.state = fdToBeChecked
   restartFlag = restartFlag +1
   ]
if fd>>FD.duplicate then fd>>FD.state = fdBeingChecked
]

//-----------------------------------------------------------------------------------------
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
//-----------------------------------------------------------------------------------------
[
logFlag = true
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 CheckFile(fd, nil) be
//-----------------------------------------------------------------------------------------
[
if fd>>FD.state ne fdBeingChecked then
   [
   if fd>>FD.state eq fdToBeChecked then
      [
      fd>>FD.state = fdBeingChecked
      restartFlag = true
      ]
   return
   ]

// check its structure
let vda, lastRD = fd>>FD.firstVDA, 0
fd>>FD.state = valof
   [
   let rd = pt!vda
   if rd eq 0 % rd uge 177000b % rd>>RD.used ne 0 resultis fdBad
   test fd>>FD.duplicate
      ifso rd>>RD.fd = fd
      ifnot if rd>>RD.fd ne fd resultis fdBad
   if lastRD ne 0 then
      if lastRD>>RD.lastPN+1 ne rd>>RD.firstPN %
       lastRD ne pt!(rd>>RD.firstBack) resultis fdBad
   rd>>RD.used = true
   if rd>>RD.lastNext eq eofDA then
      [
      if fd>>FD.duplicate ne 0 then
         [
         fd>>FD.lastPN = rd>>RD.lastPN
         fd>>FD.lastVDA = vda + (rd>>RD.lastPN - rd>>RD.firstPN)
         XferPage(DCreadLD, fd>>FD.lastVDA)
         fd>>FD.lastNumChars = label>>DL.numChars
         ]
      resultis fdGood
      ]
   vda, lastRD = rd>>RD.lastNext, rd
   ] repeat
if fd>>FD.state ne fdGood return

// mark it good
vda = fd>>FD.firstVDA
   [
   let rd = pt!vda
   while pt!vda eq rd do [ pt!vda = ptGood; vda = vda +1 ]
   vda = rd>>RD.lastNext
   ] repeatuntil vda eq eofDA
]

//-----------------------------------------------------------------------------------------
and ForAllFDs(Proc, arg) be
//-----------------------------------------------------------------------------------------
// Enumerates all active FDs and calls Proc(fd, arg)
[
let fdb = fdbQ!0; while fdb ne 0 do
   [
   let ptr = lenDB; while ptr ls fdb>>DB.ptr do
      [
      let fd = fdb + ptr
      Proc(fd, arg)
      ptr = ptr + lenFD
      ]
   fdb = fdb>>DB.link
   ]
]

//-----------------------------------------------------------------------------------------
and CreateD(q) = valof
//-----------------------------------------------------------------------------------------
// returns a pointer to an RD or an FD.
[
manifest dbSize = 240 + lenDB  //divisible by lenFD and lenRD
let db, lenD = q>>DQ.tail, q>>DQ.lenD
if q>>DQ.head eq 0 % db>>DB.ptr+lenD gr db>>DB.max then
   [
   db = Allocate(sysZone, dbSize); if db eq 0 resultis 0
   Zero(db, dbSize)
   db>>DB.ptr = lenDB
   db>>DB.max = dbSize
   Enqueue(q, db)
   ]
let d = db + db>>DB.ptr
db>>DB.ptr = db>>DB.ptr + lenD
resultis d
]

//-----------------------------------------------------------------------------------------
and CompactDBs() be
//-----------------------------------------------------------------------------------------
[
let lowestFDB = LowestFDB()
   [
   let rdb = Dequeue(rdbQ); if rdb eq 0 break
   test rdb ugr lowestFDB
      ifso
         [
         MoveBlock(rdb, lowestFDB, rdb>>DB.max)
         Unqueue(fdbQ, lowestFDB)
         Free(sysZone, lowestFDB)
         Enqueue(fdbQ, rdb)
         lowestFDB = LowestFDB()
         ]
      ifnot Free(sysZone, rdb)
   ] repeat
Zero(bt, maxVDA/8+1)
ForAllFDs(RehashFD)
]

//-----------------------------------------------------------------------------------------
and RehashFD(fd, nil) be
//-----------------------------------------------------------------------------------------
[
let ha = (fd>>FD.sn.word2 & 77777b) rem (maxVDA/8+1)
   [
   if bt!ha eq 0 then [ bt!ha = fd; return ]
   ha = ha eq maxVDA/8? 0, ha+1
   ] repeat
]

//-----------------------------------------------------------------------------------------
and LowestFDB() = valof
//-----------------------------------------------------------------------------------------
[
let lowestFDB = 177777b
let fdb = fdbQ!0; while fdb ne 0 do
   [
   if fdb uls lowestFDB then lowestFDB = fdb
   fdb = fdb>>DB.link
   ]
resultis lowestFDB
]