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