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