// TfsBase.Bcpl
// Copyright Xerox Corporation 1979, 1980, 1981

//	Last modified July 9, 1981  1:23 PM by Taft

get "Altofilesys.d"
get "Disks.d"
get "Tfs.d"

compileif newname debug then [ manifest [ debug = false ]]
compileif newname saveregs then [ manifest [ saveregs = false ]]

external
[ 
// procedures defined here
TFSInitializeCbStorage
TFSDoDiskCommand
TFSGetCb
TFSActOnPages
DefaultTFSErrorRtn
DoRecovery
TFSWaitQuiet
TFSNonEx
DataFix

// procedures defined elsewhere
TFSIncrement
TFSModShift
VirtualDiskDA
RealDiskDA
Zero
MoveBlock
CallSwat
SysErr
DisableInterrupts
EnableInterrupts
ReturnTo
DefaultArgs
StartIO
Idle
Noop
SaveRegs	// iff saveregs compile-time switch = true

// statics defined here
TFSLeaveDisplay
TFSSavedDisplay
TFSLock
TFSDebug
]

static  // statics defined here
[
TFSLeaveDisplay = false	// nonzero to leave display on during transfers
TFSSavedDisplay = -1	// saved display list head (-1 => none)
TFSLock = 0		// nonzero to lock out new commands
TFSDebug = debug
]

manifest RTC = #430

compileif debug then
[
static
   [
   TFSErrorRate	// simulated error rate, measured in 64ths
   TFSRestoreRate	// simulated restore rate, measured in 64ths
   ]

//----------------------------------------------------------------------------
let RecordTFS(a,b,c) be 
//----------------------------------------------------------------------------
// Kludge for recording errors.  Expects to find #645 zero (for
// no error recording) or a pointer to a DebugData structure (see below).
// Records a,b in ring buffer (unless a=0, in which case b=disk, c=CB,
// and what is recorded is 0, VDA of CB).
// Then, if a=1, finds or creates status entry whose word 0 is equal to b
// and increments words 1 and 2 (double-precision counter).
// Unused entries are indicated by word 0 = -1.
// Current interpretations:
//	a	b
//	0	vda	Command completed (TFSGetCb)
//	1	status	Error occurred (DoRecovery)
//	2	command	Command issued (DoRecovery)
//	#1xx	vda	Command issued, xx = actNumber (TFSDoDiskCommand)
[
structure DebugData:
   [
   pNextRing word	// -> next entry to use in ring buffer
   pEndRing word	// -> first word beyond end of ring buffer
   pBeginRing word	// -> first word of ring buffer
   pBeginStatus word	// -> beginning of block for 3-word status entries
   pEndStatus word	// -> first word beyond end of status entries
   ]

if @#645 ne 0 then
   [
   let p = @#645
   if a eq 0 then b = VirtualDiskDA(b, lv c>>CB.diskAddress)
   let s = p>>DebugData.pNextRing
   s!0 = a; s!1 = b
   s = s+2
   if s eq p>>DebugData.pEndRing then s = p>>DebugData.pBeginRing
   p>>DebugData.pNextRing = s

   if a eq 1 then
      [
      s = p>>DebugData.pBeginStatus
      until s eq p>>DebugData.pEndStatus do
         [
         if s!0 eq -1 then [ Zero(s+1, 2); s!0 = b ]
         if b eq s!0 then [ TFSIncrement(s+1); break ]
         s = s+3
         ]
      ]
   ]
]
] // compileif debug

// TFSRealDA, TFSVirtualDA, and TFSIncrement are defined in TfsA.asm


//----------------------------------------------------------------------------
let TFSInitializeCbStorage(disk, cbz, firstPage, length, retry, errorRtn;
    numargs na) be 
//----------------------------------------------------------------------------
// Init the cbz such that subsequently it can be used for
// TFS disk transfers.
[
if na ge 4 then
   [
   Zero(cbz, length)
   cbz>>CBZ.length = length
   cbz>>CBZ.errorRtn = na ge 6 & errorRtn? errorRtn, lv DefaultTFSErrorRtn
   cbz>>CBZ.retry = retry
   cbz>>CBZ.cleanupRoutine = Noop
   ]
cbz>>CBZ.disk = disk
cbz>>CBZ.currentPage = firstPage
cbz>>CBZ.queueHead = lv cbz>>CBZ.head  // for backward compatibility
let cb = lv cbz>>TFSCBZ.CBs
cbz>>CBZ.head = cb
   [
   cbz>>CBZ.tail = cb
   cb>>CB.cbz = cbz
   cb>>CB.StatusH = dstFree
   cb = cb+lCB
   if cb+lCB gr cbz+cbz>>CBZ.length then cb = 0
   cbz>>CBZ.tail>>CB.nextCB = cb
   ] repeatuntil cb eq 0
]

//----------------------------------------------------------------------------
and TFSDoDiskCommand(disk, cb, CA, DA, fp, pageNumber, action,
    nextCb; numargs na) be 
//----------------------------------------------------------------------------
// Expects command and label to both be zeroed on entry, or
// otherwise appropriately initialized
[
let cbz = cb>>CB.cbz

// Resurrect //* lines if interrupts ever implemented and used
//*   if cb>>CB.normalWakeups eq 0 then
//*      cb>>CB.normalWakeups = cbz>>CBZ.normalWakeups
//*   if cb>>CB.errorWakeups eq 0 then
//*      cb>>CB.normalWakeups = cbz>>CBZ.errorWakeups

// Setup header block part of sector transfer
cb>>CB.AddrH = lv (cb>>CB.diskAddress)  // in front of this KCB
cb>>CB.CountH = lDH

// Setup label block part of sector transfer
if cb>>CB.AddrL eq 0 then  // caller may want label to go elsewhere
   cb>>CB.AddrL = na ge 8 & nextCb? lv nextCb>>CB.label+lDH, lv cb>>CB.label
cb>>CB.CountL = lDL

// Setup data block part of sector transfer
cb>>CB.AddrD = CA
cb>>CB.CountD = TFSwordsPerPage

// Setup for Label compare
MoveBlock(lv (cb>>CB.AddrL>>DL.fileId), fp, lFID)  // FID part
cb>>CB.AddrL>>DL.packID = disk>>TFSDSK.packID
cb>>CB.AddrL>>DL.pageNumber = pageNumber
cb>>CB.truePageNumber = pageNumber

// Possibly put in the disk address for this command. DA eq fillinDA means
// it is already set up, or will be filled in from the previous label transfer
if DA ne fillInDA then RealDiskDA(disk, DA, lv cb>>CB.diskAddress) 
cb>>CB.vDiskAddress = DA

// Fill in the actual disk action for each block of the sector
let actNumber = action-diskMagic
if actNumber ugr 10 then SysErr(action, ecBadAction)
cb>>CB.CommH = (table
   [
   diskRead ; diskCheck ; diskCheck ; diskWrite ; diskCheck ;
   diskCheck ; diskNoop; diskNoop; diskCheck; diskCheck; diskCheck
   ])!actNumber
cb>>CB.CommL = (table
   [
   diskRead ; diskRead ; diskCheck ; diskWrite ; diskWrite ;
   diskCheck ; diskNoop; diskNoop; diskRead; diskCheck; diskWrite
   ])!actNumber
cb>>CB.CommD = (table
   [
   diskRead ; diskRead ; diskRead ; diskWrite ; diskWrite ;
   diskWrite ; 0; 0; 0; 0; 0
   ])!actNumber

// TFSDoDiskCommand (cont'd)

// Fill in the drive number
cb>>CB.drive = disk>>TFSDSK.driveNumber

// Wait for interlocked activity (DoRecovery, TFSTryDisk, etc.) to complete
while TFSLock ne 0 do Idle()

// Turn off the display, if not already off
if TFSSavedDisplay eq -1 then
   [
   TFSSavedDisplay = @DAstart
   unless TFSLeaveDisplay do @DAstart = 0
   ]

// Fill in the command seal
cb>>CB.ID = dcbID

// Enqueue the command
compileif debug then [ RecordTFS(#100+actNumber, DA) ]
//* DisableInterrupts()
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
//* EnableInterrupts()

// Put this CB back on the available queue
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(disk, cbz, dontClear, returnIfNoCb; numargs na) = valof 
//----------------------------------------------------------------------------
[
// Dequeue next CB from CBZ
let cb = cbz>>CBZ.head
if cb eq 0 then
   [
   if na ge 4 & returnIfNoCb resultis 0
   SysErr(cbz, ecTfsQueue)  //there should be one
   ]
cbz>>CBZ.head = cb>>CB.nextCB

// If header status is dstFree, cb is usable
if cb>>CB.StatusH eq dstFree then [ Zero(cb, lVarCB); resultis cb ]

// Many ways to return a good 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 lvStatus = cb>>CB.CommD eq 0? lv cb>>CB.StatusL, lv cb>>CB.StatusD

   // Here is the main place to wait for command completion:
   if @lvStatus eq 0 then
      [
      if na ge 4 & returnIfNoCb then  // Put cb back on queue and return 0
         [ cbz>>CBZ.head = cb; resultis 0 ]

      let inTime = @RTC + 5*(1000/39)  // Prepare a timer (5 seconds)
         [ // Wait for command to complete or time out
         Idle()
         if @lvStatus ne 0 then break  // command completed
         if KBLK>>KBLK.ptr eq 0 & cb>>CB.ID eq dcbID then
            // controller went idle without even starting this command
            [ @lvStatus = dstForgotten % dstDone; break ]
         if @RTC-inTime gr 0 then
            // command timed out and controller seems to be hung up
            [ @lvStatus = dstTimeout % dstDone; break ]
         ] repeat
      ]

   compileif debug then
      [
      // 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 (@lvStatus & (dstForgotten % dstTimeout)) ne 0 then
         [
         let saveItNow = vec lVarCB
         MoveBlock(saveItNow, cb, lVarCB)
         compileif saveregs then [ SaveRegs() ]
         if KBLK>>KBLK.aborted eq 0 then CallSwat("dead")
         ]
      let ErrorRan = nil
      if KBLK>>KBLK.aborted then @#22 = @#22+1
      if TFSErrorRate then
         [
         let lb = (table [ #61003; #121000; #1401 ] )()	//RCLK
         ErrorRan = (lb rshift 6)&#77		// make 6-bit quantity
         if ErrorRan ls TFSErrorRate then cb>>CB.StatusH = dstTimeout
         ]
      RecordTFS(0, disk, cb)		//Record completion of command
      ]

   // Merge together status for all blocks
   let errorStatus =  (cb>>CB.StatusD % cb>>CB.StatusL % cb>>CB.StatusH) &
    dstErrors  // mask out non-errors

   // Most successful transfers exit here:
   if errorStatus eq 0 then break

// TFSGetCb (cont'd)

   // 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).
   compileif debug then [ RecordTFS(1, errorStatus) ]
   DoRecovery(disk, diskReset, cbz>>CBZ.errorRtn)

   // Retry data-late and "forgotten" errors indefinitely, without any
   // other recovery actions, and without counting them as errors.
   if (errorStatus & dstRetryIndefinitely) eq 0 then
      [
      cbz>>CBZ.errorCount = cbz>>CBZ.errorCount+1
      let errorCount = cbz>>CBZ.errorCount

      // Disk is now quiet.  Now do error reporting and recovery.
      // Report a check error not accompanied by other errors only after
      // it has been retried at least once -- because EOF is sometimes
      // detected by slamming into page 0 and getting a check error.
      unless errorCount eq 1 & errorStatus eq dstCompErr do
         [
         compileif debug then
            [
            if TFSErrorRate ne 0 & ErrorRan ls TFSRestoreRate then
               errorCount = (disk>>DSK.retryCount rshift 1)+1
            ]

         TFSIncrement(lv disk>>TFSDSK.nErrors)
         let block = lv cb>>CB.CommH
         errorStatus = 0

            [ // repeat for each block
            // 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 and therefore it is
            // hopeless to correct an ECC error in a checked block.
            // Also, do not invoke ECC until we have retried at least
            // 4 times, to reduce the risk of false ECC correction
            // on transient data errors.
            let status = block>>KCBblock.Status & dstErrors
            if status eq dstECCerror then
               [
               TFSIncrement(lv disk>>TFSDSK.nECCErrors)
               if errorCount ge 4 & DataFix(block) eq -1 then
                  [ status = 0; TFSIncrement(lv disk>>TFSDSK.nECCFixes) ]
               ]
            errorStatus = errorStatus % status
            block = block+(size KCBblock/16)
            ] repeatwhile block ule (lv cb>>CB.CommD)

         if errorStatus eq 0 then break  //successful ECC fix
         ]

      // Turn display back on now, since error routine might never return
      if TFSSavedDisplay ne -1 then
         [ @DAstart = TFSSavedDisplay; TFSSavedDisplay = -1 ]

// TFSGetCb (cont'd)

      cbz>>CBZ.errorDA = cb>>CB.vDiskAddress
      if errorCount ge disk>>DSK.retryCount then 
         [  // Non-recoverable error
         TFSIncrement(lv disk>>TFSDSK.nUnRecov)
         (@cbz>>CBZ.errorRtn)(cbz>>CBZ.errorRtn, cb, ecUnRecovDiskError)
         break      //Let remainder of transfers proceed
         ]

      // If more than 8 errors, do restore before trying again.
      if errorCount gr (disk>>DSK.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.
         // Note that the ReadOnly bit has been masked out in errorStatus,
         // but the status stored on top of the ID contains the true state
         // of the ReadOnly switch.
         if (cb>>CB.ID)<<DST.ReadOnly & errorStatus<<DST.DeviceCk then
            (@cbz>>CBZ.errorRtn)(cbz>>CBZ.errorRtn, cb, ecReadOnly)
         TFSIncrement(lv disk>>TFSDSK.nRestores)
         DoRecovery(disk, diskRestore, cbz>>CBZ.errorRtn)
         ]
      ]

   // Initialize things again
   TFSInitializeCbStorage(disk, cbz, cb>>CB.truePageNumber)
   ReturnTo(cbz>>CBZ.retry)
   ] repeat

// Turn display back on if disk now idle
if KBLK>>KBLK.ptr eq 0 & TFSSavedDisplay ne -1 then
   [ @DAstart = TFSSavedDisplay; TFSSavedDisplay = -1 ]

// Good cb from previous transfer, ready to return
TFSIncrement(lv disk>>TFSDSK.nTransfers)
cbz>>CBZ.nextDA = VirtualDiskDA(disk, lv cb>>CB.AddrL>>DL.next)
cbz>>CBZ.currentNumChars = cb>>CB.AddrL>>DL.numChars
cbz>>CBZ.errorCount = 0
cbz>>CBZ.cleanupRoutine(disk, cb, cbz)
unless ((na ge 3) & dontClear) do Zero(cb, lVarCB)
resultis cb
]

//----------------------------------------------------------------------------
and DoRecovery(disk, command, errorRtn; numargs na) 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.
[
if na ls 3 then errorRtn = lv DefaultTFSErrorRtn
let coax=false
let kcb = vec lKCB
while TFSLock ne 0 do Idle()
TFSLock = disk
TFSWaitQuiet(false)
let retryCount = 0

   [  // repeat until we succeed in making all errors go away
   if coax then StartIO(#20)  // reset controller
   retryCount = retryCount+1
   if (retryCount & 17B) eq 0 then
      [
      compileif saveregs then [ SaveRegs() ]
      (@errorRtn)(errorRtn, disk>>DSK.driveNumber, ecDriveHung)
      ]
   Zero(kcb, lKCB)
   kcb>>KCB.ID = dcbID
   kcb>>KCB.track = -1
   kcb>>KCB.drive = disk>>DSK.driveNumber
   kcb>>KCB.CommH = command
   KBLK>>KBLK.track = -1  // Force microcode to forget cylinder address
   KBLK>>KBLK.drive = disk>>DSK.driveNumber % 100000B  // Force drive select
   KBLK>>KBLK.aborted = 0
   compileif debug then [ RecordTFS(2, command) ]
   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 % kcb>>KCB.ID eq dcbID
      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)

         // Consider recovery successful if command executed without
         // error in non-coax mode.
         if status<<DST.Errors eq 0 & not coax then break
         coax = false

         // Certain errors sometimes require a restore to reset.
         // If we didn't succeed in resetting one, try a restore next time.
         if (status & dstRestore) 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 = @RTC + 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 = @RTC+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 @RTC-timer gr 0

KBLK>>KBLK.ptr = 0  // in case microcode didn't do anything
]

//----------------------------------------------------------------------------
and DefaultTFSErrorRtn(lvErrorRtn, cb, ec) be SysErr(0, ec, cb)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and TFSNonEx(disk) be SysErr(disk, ecNoCreationAbility)
//----------------------------------------------------------------------------
// What happens if you try to create or delete files when initmode was 0

//----------------------------------------------------------------------------
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 D uge LCM 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
//   ]
//

//----------------------------------------------------------------------------
and TFSActOnPages(disk, CAs, DAs, fp, firstPage, lastPage, action,
    lvNumChars, lastAction, fixedCA, cleanupRoutine, errorRtn,
    returnOnCheckError, hintLastPage; numargs na) = valof 
//----------------------------------------------------------------------------
// See ActOnDiskPages description in BFS section of O.S. manual.
// Returns the page number of the last page successfully acted  on.
// CAs (core addresses) and DAs (disk addresses) are vectors
// indexed by page number (e.g. CAs!firstPage)
// the arguments following action are optional; if one of them is
// omitted or 0, the default action is taken
[
DefaultArgs(lv na, -7, lv na, action, 0, TFSDefaultCleanupRtn,
 0, false, lastPage)

// Initialize for transfers
let result = nil
let cbz = vec CBzoneLength
TFSInitializeCbStorage(disk, cbz, firstPage, CBzoneLength, Aretry, errorRtn)
cbz>>CBZ.DAs = DAs
cbz>>CBZ.cleanupRoutine = cleanupRoutine
if hintLastPage-firstPage ugr lastPage-firstPage then
   hintLastPage = lastPage  // hintLastPage not in [firstPage..lastPage]

// Each cb is used twice:
// 	to hold the DL for page i-1, and
//	to hold the KCB for page i.
// It isn't reused until the command for page i is done, and that is
// guaranteed to be after the DL for page i-1 is no longer needed,
// since everything is done strictly sequentially by page number.

// Note: if the hintLastPage looks reasonable and is less than lastPage,
// we transfer pages up to that point, then check to see whether the last
// page transferred really was the last page of the file.  If so, we return
// without having caused the disk to seek to cylinder 0 as a result of
// chaining forward from the last page.  If the hint was wrong, we have to
// queue up the remainder of the transfers; this costs an extra disk rotation.

// TFSActOnPages (cont'd)

Aretry:
   [ // repeat
   // Get a first cb
   result = hintLastPage
   let cb = TFSGetCb(disk, cbz)
   let curFirstPage = cbz>>CBZ.currentPage
   for pageNumber = curFirstPage to hintLastPage do
      [
      if DAs!pageNumber eq eofDA then  // Last page has been fixed up
         [ result = pageNumber-1; break ]

      // Be very careful, if lastAction is different, to let first set of
      // transfers, if any, finish and be retried if necessary.  For example,
      // if they are all writes, and lastAction is a read (into the same
      // buffer), we must not queue the read until the write has completed
      // and been checked.  This is because the Trident (unlike the Diablo)
      // does not stop executing commands when an error occurs, but rather
      // continues racing down the command chain.
      let thisCBaction = action
      if pageNumber eq lastPage & thisCBaction ne lastAction then
         [
         if curFirstPage ne lastPage then
            [ result = pageNumber-1; break ]
         thisCBaction = lastAction
         ]
      if thisCBaction eq DCdoNothing then loop

      // Nonrecoverable error(s) check
      if returnOnCheckError &
       (cbz>>CBZ.errorCount eq disk>>DSK.retryCount rshift 1) then
         resultis -(pageNumber+77B)

      // If we are chaining, cause this command to fill in
      // the disk address part of the next command
      let nextCb = TFSGetCb(disk, cbz)
      cb>>CB.AddrL = DAs!(pageNumber+1) eq fillInDA?
       lv nextCb>>CB.label+lDH, lv nextCb>>CB.label
      TFSDoDiskCommand(disk, cb, (fixedCA ne 0? fixedCA, CAs!pageNumber),
       DAs!pageNumber, fp, pageNumber, thisCBaction)
      cb = nextCb
      ]
   while cbz>>CBZ.head ne 0 do TFSGetCb(disk, cbz)
   if result eq lastPage % DAs!(result+1) eq eofDA then break
   hintLastPage = lastPage  // hint was wrong, restart transfer
   TFSInitializeCbStorage(disk, cbz, result+1)
   ] repeat

// Cleanup
@lvNumChars = cbz>>CBZ.currentNumChars
resultis result
]


//----------------------------------------------------------------------------
and TFSDefaultCleanupRtn(disk, cb, cbz) be
//----------------------------------------------------------------------------
// The default cleanupRoutine substitutes the actual virtual DA for
// each instance of fillInDA in the DAs vector
[
let lvDA = lv ((cbz>>CBZ.DAs)!(cb>>CB.truePageNumber))
if lvDA!1 eq fillInDA then lvDA!1 = cbz>>CBZ.nextDA
if lvDA!(-1) eq fillInDA then
   lvDA!(-1) = VirtualDiskDA(disk, lv (cb>>CB.AddrL>>DL.previous))
]