// TfuCertify.bcpl
// Copyright Xerox Corporation 1979, 1980
// Last modified June 14, 1980 2:59 PM by Taft
get "Altofilesys.d"
get "Disks.d"
get "Tfs.d"
external
[
//outgoing procedures
CertifyPack; ListBadSpots; ResetBadSpots
//incoming procedures
ConfirmWipe; BigDisplay; SmallDisplay
TFSInit; TFSClose; DataFix
TFSInitializeCbStorage; TFSGetCb; TFSDoDiskCommand; ActOnDiskPages
TFSDiskModel; VirtualDiskDA
Allocate; Free; Zero; MoveBlock
Ws; Gets; Puts; Endofs; PutTemplate; Random
//incoming statics
z; keys; dsp; TFSLeaveDisplay
]
static [ currentDA; et; saveDA ]
manifest maxETEntries = 100
structure ET:
[
nEntries word
entry↑0,maxETEntries-1 [ da @DA; nErrors word ]
]
manifest lenET = size ET/16
manifest
[
errorThreshold = 2
nBufs = 3
cursor = #431
rtc = #430
]
//----------------------------------------------------------------------------
let CertifyPack(drive, passes) be
//----------------------------------------------------------------------------
[
unless ConfirmWipe(drive) return
let disk = TFSInit(z, false, drive, 0, true)
if disk eq 0 then
[ PutTemplate(dsp, "*nCan't access drive $O", drive); return ]
et = Allocate(z, lenET)
Zero(et, lenET)
let bufVec = vec nBufs
for b = 0 to nBufs-1 do bufVec!b = Allocate(z, TFSwordsPerPage)
let buf = bufVec!0
unless TransferPage0(disk, buf, DCreadD) & buf>>BPL.seal eq bplSeal do
[
Zero(buf, TFSwordsPerPage)
buf>>BPL.seal = bplSeal
TransferPage0(disk, buf, DCwriteHLD)
]
let rCursor = table [ 0; 0; 0; #76000; #41000; #41000; #41000; #76000; #44000; #42000; #42000; #41000; #41000; 0; 0; 0 ]
let wCursor = table [ 0; 0; 0; #40400; #44400; #44400; #44400; #25000; #25000; #25000; #12000; #12000; #12000; 0; 0; 0 ]
let savedCursor = vec 16
MoveBlock(savedCursor, cursor, 16)
MoveBlock(cursor, wCursor, 16)
// Suck out a random number of random numbers
let c = (@#430 & #7777)
while c ne 0 do [ Random(); c = c-1 ]
for i = 1 to passes do
[
for b = 0 to nBufs-1 do
for w = 0 to TFSwordsPerPage-1 do (bufVec!b)!w = Random()
MoveBlock(cursor, wCursor, 16)
unless (i eq 1? InitHeaders, WritePass)(disk, bufVec) break
MoveBlock(cursor, rCursor, 16)
unless ReadPass(disk, bufVec) break
]
MoveBlock(cursor, savedCursor, 16)
TransferPage0(disk, buf, DCreadD)
for i = 0 to et>>ET.nEntries-1 do
if et>>ET.entry↑i.nErrors ge errorThreshold then
AppendBadSpot(buf, lv et>>ET.entry↑i.da)
TransferPage0(disk, buf, DCwriteD)
for b = 0 to nBufs-1 do Free(z, bufVec!b)
Free(z, et)
TFSClose(disk)
]
//----------------------------------------------------------------------------
and AppendBadSpot(bpl, da) be
//----------------------------------------------------------------------------
[
for i = 0 to bpl>>BPL.nBadPages-1 do
if DAsEqual(da, lv bpl>>BPL.da↑i) return //duplicate
test bpl>>BPL.nBadPages ge (TFSwordsPerPage - offset BPL.da/16)/2
ifso Ws("*nBad Page List is full!")
ifnot
[
MoveBlock(lv bpl>>BPL.da↑(bpl>>BPL.nBadPages), da, 2)
bpl>>BPL.nBadPages = bpl>>BPL.nBadPages+1
]
]
//----------------------------------------------------------------------------
and InitHeaders(disk, bufVec) = SweepDisk(disk, bufVec, DCwriteHLD)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and WritePass(disk, bufVec) = SweepDisk(disk, bufVec, DCwriteLD)
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and ReadPass(disk, bufVec) = valof
//----------------------------------------------------------------------------
[
static SysDataFix
let MyDataFix(block) = valof
[
DisplayOn()
let res = SysDataFix(block)
PutTemplate(dsp, "*n$S ECC error in $S at cyl $3D hd $2D sec $D",
(res eq -1? "Correctable", "Uncorrectable"),
selecton block>>KCBblock.Count into
[ case lDH: "Header"; case lDL: "Label"; case TFSwordsPerPage: "Data" ],
currentDA>>DA.track, currentDA>>DA.head, currentDA>>DA.sector)
RegisterError(currentDA)
Hesitate()
DisplayOff()
resultis res
]
SysDataFix = DataFix
DataFix = MyDataFix
let res = SweepDisk(disk, bufVec, DCreadLD)
DataFix = SysDataFix
resultis res
]
//----------------------------------------------------------------------------
and SweepDisk(disk, bufVec, action) = valof
//----------------------------------------------------------------------------
// bufVec is a pointer to nBufs data buffers. This code cycles through
// the buffers in such a way as to cause adjacent cylinders to transfer
// to or from different buffers. This maximizes data interference between
// adjacent tracks on the disk surface.
[
let savedTFSLeaveDisplay = TFSLeaveDisplay
TFSLeaveDisplay = true
DisplayOff()
let SweepDiskCleanup(disk, cb, cbz) be IncrementDA(disk, currentDA)
let v = vec 2; currentDA = v
Zero(currentDA, 2)
currentDA>>DA.sector = 1
let res = true
let cbz = vec CBzoneLength
TFSInitializeCbStorage(disk, cbz, 0, CBzoneLength, SDretry, lv SweepDiskErr)
cbz>>CBZ.cleanupRoutine = SweepDiskCleanup
SDretry:
[
let nextDA = vec 2
MoveBlock(nextDA, currentDA, 2)
if res then until nextDA!0 eq 0 & nextDA!1 eq 0 do
[ // Work done once per cylinder and before each retry
if UserAbort() then [ res = false; break ]
let buf = bufVec!(nextDA>>DA.track rem nBufs)
// This nonsense necessary to subvert TFSDoDiskCommand's label setup
let fileID = lv buf>>DL.fileId
disk>>TFSDSK.packID = buf>>DL.packID
let page = buf>>DL.pageNumber
[ // Work done once per page
let cb = TFSGetCb(disk, cbz)
MoveBlock(lv cb>>CB.diskAddress, nextDA, 2)
cb>>CB.AddrL = buf
TFSDoDiskCommand(disk, cb, buf, fillInDA, fileID, page, action)
IncrementDA(disk, nextDA)
] repeatuntil nextDA!1 eq 0
]
while cbz>>CBZ.head ne 0 do TFSGetCb(disk, cbz)
]
disk>>TFSDSK.packID = 0
DisplayOn()
TFSLeaveDisplay = savedTFSLeaveDisplay
resultis res
]
//----------------------------------------------------------------------------
and IncrementDA(disk, da) be
//----------------------------------------------------------------------------
[
da>>DA.sector = da>>DA.sector+1
if da>>DA.sector ge disk>>TFSDSK.nSectors then
[
da>>DA.sector = 0
da>>DA.head = da>>DA.head+1
if da>>DA.head ge disk>>TFSDSK.nHeads then
[
da>>DA.head = 0
da>>DA.track = da>>DA.track+1
if da>>DA.track ge disk>>TFSDSK.nTracks then
da>>DA.track = 0
]
]
]
//---------------------------------------------------------------------------
and SweepDiskErr(nil, cb, code) be
//---------------------------------------------------------------------------
[
DisplayOn()
let da = lv cb>>CB.diskAddress
PutTemplate(dsp, "*nUnrecoverable disk error at cyl $3D hd $2D sec $D",
da>>DA.track, da>>DA.head, da>>DA.sector)
Hesitate()
DisplayOff()
]
//---------------------------------------------------------------------------
and TransferPage0(disk, buf, action) = valof
//---------------------------------------------------------------------------
// Transfers physical page 0 to or from the buffer, returning true
// if successful and false otherwise.
[
let DAs = vec 2
// Passing a DA of fillInDA causes TFSDoDiskCommand not to compute
// the real DA. Since the CB has been zeroed, a real DA of zero results.
DAs!0 = eofDA; DAs!1 = fillInDA; DAs!2 = eofDA
resultis ActOnDiskPages(disk, lv buf, DAs+1, table [ 0; 0; 0 ], 0, 0, action,
0, 0, 0, 0, 0, true) eq 0
]
//---------------------------------------------------------------------------
and RegisterError(da) be
//---------------------------------------------------------------------------
[
let i = 0
while i ls et>>ET.nEntries do
[
if DAsEqual(da, lv et>>ET.entry↑i.da) then
[ et>>ET.entry↑i.nErrors = et>>ET.entry↑i.nErrors+1; return ]
i = i+1
]
test i ls maxETEntries
ifso
[
MoveBlock(lv et>>ET.entry↑i.da, da, 2)
et>>ET.entry↑i.nErrors = 1
et>>ET.nEntries = et>>ET.nEntries+1
]
ifnot
Ws("*nError table full!")
]
//---------------------------------------------------------------------------
and DAsEqual(da1, da2) = da1!0 eq da2!0 & da1!1 eq da2!1
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and DisplayOff() be [ saveDA = @DAstart; @DAstart = 0 ]
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and DisplayOn() be @DAstart = saveDA
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and Hesitate() be
//---------------------------------------------------------------------------
[
let t = @rtc+15
while t-@rtc ge 0 do loop
]
//---------------------------------------------------------------------------
and UserAbort() = valof
//---------------------------------------------------------------------------
[
unless Endofs(keys) do
[
DisplayOn()
Gets(keys)
Ws("[Command: ")
let c = Gets(keys)
Puts(dsp, c)
Ws("]")
DisplayOff()
resultis c eq $Q % c eq $q
]
resultis false
]
//---------------------------------------------------------------------------
and ListBadSpots(drive) be
//---------------------------------------------------------------------------
[
let disk = TFSInit(z, false, drive, 0, true)
if disk eq 0 then
[ PutTemplate(dsp, "Can't access drive $O", drive); return ]
BigDisplay()
let buf = vec TFSwordsPerPage
test TransferPage0(disk, buf, DCreadD) & buf>>BPL.seal eq bplSeal
ifso
test buf>>BPL.nBadPages eq 0
ifso Ws("*nThis pack has no known bad spots.")
ifnot for i = 0 to buf>>BPL.nBadPages-1 do
[
let da = lv buf>>BPL.da↑i
let fs = (da>>DA.track)/(disk>>TFSDSK.nVTracks)
disk>>TFSDSK.firstVTrack = (disk>>TFSDSK.nVTracks)*fs
let vda = VirtualDiskDA(disk, da)
PutTemplate(dsp, "*n Cyl $3D hd $2D sec $D = VDA $UD in FS $D",
da>>DA.track, da>>DA.head, da>>DA.sector, vda, fs)
]
ifnot
Ws("*nThis pack's bad spot table has not been initialized.")
TFSClose(disk)
SmallDisplay()
]
//---------------------------------------------------------------------------
and ResetBadSpots(drive) be
//---------------------------------------------------------------------------
[
let disk = TFSInit(z, false, drive, 0, true)
if disk eq 0 then
[ PutTemplate(dsp, "Can't access drive $O", drive); return ]
let buf = vec TFSwordsPerPage
Zero(buf, TFSwordsPerPage)
TransferPage0(disk, buf, DCwriteD)
TFSClose(disk)
]