// Certify.bcpl -- BFS Certify program
// Copyright Xerox Corporation 1986
// created November 23, 1986 7:18 PM by Putz
// Last modified November 24, 1986 5:59 AM by Putz
// To compile and load:
// BCPL/O Certify.bcpl
// Bldr/LV Certify BFSInit GP Template Random
get "Altofilesys.d"
get "AltoDefs.d"
get "Streams.d"
get "SysDefs.d"
get "Disks.d"
get "Bfs.d"
external
[
// incoming procedures
BFSInit // from BFSInit.br
PutTemplate // from Template.br
Random // from Random.br
ReadParam // from GP.br
SetupReadParam
// from OS
VirtualDiskDA; CloseDisk; BfsMakeFpFromLabel
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
Ws; dsp; keys; Endofs; Gets; Resets
OpenFile; Closes; CleanupDiskStream
Zero; MoveBlock; SetBlock; Noop; lvIdle; Idle
Allocate; Free; DefaultArgs; MyFrame; GotoLabel
sysZone; lvUserFinishProc; lvSysErr
]
static
[
label; data; machineType
maxVDA; certDisk; eTable
nDisks; nTracks; nSectors
origPartition; savedUFP; savedIdle
certPartition; currentPass; logFile
abortFlag = false
doPrompt = true
nPasses = 100 // default
]
manifest
[
maxETEntries = 200
errorThreshold = 1
abortChar = 3 // abort with control-C
]
structure String [ length byte; char↑1,1 byte ]
structure ET: //Error Table
[
nEntries word
entry↑0,maxETEntries-1 [ da word; nErrors word ]
]
manifest lenET = size ET/16
//----------------------------------------------------------------------------
let Certify() be
//----------------------------------------------------------------------------
[ Ws("Certify.run of November 24, 1986.")
// show "BFS" cursor
MoveBlock(cursorBitMap,
table [ 0; 0; 0; 0; 161706b; 111011b; 111010b; 161606b;
111001b; 111011b; 161006b; 0; 0; 0; 0; 0 ], 16)
machineType = AltoVersion()
if machineType ls 4 then
[ Ws("No partitions on this machine.")
abort
]
origPartition = ChangePartition(0)
savedIdle = @lvIdle
savedUFP = @lvUserFinishProc
@lvSysErr = MyErr
@lvUserFinishProc = MyCleanUp
// Allocate buffers
// let spaceLeft = nil
// Allocate(sysZone, 30000, lv spaceLeft)
// PutTemplate(dsp, "*NSpace left = $D", spaceLeft)
eTable = Allocate(sysZone, lenET)
data = Allocate(sysZone, 256)
label = Allocate(sysZone, 8)
logFile = OpenFile("Certify.log", ksTypeWriteOnly, charItem)
//get partition number and number of passes from command line
let switches = vec 50 // unpacked string
SetupReadParam(0, switches)
doPrompt = not ((switches!0 ge 1)
& ((switches!1 eq $y) % (switches!1 eq $Y)))
let noArgs = true
[ certPartition = ReadParam($D, -1)
while (switches!0 eq 1) & ((switches!1 & 0337) eq $P) do
[ // switch /P sets number of passes
nPasses = certPartition
certPartition = ReadParam($D, -1)
]
if certPartition eq -1 break
CertifyPartition()
noArgs = false
] repeatuntil abortFlag
if noArgs then Ws("*NUsage: Certify[/Yes] [nPasses/P] partNum ... partNum")
Free(sysZone, eTable)
Free(sysZone, data)
Free(sysZone, label)
]
and let CertifyPartition() be
[ ChangePartition(certPartition)
if ChangePartition(0) ne certPartition then abort
Zero(eTable, lenET)
unless GetDiskShape() abort
let format = "*NCertify BFS$D Disks: $D, Cylinders: $D, Heads: 2, Sectors: $D"
PutTemplate(dsp, format, certPartition, nDisks, nTracks, nSectors)
if doPrompt then
[ PutTemplate(dsp, "*NConfirm erase and certify BFS$D ($D passes)", certPartition, nPasses)
if not Confirm("? ") then finish
let now = @realTimeClock
while now + 5*27 ugr @realTimeClock loop
Resets(keys)
if not Confirm("*NAre you still sure? ") then finish
]
ChangePartition(origPartition)
PutTemplate(logFile, format, certPartition, nDisks, nTracks, nSectors)
ChangePartition(certPartition)
certDisk = BFSInit(sysZone, false, 0, 0, true)
certDisk>>BFSDSK.nDisks = nDisks
certDisk>>BFSDSK.nTracks = nTracks
certDisk>>BFSDSK.nSectors = nSectors
maxVDA = nDisks * nTracks * 2 * nSectors -1
@lvIdle = MyIdle
// Set up read and write cursors
let rCursor = table [
0; 0; 0; 76000b; 41000b; 41000b; 41000b; 76000b
44000b; 42000b; 42000b; 41000b; 41000b; 0; 0; 0 ]
let wCursor = table [
0; 0; 0; 40400b; 44400b; 44400b; 44400b; 25000b
25000b; 25000b; 12000b; 12000b; 12000b; 0; 0; 0 ]
let savedCursor = vec 16
MoveBlock(savedCursor, cursorBitMap, 16)
// suck out a random number of random numbers
let c = @realTimeClock & 7777b
while c ne 0 do [ Random(); c = c-1 ]
// certify the disk
for i = 1 to nPasses do
[ currentPass = i
for w = 0 to 255 do data!w = Random()
MoveBlock(cursorBitMap, wCursor, 16)
certDisk>>DSK.retryCount = 8
if SweepDisk(i eq 1? DCwriteHLD, DCwriteLD) break
MoveBlock(cursorBitMap, rCursor, 16)
certDisk>>DSK.retryCount = 1
if SweepDisk(DCreadLD) break
]
// mark bad spots incorrigable
certDisk>>DSK.retryCount = 8
SetBlock(lv label>>DL.fileId, -2, lFID)
for i = 0 to eTable>>ET.nEntries-1 do
if eTable>>ET.entry↑i.nErrors uge errorThreshold then
[ let da = eTable>>ET.entry↑i.da
let vda = VirtualDiskDA(certDisk, lv da)
XferPage(DCwriteHLD, vda, 0, label, 0, lv Noop)
let format = "*N BFS$D Un $D, Cyl $3F0D, Hd $D, Sec $2F0D. Errors = $D"
PutTemplate(dsp, format, certPartition, da<<DA.disk,
da<<DA.track, da<<DA.head, da<<DA.sector,
eTable>>ET.entry↑i.nErrors)
ChangePartition(origPartition)
PutTemplate(logFile, format, certPartition, da<<DA.disk,
da<<DA.track, da<<DA.head, da<<DA.sector,
eTable>>ET.entry↑i.nErrors)
ChangePartition(certPartition)
]
PutTemplate(dsp,
"*N$D pages marked bad on BFS$D in $D passes.",
eTable>>ET.nEntries, certPartition, currentPass)
MoveBlock(cursorBitMap, savedCursor, 16)
CloseDisk(certDisk)
ChangePartition(origPartition)
PutTemplate(logFile,
"*N$D pages marked bad on BFS$D in $D passes.*N",
eTable>>ET.nEntries, certPartition, currentPass)
CleanupDiskStream(logFile)
]
//----------------------------------------------------------------------------
and GetDiskShape(action) = valof
//----------------------------------------------------------------------------
[
if TryDisk(0, 0, 0, 0)<<DST.notReady then
[ Ws(". DP0 is not ready!"); resultis false ]
nDisks, nTracks, nSectors = 1, 203, 12
unless TryDisk(1, 0, 0, 0)<<DST.notReady do
nDisks = 2
unless TryDisk(0, 203, 0, 0)<<DST.seekFail do
nTracks = 406
unless TryDisk(0, 0, 0, 13)<<DST.finalStatus eq badSector do
nSectors = 14
resultis true
]
//----------------------------------------------------------------------------
and TryDisk(dsk, trk, hd, sect) = valof
//----------------------------------------------------------------------------
[
let kcb = vec lKCB; Zero(kcb, lKCB)
kcb>>KCB.command = seekOnly
kcb>>KCB.headerAddress = lv kcb>>KCB.header
kcb>>KCB.labelAddress = label
kcb>>KCB.dataAddress = data
kcb>>KCB.diskAddress.disk = dsk
kcb>>KCB.diskAddress.track = trk
kcb>>KCB.diskAddress.head = hd
kcb>>KCB.diskAddress.sector = sect
@diskAddress = -1
until @diskCommand eq 0 loop
for trys = 1 to 5 do
[
kcb>>KCB.status = 0
@diskCommand = kcb
while (kcb>>KCB.status & DSTdoneBits) eq 0 loop
if (kcb>>KCB.status & DSTgoodStatusMask) eq DSTgoodStatus break
]
resultis kcb>>KCB.status
]
//----------------------------------------------------------------------------
and SweepDisk(action) = valof
//----------------------------------------------------------------------------
[
let zoneLength = certDisk>>DSK.lengthCBZ + 2*nSectors*certDisk>>DSK.lengthCB
let cbz = Allocate(sysZone, zoneLength)
InitializeDiskCBZ(certDisk, cbz, 0, zoneLength, SweepRetry, lv SweepError)
cbz>>CBZ.cleanupRoutine = Noop
cbz>>CBZ.errorDA = 0
cbz>>CBZ.client = MyFrame()
SweepRetry: let sweepVDA = cbz>>CBZ.errorDA
while sweepVDA le maxVDA do
[
let cb = GetDiskCb(certDisk, cbz)
cb>>CB.labelAddress = data
DoDiskCommand(certDisk, cb, data, sweepVDA, data+5, data!4, action)
sweepVDA = sweepVDA +1
if (sweepVDA & 77b) eq 0 then
[ if not Endofs(keys) then
[ PutTemplate(dsp, "*NCurrent Pass = $D", currentPass)
if Gets(keys) eq abortChar then
[ abortFlag = true; break ]
]
if machineType eq 4 then Idle() ]
]
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(certDisk, cbz)
Free(sysZone, cbz)
resultis abortFlag
]
//----------------------------------------------------------------------------
and SweepError(nil, cb, nil) be
//----------------------------------------------------------------------------
[
let dst = cb>>CB.status
let da = cb>>CB.diskAddress
if dst<<DST.checksumError ne 0 & dst<<DST.dataLate eq 0 then
[
PutTemplate(dsp, "*NChecksum error at BFS$D Un $D, Cyl $3F0D, Hd $D, Sec $2F0D.",
certPartition, da<<DA.disk, da<<DA.track, da<<DA.head,
da<<DA.sector)
let i = 0; while i ls eTable>>ET.nEntries do
[ if da eq eTable>>ET.entry↑i.da break; i = i +1 ]
if i ls maxETEntries then
[
if eTable>>ET.entry↑i.nErrors eq 0 then
[
eTable>>ET.nEntries = eTable>>ET.nEntries +1
eTable>>ET.entry↑i.da = da
]
eTable>>ET.entry↑i.nErrors = eTable>>ET.entry↑i.nErrors +1
PutTemplate(dsp, " Errors here = $UD/$D", eTable>>ET.entry↑i.nErrors, currentPass)
]
if i eq maxETEntries then Ws(" Error table full!")
]
// treat it sort of like a soft error
let cbz = cb>>CB.cbz
cbz>>CBZ.errorDA = VirtualDiskDA(certDisk, lv da) +1
InitializeDiskCBZ(certDisk, cbz)
if certDisk>>DSK.retryCount eq 1 & dst<<DST.seekFail then
[ //retry count of one bypasses GetCB's recal for pos errors
@diskAddress = -1
DoDiskCommand(certDisk, GetDiskCb(certDisk, cbz), 0, 0, 0, 0, 525b)
]
GotoLabel(cbz>>CBZ.client, cbz>>CBZ.retry)
]
//----------------------------------------------------------------------------
and XferPage(action, vda, d, l, h, lvError; numargs na) = valof
//----------------------------------------------------------------------------
[
let header = vec 1
DefaultArgs(lv na, -2, data, label, header, lv XferError)
let cbz = vec CBzoneLength
InitializeDiskCBZ(certDisk, cbz, 0, CBzoneLength, XferRetry, lvError)
cbz>>CBZ.cleanupRoutine = XferCleanup
cbz>>CBZ.client = h
XferRetry: let cb = GetDiskCb(certDisk, cbz)
cb>>CB.labelAddress = l
let fp = vec lFP; BfsMakeFpFromLabel(fp, l)
DoDiskCommand(certDisk, cb, d, vda, fp, l>>DL.pageNumber, action)
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(certDisk, cbz)
resultis cbz>>CBZ.currentPage
]
//----------------------------------------------------------------------------
and XferCleanup(disk, cb, cbz) be
//----------------------------------------------------------------------------
[
MoveBlock(cbz>>CBZ.client, cb>>CB.headerAddress, 2)
cbz>>CBZ.currentPage = cb>>CB.status
]
//----------------------------------------------------------------------------
and XferError(nil, cb, nil) be
//----------------------------------------------------------------------------
[
let disk = cb>>CB.cbz>>CBZ.disk
let rda = cb>>CB.diskAddress
let vda = VirtualDiskDA(disk, lv rda)
PutTemplate(dsp, "*NHard error at BFS$D VDA $UO = Unit $D Cylinder $3F0D Head $D Sector $2F0D",
certPartition, vda, rda<<DA.disk, rda<<DA.track, rda<<DA.head,
rda<<DA.sector)
Ws("*NAttempted action was")
for i = 1 to 3 do
[
let action = selecton i into
[
case 1: cb>>CB.command.headerAction
case 2: cb>>CB.command.labelAction
case 3: cb>>CB.command.dataAction
]
action = selecton action into
[
case 0: "read"
case 1: "check"
case 2: case 3: "write"
]
let record = selecton i into
[
case 1: "header"
case 2: "label"
case 3: "data"
]
PutTemplate(dsp, " $S $S", action, record)
]
Ws("*NResulting status was")
let dst = cb>>CB.status
if dst<<DST.seekFail then Ws(" seek failed")
if dst<<DST.seeking then Ws(" seeking")
if dst<<DST.notReady then Ws(" disk not ready (on?)")
if dst<<DST.dataLate then Ws(" data late")
if dst<<DST.noTransfer then Ws(" no transfer")
if dst<<DST.checksumError then Ws(" checksum error")
if dst<<DST.finalStatus then Ws(selecton dst<<DST.finalStatus into
[
case 1: (dst&360b)? "", " sector late"
case 2: " check error"
case 3: " illegal sector"
])
]
//----------------------------------------------------------------------------
and MyIdle() be
//----------------------------------------------------------------------------
[
let MulDiv = table
[
055001B // sta 3 savedPC,2
155000B // mov 2 3
111000B // mov 0 2
102460B // mkzero 0 0
061020B // mul
031403B // lda 2 3 3
061021B // div
077400B // Swat
121000B // mov 1 0
171000B // mov 3 2
035001B // lda 3 savedPC,2
001401B // jmp 1,3
]
@mouseX = 200 + 200*diskAddress>>DA.disk
@mouseY = diskAddress>>DA.track ls 0? 0,
20 + MulDiv(808-40-16, diskAddress>>DA.track, 406)
]
//----------------------------------------------------------------------------
and Confirm(prompt) = valof
//----------------------------------------------------------------------------
[
Ws(prompt)
switchon Gets(keys) into
[
case $Y: case $y: case $*N:
[ Ws("Yes"); resultis true ]
case $N: case $n: case $*177:
[ Ws("No"); resultis false ]
default:
[ Ws("(Y or N) "); loop ]
] repeat
]
and AltoVersion() = valof
[
resultis (table [ 61014b; 1401b ])(origPartition)
]
and ChangePartition(partNumber) = valof
[
resultis (table [ 61037b; 1401b ])(partNumber)
]
and MyErr(p1, errCode) be
[
ChangePartition(origPartition)
PutTemplate(dsp, "*NSystem error $D", errCode)
abort
]
and MyCleanUp(code) be
[
ChangePartition(origPartition)
Closes(logFile)
@lvIdle = savedIdle
@lvUserFinishProc = savedUFP
]