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