// CopyDiskTfs1.bcpl
// Copyright Xerox Corporation 1979, 1980
// Last modified November 10, 1980 12:49 PM by Boggs
get "AltoDefs.d"
get "CopyDisk.decl"
get "CopyDiskTfs.decl"
external
[
// outgoing procedures
TFSTryDisk; TFSWaitQuiet; TFSModShift
TFSInitializeCbStorage; TFSGetCb
TFSDoDiskCommand; TFSRecovery; TFSDiskModel
// incoming procedures
Zero; MoveBlock; Usc; StartIO
Noop; Idle; ReturnTo; SysErr
// incoming statics
CtxRunning
]
static TFSLock // nonzero to lock out new commands
//----------------------------------------------------------------------------
let TFSTryDisk(drive) = valof
//----------------------------------------------------------------------------
// Try to access disk and return:
// 0 if controller appears not to work
// 1 if disk appears to be there
// 2 if disk appears to be absent
[
while TFSLock ne 0 do Idle()
TFSLock = -1 //lock out all other access
TFSWaitQuiet(false)
let oldDrive = KBLK>>KBLK.drive
if Usc(oldDrive, 17b) ge 0 then oldDrive = 0
let result = TryDisk(drive)
// If selected a nonexistent drive, must leave controller pointing
// at the previously-selected drive, which is assumed to exist.
// (Note that drive 0 must exist or the controller won't work --
// this is a hardware restriction.)
if result eq 2 then TryDisk(oldDrive)
TFSLock = 0
resultis result
]
//----------------------------------------------------------------------------
and TryDisk(drive) = valof
//----------------------------------------------------------------------------
[
StartIO(20b) //turn off and reset controller
[ //repeat
KBLK>>KBLK.ptr = 0
KBLK>>KBLK.drive = drive % 100000b //Force drive select
KBLK>>KBLK.Status = -1
KBLK>>KBLK.cylinder = -1 //Force seek next time
let timedOut = nil
// See if unit responds. Let each StartIO work for 1/20 second.
// If Status has not been set after last StartIO, timedOut will
// be true. The reason for several StartIO's is that we may
// be trying to select a non-existent disk, which will not
// provide sector pulses and corresponding wakeups.
for reTries = 1 to 4 do //May have to give several StartIO's
[ // for a non-ex disk
StartIO(40b) // Causes microcode to start
timedOut = false
let inTime = @realTimeClock
[
if KBLK>>KBLK.Status ne -1 then break
if (@realTimeClock-inTime) gr 1 then timedOut=true
Idle()
] repeatuntil timedOut
unless timedOut break
]
if timedOut then resultis 0 //Controller not hooked up
] repeatuntil KBLK>>KBLK.WrLate eq 0
// Which status bit to test? A drive will select if power is on
// (even if the disk is not spinning): NotSelected is therefore only
// an indication of a non-ex or fully powered down drive. The OnLine
// indication is best, although if the drive is in the middle of
// a restore, it is conceivable that OnLine goes away.
resultis KBLK>>KBLK.NotOnLine eq 0? 1, 2
]
//----------------------------------------------------------------------------
and TFSDiskModel(ss) be
//----------------------------------------------------------------------------
// Determines what model disk is attached, puts default disk shape
// parameters in the disk object, and returns the disk model number:
// 80 Trident T-80
// 300 Trident T-300
// 4004 Shugart SA-4004
// 4008 Shugart SA-4008
[
// The following parallel tables define the disk parameters for the
// disk models currently known about. Determination of disk model
// is done by selecting heads and seeing what happens -- each model
// disk has a different maximum head number.
// nHeadsT!(i-1) but not nHeadsT!i is a legal head for disk model modelT!i,
// 0 <= i <= maxModel. nHeadsT must be monotonic!
manifest maxModel = 3
let modelT = table [ 4004; 80; 4008; 300 ]
let nTracksT = table [ 202; 815; 202; 815 ]
let nHeadsT = table [ 4; 5; 8; 19 ]
let nSectorsT = table [ 8; 9; 8; 9 ]
while TFSLock ne 0 do Idle()
TFSLock = -1
TFSWaitQuiet(false)
let modelIndex = 0
[
let kcb = vec lKCB; Zero(kcb, lKCB)
kcb>>KCB.drive = ss>>TFSSS.drive
// Issue no real commands -- just select a head
kcb>>KCB.head = nHeadsT!modelIndex
kcb>>KCB.ID = dcbID
KBLK>>KBLK.ptr = kcb
while KBLK>>KBLK.ptr ne 0 do Idle()
// Trident disks raise CylOvfl and Shugart disks raise SecOvfl
// when an illegal head is selected.
if KBLK>>KBLK.CylOvfl % KBLK>>KBLK.SecOvfl break
unless KBLK>>KBLK.WrLate do modelIndex = modelIndex + 1
] repeatuntil modelIndex eq maxModel
TFSLock = 0
TFSRecovery(diskReset) //turn off red light on T-80
let dp = lv ss>>SS.dp>>CD.diskParams.params
dp>>TFSDiskParams.nCylinders = nTracksT!modelIndex
dp>>TFSDiskParams.nHeads = nHeadsT!modelIndex
dp>>TFSDiskParams.nSectors = nSectorsT!modelIndex
ss>>TFSSS.model = modelT!modelIndex
]
//----------------------------------------------------------------------------
and TFSInitializeCbStorage(cbz, length, retry, error, cleanup; numargs na) be
//----------------------------------------------------------------------------
[
if na gr 1 then
[
Zero(cbz, length)
cbz>>CBZ.length = length
cbz>>CBZ.error = error
cbz>>CBZ.retry = retry
cbz>>CBZ.cleanup = cleanup
]
let cb = lv cbz>>CBZ.CBs
cbz>>CBZ.head = cb
[
cbz>>CBZ.tail = cb
cb>>CB.cbz = cbz
cb>>CB.StatusH = DSTfreeStatus
cb = cb + lCB
if Usc(cb+lCB, cbz+cbz>>CBZ.length) gr 0 then cb = 0
cbz>>CBZ.tail>>CB.nextCB = cb
] repeatuntil cb eq 0
]
//----------------------------------------------------------------------------
and TFSDoDiskCommand(cb, buffer, action) be
//----------------------------------------------------------------------------
[
let ss = CtxRunning>>CDCtx.ss
MoveBlock(lv cb>>CB.diskAddress, lv ss>>TFSSS.currentDA, lDH)
MoveBlock(lv buffer>>TFSBuffer.header, lv ss>>TFSSS.currentDA, lDH)
cb>>CB.drive = ss>>TFSSS.drive
let actNumber = action-diskMagic
cb>>CB.CommH = (table
[
diskRead; diskCheck; diskCheck; diskWrite; diskCheck;
diskCheck; diskNoop; diskNoop; diskCheck; diskCheck; diskCheck
])!actNumber
cb>>CB.AddrH = lv buffer>>TFSBuffer.header
cb>>CB.CountH = lDH
cb>>CB.CommL = (table
[
diskRead; diskRead; diskCheck; diskWrite; diskWrite;
diskCheck; diskNoop; diskNoop; diskRead; diskCheck; diskWrite
])!actNumber
cb>>CB.AddrL = lv buffer>>TFSBuffer.label
cb>>CB.CountL = lDL
cb>>CB.CommD = (table
[
diskRead; diskRead; diskRead; diskWrite; diskWrite;
diskWrite; 0; 0; 0; 0; 0
])!actNumber
cb>>CB.AddrD = lv buffer>>TFSBuffer.data
cb>>CB.CountD = TFSwordsPerPage
// Wait for interlocked activity (TFSRecovery, TFSTryDisk, etc.) to complete
while TFSLock ne 0 do Idle()
cb>>CB.ID = dcbID
let p = KBLK>>KBLK.ptr // chase down chain
if p ne 0 then
[
until p>>KCB.nextKCB eq 0 do p = p>>KCB.nextKCB
p>>KCB.nextKCB = lv cb>>CB.diskAddress
]
if KBLK>>KBLK.ptr eq 0 then KBLK>>KBLK.ptr = lv cb>>CB.diskAddress
// Put this CB back on the available queue
let cbz = ss>>TFSSS.cbz
cb>>CB.nextCB = 0
test cbz>>CBZ.head eq 0
ifso cbz>>CBZ.head = cb
ifnot cbz>>CBZ.tail>>CB.nextCB = cb
cbz>>CBZ.tail = cb
]
//----------------------------------------------------------------------------
and TFSGetCb(cbz) = valof
//----------------------------------------------------------------------------
[
let ss = CtxRunning>>CDCtx.ss
// Dequeue next CB from CBZ
let cb = cbz>>CBZ.head; if cb eq 0 then SysErr(cbz, ecTfsQueue)
cbz>>CBZ.head = cb>>CB.nextCB
// If header status is DSTfreeStatus, cb is useable
if cb>>CB.StatusH eq DSTfreeStatus then [ Zero(cb, lVarCB); resultis cb ]
[ //repeat (gives us something to break out of)
// Following code depends on the fact that label is always transferred,
// although the data field may not be (DCreadLnD)
let dsAddr = cb>>CB.CommD eq 0? lv cb>>CB.StatusL, lv cb>>CB.StatusD
// Here is the main place to wait for command completion:
let diskStatus = nil
let inTime = @realTimeClock + 5*(1000/39) // Prepare a timer (5 seconds)
until @realTimeClock-inTime gr 0 do
[
diskStatus = @dsAddr
if diskStatus ne 0 break
Idle()
]
// If status is not set, it must mean that the command aborted,
// or the read task committed suicide, or sector pulses are not there.
if diskStatus eq 0 then @dsAddr = 3 // Fake bad status
// Merge together status for all blocks
diskStatus = cb>>CB.StatusD % cb>>CB.StatusL % cb>>CB.StatusH
// Most successful transfers exit here:
if (diskStatus & DSTerrorBits) eq DSTgoodStatus break
// Must reset the disk after each error -- but don't tamper with zone.
// Note that other disk activity can be taking place (e.g., we might
// just have an ECC error and can fix it without flushing remainder
// of command block chain).
unless diskStatus<<DST.DataLate do // retry data-late errors indefinitely
cbz>>CBZ.errorCount = cbz>>CBZ.errorCount+1
let errorCount = cbz>>CBZ.errorCount
TFSRecovery(diskReset)
// Disk is now quiet
// Do error correction stuff if not very first retry -- because EOF is
// detected by slamming into page 0 and getting a check error
if errorCount gr 1 then
[
let block = lv cb>>CB.CommH
diskStatus = DSTgoodStatus
[ // repeat
// Attempt ECC only if there were no other errors in this block.
// This includes check errors, since the first two words of a checked
// block are not stored in memory.
let status = block>>KCBblock.Status
if status<<DST.ECCerror ne 0 & status<<DST.Errors eq 0 then
if DataFix(block) eq -1 then status = 0
diskStatus = diskStatus % status
block = block+(size KCBblock/16)
] repeatwhile block le (lv cb>>CB.CommD)
if (diskStatus & DSTerrorBits) eq DSTgoodStatus break // ECC fix OK
]
if errorCount ge ss>>TFSSS.retryCount then
[ // Non-recoverable error
(cbz>>CBZ.error)(cb, ecUnRecovDiskError)
break //Let remainder of transfers proceed
]
// If more than 8 errors, do restore before trying again.
if errorCount gr (ss>>TFSSS.retryCount rshift 1) then
[
// Check for read-only error. We do this after 8 retries (rather than
// immediately) because the hardware doesn't provide an unequivocal
// "tried to write when read-only" indication. Also, we must do
// a restore after the error routine returns in order to force the
// drive to notice the new state of the switch.
if diskStatus<<DST.ReadOnly & diskStatus<<DST.DeviceCk then
(cbz>>CBZ.error)(cb, ecReadOnly)
TFSRecovery(diskRestore)
]
// Initialize things again
TFSInitializeCbStorage(cbz)
ReturnTo(cbz>>CBZ.retry)
] repeat
// Good cb from previous transfer, ready to return
cbz>>CBZ.errorCount = 0
cbz>>CBZ.cleanup(cb)
Zero(cb, lVarCB)
resultis cb
]
//----------------------------------------------------------------------------
and TFSRecovery(command) be
//----------------------------------------------------------------------------
// Recovery code for many purposes. Called from TFSGetCb and TFSInit
// The coaxing operation is performed if a command times out. It may
// be that we have inadvertently selected a non-existent drive.
// Also, we must handle the case in which the
// presently-selected drive has been taken off line, and no more
// sector pulses are arriving (Roger did not put the one-shot
// sector-pulse impersonator in his interface that McCreight did
// in his!). So be prepared to give some "fake" sector pulses via StartIO.
// Also, there is a bug in the controller such that if you issue a Read
// and the drive doesn't send you any data (e.g., because it's in select
// lock or the pack has been DC-erased), the controller gets hung up
// waiting for the sync bit. The only safe way to get out of this state is
// to reset the controller, turn it back on, and issue a diskReset.
[
let ss = CtxRunning>>CDCtx.ss
let coax = false
let kcb = vec lKCB
while TFSLock ne 0 do Idle()
TFSLock = ss
TFSWaitQuiet(false)
let retryCount = 0
[ // repeat until we succeed in making all errors go away
if coax then [ StartIO(#20); KBLK>>KBLK.drive = 0 ] // reset controller
retryCount = retryCount+1
if (retryCount & 37B) eq 0 then
(ss>>TFSSS.cbz>>CBZ.error)(ss>>TFSSS.drive, ecDriveHung)
Zero(kcb, lKCB)
kcb>>KCB.ID = dcbID
kcb>>KCB.cylinder = -1
kcb>>KCB.drive = ss>>TFSSS.drive
kcb>>KCB.CommH = command
KBLK>>KBLK.cylinder = -1 // Force microcode to forget cylinder address
KBLK>>KBLK.aborted = 0
KBLK>>KBLK.ptr = kcb
if coax then StartIO(#40) // start controller
TFSWaitQuiet(command eq diskRestore)
// If we timed out, perhaps sector pulses have gone away.
// Issue the command more forcefully next time around.
test kcb>>KCB.StatusH eq 0
ifso coax = true
ifnot
[
// NotReady in KCB happens normally if command eq diskRestore.
manifest NotReady = 100000B rshift offset DST.NotReady
let status = KBLK>>KBLK.Status % (kcb>>KCB.StatusH & not NotReady)
if status<<DST.Errors eq 0 then break // successful recovery
// Certain errors sometimes require a restore to reset.
// If we didn't succeed in resetting one, try a restore next time.
if (status & DSTrestoreBits) ne 0 then command = diskRestore
]
] repeat
TFSLock = 0
]
//----------------------------------------------------------------------------
and TFSWaitQuiet(awaitIndex) be
//----------------------------------------------------------------------------
// Wait until disk is thoroughly idle. Evidence for idle is:
// 1 - KBLK.ptr=0, i.e. no commands remain
// 2 - KBLK.Sector is counting, i.e. not in a write command,
// and read task has had time to finish.
// Also we should note that after a Restore is executed,
// it takes a while for sector pulses to start arriving again,
// and we must await an index mark because the sector count may have
// gotten out of sync.
[
let stage = 0
let lastPtr = -1
let timer = nil
let sector = nil
[ // repeat
switchon stage into
[
case 0:
// Wait for cb queue to empty, but time out if a single command
// stays stuck on the queue for more than 500 ms.
if KBLK>>KBLK.ptr ne lastPtr then
[ lastPtr = KBLK>>KBLK.ptr; timer = @realTimeClock + 500/39 ]
if KBLK>>KBLK.ptr eq 0 then stage = 1
endcase
case 1:
// Wait for restore to complete
unless awaitIndex & KBLK>>KBLK.NotReady do
[ sector = KBLK>>KBLK.Sector; timer = @realTimeClock+1; stage = 2 ]
endcase
case 2:
// Wait for sector number to advance, but time out after
// 39 ms (two rotations).
if KBLK>>KBLK.Sector ne sector then
[ unless awaitIndex break; stage = 3 ]
endcase
case 3:
// If did restore, wait for index mark (sector 0)
if KBLK>>KBLK.Sector eq 0 break
endcase
]
Idle()
] repeatuntil @realTimeClock-timer gr 0
KBLK>>KBLK.ptr = 0 // in case microcode didn't do anything
]
//----------------------------------------------------------------------------
and DataFix(block) = valof
//----------------------------------------------------------------------------
// ECC fixer. Argument is a "block" of the disk command.
// Returns: -1 if everything fixed correctly.
// ...otherwise... a number indicating where the ECC gave up.
[
manifest LCM = 21*2047
let sink = vec 1
let rem0 = block>>KCBblock.ECC0 & #37
let rem1 = block>>KCBblock.ECC1
let S0,S1 = 0,nil
let Dx,D,Dbits,p,data,mask = nil,nil,nil,nil,nil,nil
[ // repeat
if (rem1 & #1777) eq 0 then break
let msb = rem0 rshift 4
rem0 = ((rem0 lshift 1) & #37) + (rem1 rshift 15)
rem1 = (rem1 lshift 1) + msb
S0 = S0 + 1
if S0 ge 21 then resultis 1
] repeat
rem0 = rem0 lshift 6 + rem1 rshift 10
rem1 = block>>KCBblock.ECC0 rshift 5
if rem1 eq 0 % rem0 eq 0 then resultis 2
S1 = TFSModShift(rem1, rem0) + 11
if S1 gr 2047+11 then resultis 3
Dx = ((-19*S0 - 2*S1)+220*21) rem 21
//D = 2047*Dx - S1 + 2047 //I dont know why I must add 2047!!!
D = 2048*Dx - Dx - S1 + 2047 // D = 2047*Dx + 2047 - S1
//if Usc(D, LCM) ge 0 then D = D - LCM // Fiala claims this can't happen
Dbits = D & #17
p = block>>KCBblock.Count - (D rshift 4)
data = block>>KCBblock.Addr
mask = rem0 rshift (16-Dbits)
for ptr = p to p+1 do
[
if mask ne 0 then
[
if ptr ls 0 resultis 4 //error outside of block
if ptr ls block>>KCBblock.Count then //error might be in ECC words
data!ptr = data!ptr xor mask
]
mask = rem0 lshift Dbits
]
resultis -1
]
// Microcode version shares S registers with the Read task.
// Therefore, call this only when disk is quiet.
//and TFSModShift(num, ref) = valof
// [
// let S1 = 0
// [
// if (#4000-S1 ls 0) % (num - ref eq 0) then break
// num = num lshift 1
// if (num & #4000) ne 0 then num = num xor #4005
// S1 = S1 + 1
// ] repeat
// resultis S1
// ]
//