// ScavDirs.bcpl -- Reconstruct Directories
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified September 29, 1982 1:32 AM by Boggs
get "Streams.d"
get "AltoFileSys.d"
get "Disks.d"
get "BFS.d"
get "Scavenger.decl"
external
[
// outgoing procedures
FixDirs
// incoming procedures
GetBit; SetBit; GetString; XferPage; Ws; CopyString
CreateD; ForAllFDs; FindDShape; WouldHave; CheckedVDA
FindFdEntry; MakeNewFdEntry
FileLength; FilePos; SetFilePos
ReadBlock; WriteBlock; ReadLeaderPage
CreateDiskStream; TruncateDiskStream
RealDiskDA; VirtualDiskDA; AssignDiskPage
MoveBlock; Zero; DoubleAdd; DoubleUsc
Allocate; Free; Enqueue; Dequeue
PutTemplate; Closes; Gets; Puts
// incoming statics
sysZone; sysDisk; dsp
alterFlag; label; data
logFlag; keys; maxVDA
badBT; usedBT; pt; fdbQ
banzaiFlag
]
manifest maxLenDV = lDV+maxLengthFnInWords+128 //from dirs.bcpl
static
[
dirFD // fd of current directory
dirName // string name of current directory
dirSt // stream open on current directory
newDvQ // queue of DVs to add to current directory
]
structure String [ length byte; char↑1,1 byte ]
//-----------------------------------------------------------------------------------------
let FixDirs() be
//-----------------------------------------------------------------------------------------
[
// Make sure SysDir exists
GuaranteeSysDir()
// Verify and compact directories
ForAllFDs(CheckDir)
// Insert lost files
ForAllFDs(InsertFile)
CloseDir()
while fdbQ!0 ne 0 do Free(sysZone, Dequeue(fdbQ))
Free(sysZone, fdbQ)
]
//-----------------------------------------------------------------------------------------
and GuaranteeSysDir() be
//-----------------------------------------------------------------------------------------
[
let fd = FindFile(1)
if fd ne 0 & fd>>FD.state eq fdGood &
fd>>FD.sn.word1 eq 100000b & fd>>FD.sn.word2 eq 144b return
// main directory is lost!
unless alterFlag do
[
Ws("*NThe main directory (SysDir) is lost.")
Ws("*NI cannot proceed without altering your disk.")
Ws("*NType any key to finish.")
Gets(keys)
finish
]
// rip off page 1 of disk
test GetBit(badBT, 1)
ifso SetBit(badBT, 1, false)
ifnot test GetBit(usedBT, 1)
ifnot SetBit(usedBT, 1, true)
ifso
[
Ws("*NPage 1 of the disk was ripped off to make SysDir.")
Ws("*NScavenge again to recover the damaged file.")
]
// find a second page for SysDir
let page1 = AssignDiskPage(sysDisk, 1)
// Write page 0 of SysDir
Zero(data, 256)
CopyString(lv data>>LD.name, "SysDir.")
label>>DL.fileId.serialNumber.word1 = 100000b
label>>DL.fileId.serialNumber.word2 = 144b
label>>DL.fileId.version = 1
label>>DL.pageNumber = 0
label>>DL.numChars = 512
label>>DL.previous = 0
RealDiskDA(sysDisk, page1, lv label>>DL.next)
XferPage(DCwriteLD, 1)
// Write page 1 of SysDir
label>>DL.pageNumber = 1
label>>DL.numChars = 0
RealDiskDA(sysDisk, 1, lv label>>DL.previous)
label>>DL.next = 0
XferPage(DCwriteLD, page1)
// Enter in FD list so ForAllFDs will generate it
if fd eq 0 then fd = CreateD(fdbQ)
fd>>FD.sn.word1 = 100000b
fd>>FD.sn.word2 = 144b
fd>>FD.firstVDA = 1
fd>>FD.state = fdGood
]
//-----------------------------------------------------------------------------------------
and CheckDir(fd, nil) be
//-----------------------------------------------------------------------------------------
// Verify and compact a directory
[
unless fd>>FD.sn.directory & fd>>FD.state eq fdGood return //not a directory file
OpenDir(fd)
let q = vec 1; q!0 = 0; newDvQ = q
let maxFiles = maxVDA/11
let heap, buffer = pt, pt+maxFiles
let readPos = vec 1; FilePos(dirSt, readPos)
let writePos = vec 1; FilePos(dirSt, writePos)
let mangledDir = false; until mangledDir do
[
SetFilePos(dirSt, readPos)
let nWords = ReadBlock(dirSt, buffer, 10*maxFiles); if nWords eq 0 break
let nFiles, inDV = 0, buffer
while inDV uls buffer+nWords & nFiles ls maxFiles do
[
let type, length = inDV>>DV.type, inDV>>DV.length
if length eq 0 % length gr maxLenDV %
(type ne dvTypeFile & type ne dvTypeFree) then
[
PutTemplate(dsp, "*NStrange entry in directory $S.", dirName)
mangledDir = true
logFlag = true
break
]
if inDV+length ugr buffer+nWords break //dv overflows buffer
if type eq dvTypeFile then
[
heap!nFiles = inDV
nFiles = nFiles +1
]
inDV = inDV + length //advance to next dv
]
let len = vec 1; len!0 = 0; len!1 = (inDV-buffer) lshift 1
DoubleAdd(readPos, len)
let l, r = nFiles rshift 1, nFiles-1
if nFiles gr 1 then //heap sort on leader VDA
[
let dv = nil
test l gr 0
ifso [ l = l -1; dv = heap!l ]
ifnot
[
dv = heap!r; heap!r = heap!0
r = r -1
if r eq 0 then [ heap!0 = dv; break ]
]
let j, i = l, nil
[
i = j
j = j lshift 1 +1
if j gr r break
if j ls r then
if (heap!j)>>DV.fp.leaderVirtualDa uls (heap!(j+1))>>DV.fp.leaderVirtualDa then j = j+1
if (heap!j)>>DV.fp.leaderVirtualDa uls dv>>DV.fp.leaderVirtualDa break
heap!i = heap!j
] repeat
heap!i = dv
] repeat
for i = 0 to nFiles-1 do CheckDV(heap!i)
// CheckDir (cont'd)
SetFilePos(dirSt, writePos)
let outDV = buffer; while outDV uls inDV do
[
if outDV>>DV.type eq dvTypeFile then
if alterFlag then WriteBlock(dirSt, outDV, outDV>>DV.length)
outDV = outDV + outDV>>DV.length
]
FilePos(dirSt, writePos)
]
// append any new DVs created by CheckDV
if newDvQ!0 ne 0 then
[
SetFilePos(dirSt, writePos)
[
let newDV = Dequeue(newDvQ); if newDV eq 0 break
WriteBlock(dirSt, newDV+1, (newDV+1)>>DV.length)
Free(sysZone, newDV)
] repeat
FilePos(dirSt, writePos)
] // end of "until mangledDir do" loop
// Fill out file with free entries
let fileLength = vec 1; FileLength(dirSt, fileLength)
SetFilePos(dirSt, writePos)
Zero(buffer, 100)
buffer>>DV.type = dvTypeFree
buffer>>DV.length = 100
if alterFlag then
[
let left = vec 1; MoveBlock(left, fileLength, 2)
let pos = vec 1; FilePos(dirSt, pos)
pos!0 = not pos!0; pos!1 = not pos!1
DoubleAdd(pos, table [ 0; 1 ])
DoubleAdd(left, pos) //DoubleSubtract(left, pos)
if DoubleUsc(left, table [ 0; 1 ]) le 0 break
if DoubleUsc(left, table [ 0; 200 ]) ls 0 then
buffer>>DV.length = left!1 rshift 1
WriteBlock(dirSt, buffer, buffer>>DV.length)
] repeat
if alterFlag then TruncateDiskStream(dirSt) //possible odd byte
]
//-----------------------------------------------------------------------------------------
and CheckDV(dv) be
//-----------------------------------------------------------------------------------------
[
let name, newDV = lv dv>>DV.name, 0
if alterFlag then unless LegalName(name) do
name = GetName("*NFilename *"$S*" has bad syntax.", name)
if name ne lv dv>>DV.name then
[
let length = lDV + name>>String.length lshift 1 +1
newDV = Allocate(sysZone, length+1)
let oldDV = dv; dv = newDV+1
oldDV>>DV.type = dvTypeFree
dv>>DV.type = dvTypeFile
dv>>DV.length = length
MoveBlock(lv dv>>DV.fp, lv oldDV>>DV.fp, lFP)
CopyString(lv dv>>DV.name, name)
Free(sysZone, name)
name = lv dv>>DV.name
logFlag = true
]
let fd = FindFile(dv>>DV.fp.leaderVirtualDa)
if fd eq 0 % fd>>FD.state eq fdBad then //dv does not describe a wff.
[
logFlag = true
fd = Salvage(dv, fd) //but all may not be lost...
test fd eq 0
ifnot PutTemplate(dsp, "*N$PSalvaged $S>$S, SN $EUOb.",
WouldHave, nil, dirName, name, lv dv>>DV.fp.serialNumber)
ifso
[
PutTemplate(dsp, "*N$PDeleted entry for $S>$S, SN $EUOb.",
WouldHave, nil, dirName, name, lv dv>>DV.fp.serialNumber)
test newDV ne 0
ifso Free(sysZone, newDV)
ifnot dv>>DV.type = dvTypeFree
return
]
]
// FixSNs may have changed the file's SN
dv>>DV.fp.serialNumber.word1 = fd>>FD.sn.word1
dv>>DV.fp.serialNumber.word2 = fd>>FD.sn.word2
dv>>DV.fp.version = 1
test fd>>FD.registered
ifso PutTemplate(dsp, "*N$S>$S, SN $EUOb, is also listed under another name.",
dirName, name, lv fd>>FD.sn)
ifnot AdjustLeader(dv, fd)
if newDV ne 0 test dv>>DV.type eq dvTypeFile
ifso Enqueue(newDvQ, newDV)
ifnot Free(sysZone, newDV)
]
//-----------------------------------------------------------------------------------------
and Salvage(dv, fd) = valof
//-----------------------------------------------------------------------------------------
// dv is an entry from a directory for which no valid FD exists.
// It may be that a chain of pages starts there, but that it is illegal
// in some way, in which case all of the chain's pages are in badBT.
// If there is a chain, follow its forward links and repair minor damage,
// truncating if major damage is encountered.
// Returns an fd if the file is salvaged, otherwise returns 0.
[
let prevVDA, curVDA, nextVDA = 0, dv>>DV.fp.leaderVirtualDa, nil
banzaiFlag = -1
if CheckedVDA(curVDA) eq -3 resultis 0
unless GetBit(badBT, curVDA) resultis 0
let pn = 0
until curVDA eq eofDA do
[
XferPage(DCreadLD, curVDA)
RealDiskDA(sysDisk, prevVDA, lv label>>DL.previous)
label>>DL.pageNumber = pn
label>>DL.fileId.version = dv>>DV.fp.version
label>>DL.fileId.serialNumber.word1 = dv>>DV.fp.serialNumber.word1
label>>DL.fileId.serialNumber.word2 = dv>>DV.fp.serialNumber.word2
nextVDA = CheckedVDA(lv label>>DL.next)
if nextVDA ugr maxVDA then nextVDA = eofDA
test nextVDA eq eofDA
ifso
[
if pn eq 0 resultis 0
if label>>DL.numChars uge 512 then
[
PutTemplate(dsp, "*N$PSet numChars←511 bytes in last page of $S>$S, SN $EUOb.",
WouldHave, nil, dirName, lv dv>>DV.name, lv dv>>DV.fp.serialNumber)
label>>DL.next = 0
label>>DL.numChars = 511
]
]
ifnot test GetBit(badBT, nextVDA)
ifso label>>DL.numChars = 512
ifnot
[
if pn eq 0 resultis 0
PutTemplate(dsp, "*N$PTruncated $S>$S, SN $EUOb, after page $D.",
WouldHave, nil, dirName, lv dv>>DV.name, lv dv>>DV.fp.serialNumber, pn)
label>>DL.next = 0
label>>DL.numChars = 511
nextVDA = eofDA //to break the loop
]
SetBit(badBT, curVDA, false) //rescue page
if alterFlag then XferPage(DCwriteLD, curVDA)
pn = pn +1
prevVDA = curVDA
curVDA = nextVDA
]
// make an FD for the salvaged file
if fd eq 0 then fd = CreateD(fdbQ)
fd>>FD.firstVDA = dv>>DV.fp.leaderVirtualDa
fd>>FD.sn.word1 = dv>>DV.fp.serialNumber.word1
fd>>FD.sn.word2 = dv>>DV.fp.serialNumber.word2
fd>>FD.lastVDA = prevVDA
fd>>FD.lastPN = pn-1
fd>>FD.lastNumChars = label>>DL.numChars
resultis fd
]
//-----------------------------------------------------------------------------------------
and InsertFile(fd, nil) be
//-----------------------------------------------------------------------------------------
[
if fd>>FD.registered % fd>>FD.state ne fdGood return
logFlag = true
// find descriptor for this file's directory
XferPage(DCreadLD, fd>>FD.firstVDA)
let fp, dFD = lv data>>LD.dirFp, 0
if fp>>FP.serialNumber.directory then dFD = FindFile(fp>>FP.leaderVirtualDa)
if dFD eq 0 % dFD>>FD.state ne fdGood %
dFD>>FD.sn.word1 ne fp>>FP.serialNumber.word1 %
dFD>>FD.sn.word2 ne fp>>FP.serialNumber.word2 then dFD = FindFile(1)
OpenDir(dFD)
// check name syntax
let name = lv data>>LD.name
if alterFlag then unless LegalName(name) do
name = GetName("*NFilename *"$S*" has bad syntax.", name)
// enter it in directory
let hd = vec lHD
if alterFlag then until FindFdEntry(dirSt, name, 0, 0, hd) eq -1 do
[
let newName = GetName("*NFilename *"$S*" is already in use.", name)
if name ne lv data>>LD.name then Free(sysZone, name)
name = newName
]
let dv = vec maxLenDV; Zero(lv dv>>DV.fp, lFP)
dv>>DV.fp.serialNumber.word1 = fd>>FD.sn.word1
dv>>DV.fp.serialNumber.word2 = fd>>FD.sn.word2
dv>>DV.fp.version = 1
dv>>DV.fp.leaderVirtualDa = fd>>FD.firstVDA
if alterFlag then MakeNewFdEntry(dirSt, name, dv, hd, 0)
PutTemplate(dsp, "*N$PInserted $S, SN $EUOb, in directory $S.",
WouldHave, nil, name, lv dv>>DV.fp.serialNumber, dirName)
CopyString(lv dv>>DV.name, name)
if name ne lv data>>LD.name then Free(sysZone, name)
AdjustLeader(dv, fd)
]
//-----------------------------------------------------------------------------------------
and AdjustLeader(dv, fd) be
//-----------------------------------------------------------------------------------------
// Make leader page of fd match dv
[
XferPage(DCreadLD, fd>>FD.firstVDA)
// set symbolic name
CopyString(lv data>>LD.name, lv dv>>DV.name)
// set directory back pointer
let fp = lv data>>LD.dirFp
fp>>FP.serialNumber.word1 = dirFD>>FD.sn.word1
fp>>FP.serialNumber.word2 = dirFD>>FD.sn.word2
fp>>FP.version = 1
fp>>FP.leaderVirtualDa = dirFD>>FD.firstVDA
// set last page hint
let fa = lv data>>LD.hintLastPageFa
fa>>FA.da = fd>>FD.lastVDA
fa>>FA.pageNumber = fd>>FD.lastPN
fa>>FA.charPos = fd>>FD.lastNumChars
// put disk shape in leader page of SysDir
if dv>>DV.fp.leaderVirtualDa eq 1 then
[
let ds = data + FindDShape(data)
ds>>FPROP.type = fpropTypeDShape
ds>>FPROP.length = lDSHAPE +1
ds = ds +1
ds>>DSHAPE.nDisks = sysDisk>>BFSDSK.nDisks
ds>>DSHAPE.nTracks = sysDisk>>BFSDSK.nTracks
ds>>DSHAPE.nHeads = sysDisk>>BFSDSK.nHeads
ds>>DSHAPE.nSectors = sysDisk>>BFSDSK.nSectors
]
if alterFlag then XferPage(DCwriteD, fd>>FD.firstVDA)
fd>>FD.registered = true
]
//-----------------------------------------------------------------------------------------
and OpenDir(fd) be
//-----------------------------------------------------------------------------------------
[
if fd eq dirFD return //already open
CloseDir()
dirFD = fd
let dirFP = vec lFP; Zero(dirFP, lFP)
MoveBlock(lv dirFP>>FP.serialNumber, lv fd>>FD.sn, lSN)
dirFP>>FP.version = 1
dirFP>>FP.leaderVirtualDa = fd>>FD.firstVDA
dirSt = CreateDiskStream(dirFP, (alterFlag? ksTypeReadWrite, ksTypeReadOnly))
ReadLeaderPage(dirSt, data)
let dn = LegalName(lv data>>LD.name)? lv data>>LD.name, "?."
dirName = Allocate(sysZone, dn>>String.length rshift 1 +1)
CopyString(dirName, dn)
dirName>>String.length = dirName>>String.length -1 //remove trailing "."
]
//-----------------------------------------------------------------------------------------
and CloseDir() be
//-----------------------------------------------------------------------------------------
[
dirFD = 0
if dirSt then Closes(dirSt); dirSt = 0
if dirName then Free(sysZone, dirName); dirName = 0
]
//-----------------------------------------------------------------------------------------
and GetName(string, arg) = valof
//-----------------------------------------------------------------------------------------
[
PutTemplate(dsp, string, arg)
[
let name = GetString("*NType a new name: ")
if name>>String.char↑(name>>String.length) ne $. then
[
name>>String.char↑(name>>String.length+1) = $.
name>>String.length = name>>String.length +1
Puts(dsp, $.)
]
if LegalName(name) resultis name
Ws(" - bad syntax")
Free(sysZone, name)
] repeat
]
//-----------------------------------------------------------------------------------------
and LegalName(string) = valof
//-----------------------------------------------------------------------------------------
[
let length = string>>String.length
if length eq 0 % length gr maxLengthFn resultis false
for i = 1 to length-1 do
[
let c = string>>String.char↑i
unless ($a le c & c le $z) % ($A le c & c le $Z) % ($0 le c & c le $9) %
c eq $. % c eq $+ % c eq $- % c eq $! % c eq $$ resultis false
]
resultis string>>String.char↑length eq $.
]
//-----------------------------------------------------------------------------------------
and FindFile(firstVDA) = valof
//-----------------------------------------------------------------------------------------
[
let v, f = firstVDA, 0
ForAllFDs(MatchFD, lv v)
resultis f
]
//-----------------------------------------------------------------------------------------
and MatchFD(fd, lvV) be if lvV!0 eq fd>>FD.firstVDA then lvV!1 = fd
//-----------------------------------------------------------------------------------------