// 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
]