// BFSTestCmd.bcpl -- CreateFile, Erase, and Certify commands
// Copyright Xerox Corporation 1982
// Last modified May 6, 1982 5:55 PM by Boggs
get "Altofilesys.d"
get "AltoDefs.d"
get "Streams.d"
get "Disks.d"
get "Bfs.d"
external
[
// outgoing procedures
Certify; Erase; CreateFile
XferError
// incoming procedures
OpenFile; GetCurrentFa; PositionPage; DeleteFile
BFSInit; CloseDisk; BfsMakeFpFromLabel; BFSNewDisk
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
AssignDiskPage; ReleaseDiskPage; VirtualDiskDA
Gets; Puts; Endofs; Closes; Resets
Zero; MoveBlock; SetBlock; Noop; Idle
Allocate; Free; DefaultArgs; MyFrame; GotoLabel
Ws; Confirm; Ding; GetNumber; GetString
PutTemplate; Random; MyIdle
// incoming statics
keys; dsp; sysZone
label; data; eng
// outgoing statics
sysDisk
]
static
[
maxVDA; sysDisk
nDisks; nTracks; nSectors; et
]
manifest
[
maxETEntries = 1000
errorThreshold = 3
]
structure ET: //Error Table
[
nEntries word
entry↑0,maxETEntries-1 [ da word; nErrors word ]
]
manifest lenET = size ET/16
//----------------------------------------------------------------------------
let CreateFile() be
//----------------------------------------------------------------------------
[
sysDisk = BFSInit(sysZone, true, 0)
if sysDisk eq 0 then
[
Ws("*NCan't init the disk. Is it on? Is it formatted (use ERASE)?")
return
]
let fileName = GetString(" named ")
if fileName eq 0 then [ CloseDisk(sysDisk); return ]
let nPages = GetNumber(", length in pages ")
Idle = MyIdle
DeleteFile(fileName)
if nPages ugr sysDisk>>DSK.diskKd>>KDH.freePages then
[
Ding(dsp)
Ws("*NThere isn't enough space on your disk")
nPages = 0
]
let stream = 0
maxVDA = sysDisk>>DSK.diskKd>>KDH.diskBTsize*16 -1
until nPages eq 0 do
[
// Scan the entire bit table and find the biggest hole
ReleaseDiskPage(sysDisk, AssignDiskPage(sysDisk, 0))
let vdaBiggestHole, sizeBiggestHole = 0, 0
let vdaThisHole, sizeThisHole = 0, 0
let vda = 0; while vda ule maxVDA do
[
test AssignDiskPage(sysDisk, vda, nil)
ifso test vdaThisHole eq 0 //vda+1 is free
ifso [ vdaThisHole, sizeThisHole = vda +1, 1 ] //new Hole
ifnot sizeThisHole = sizeThisHole +1
ifnot if vdaThisHole ne 0 then //vda+1 is allocated
[
if sizeThisHole ugr sizeBiggestHole then
[ vdaBiggestHole, sizeBiggestHole = vdaThisHole, sizeThisHole ]
vdaThisHole = 0
]
vda = vda +1
]
if vdaBiggestHole eq 0 then
[
if stream ne 0 then
[ Closes(stream); stream = 0; DeleteFile(fileName) ]
Ding(dsp)
Ws("*NThere isn't enough space on your disk")
break
]
PutTemplate(dsp, "*NFound a group of $UOb pages starting at vda $UOb",
sizeBiggestHole, vdaBiggestHole)
ReleaseDiskPage(sysDisk, AssignDiskPage(sysDisk, vdaBiggestHole-1))
if stream eq 0 then stream = OpenFile(fileName, ksTypeWriteOnly)
let fa = vec lFA; GetCurrentFa(stream, fa)
if nPages uls sizeBiggestHole then sizeBiggestHole = nPages
PositionPage(stream, fa>>FA.pageNumber+sizeBiggestHole)
nPages = nPages - sizeBiggestHole
]
if stream then Closes(stream)
Free(sysZone, fileName)
CloseDisk(sysDisk)
Idle = Noop
]
//----------------------------------------------------------------------------
and Certify() be
//----------------------------------------------------------------------------
[
let nPasses = GetNumber(". How many passes? ", 100)
unless GetDiskShape("CERTIFY") return
sysDisk = BFSInit(sysZone, false, 0, 0, true)
sysDisk>>BFSDSK.nDisks = nDisks
sysDisk>>BFSDSK.nTracks = nTracks
sysDisk>>BFSDSK.nSectors = nSectors
maxVDA = nDisks * nTracks * 2 * nSectors -1
et = Allocate(sysZone, lenET); Zero(et, lenET)
Idle = 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
[
for w = 0 to 255 do data!w = Random()
MoveBlock(cursorBitMap, wCursor, 16)
sysDisk>>DSK.retryCount = 8
if SweepDisk(i eq 1? DCwriteHLD, DCwriteLD) break
MoveBlock(cursorBitMap, rCursor, 16)
sysDisk>>DSK.retryCount = 1
if SweepDisk(DCreadLD) break
]
// mark bad spots incorrigable
sysDisk>>DSK.retryCount = 8
let nBadPages = 0
SetBlock(lv label>>DL.fileId, -2, lFID)
for i = 0 to et>>ET.nEntries-1 do
if et>>ET.entry↑i.nErrors uge errorThreshold then
[
let vda = VirtualDiskDA(sysDisk, lv et>>ET.entry↑i.da)
XferPage(DCwriteHLD, vda, 0, label, 0, lv Noop)
nBadPages = nBadPages +1
]
PutTemplate(dsp, "*N$D pages marked bad", nBadPages)
MoveBlock(cursorBitMap, savedCursor, 16)
Idle = Noop
Free(sysZone, et)
CloseDisk(sysDisk)
until Endofs(keys) do Gets(keys)
]
//----------------------------------------------------------------------------
and Erase() be
//----------------------------------------------------------------------------
[
Idle = MyIdle
if GetDiskShape("ERASE") then
unless BFSNewDisk(sysZone, 0, nDisks, nTracks, 0, nSectors) do
[ Ws("...failed"); Ding(dsp) ]
Idle = Noop
]
//----------------------------------------------------------------------------
and GetDiskShape(action) = valof
//----------------------------------------------------------------------------
[
if TryDisk(0, 0, 0, 0)<<DST.notReady then
[ Ws(". DP0 is not ready!"); Ding(dsp); resultis false ]
nDisks, nTracks, nSectors = 1, 203, 12
unless TryDisk(1, 0, 0, 0)<<DST.notReady do
nDisks = Confirm("*NUse both disks? ")? 2, 1
unless TryDisk(0, 203, 0, 0)<<DST.seekFail do
nTracks = Confirm("*NUse all 406 cylinders? ")? 406, 203
unless TryDisk(0, 0, 0, 13)<<DST.finalStatus eq badSector do
nSectors = Confirm("*NUse all 14 sectors? ")? 14, 12
PutTemplate(dsp, "*NDisks: $D, Cylinders: $D, Heads: 2, Sectors: $D",
nDisks, nTracks, nSectors)
let eng = (table [ 61014b; 1401b ])()<<VERS.eng
PutTemplate(dsp, "*NAbout to $S a $S model $S $Sfile system.", action,
(nDisks eq 1? "single", "dual"), (nTracks eq 203? "31", "44"),
(eng gr 3? (nSectors eq 12? "12 sector ", "14 sector "), ""))
Ws("*N*NWARNING: The old disk contents will be destroyed.")
let ok = Confirm("*NAre you sure this is what you want to do? ")
if ok then
[
let now = @realTimeClock
while now + 5*27 ugr @realTimeClock loop
Resets(keys)
ok = Confirm("*N*NAre you still sure? ")
]
resultis ok
]
//----------------------------------------------------------------------------
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 = sysDisk>>DSK.lengthCBZ + 2*nSectors*sysDisk>>DSK.lengthCB
let cbz = Allocate(sysZone, zoneLength)
InitializeDiskCBZ(sysDisk, 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(sysDisk, cbz)
cb>>CB.labelAddress = data
DoDiskCommand(sysDisk, cb, data, sweepVDA, data+5, data!4, action)
sweepVDA = sweepVDA +1
if (sweepVDA & 77b) eq 0 then
[ unless Endofs(keys) break; if eng eq 4 then Idle() ]
]
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(sysDisk, cbz)
Free(sysZone, cbz)
resultis not Endofs(keys)
]
//----------------------------------------------------------------------------
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 Un $D, Cyl $D, Hd $D, Sec $D.",
da<<DA.disk, da<<DA.track, da<<DA.head, da<<DA.sector)
let i = 0; while i ls et>>ET.nEntries do
[ if da eq et>>ET.entry↑i.da break; i = i +1 ]
if i ls maxETEntries then
[
if et>>ET.entry↑i.nErrors eq 0 then
[
et>>ET.nEntries = et>>ET.nEntries +1
et>>ET.entry↑i.da = da
]
et>>ET.entry↑i.nErrors = et>>ET.entry↑i.nErrors +1
PutTemplate(dsp, " Errors here = $UD.", et>>ET.entry↑i.nErrors)
]
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(sysDisk, lv da) +1
InitializeDiskCBZ(sysDisk, cbz)
if sysDisk>>DSK.retryCount eq 1 & dst<<DST.seekFail then
[ //retry count of one bypasses GetCB's recal for pos errors
@diskAddress = -1
DoDiskCommand(sysDisk, GetDiskCb(sysDisk, 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(sysDisk, cbz, 0, CBzoneLength, XferRetry, lvError)
cbz>>CBZ.cleanupRoutine = XferCleanup
cbz>>CBZ.client = h
XferRetry: let cb = GetDiskCb(sysDisk, cbz)
cb>>CB.labelAddress = l
let fp = vec lFP; BfsMakeFpFromLabel(fp, l)
DoDiskCommand(sysDisk, cb, d, vda, fp, l>>DL.pageNumber, action)
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(sysDisk, 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 VDA $UO = Unit $D Cylinder $D Head $D Sector $D",
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"
])
]