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