// CopyDiskBfs1.bcpl // Copyright Xerox Corporation 1979, 1980, 1982 // Last modified July 21, 1982 6:55 PM by Boggs get "AltoDefs.d" get "CopyDisk.decl" get "CopyDiskBfs.decl" external [ // outgoing procedures BfsTryDisk; BfsReader; BfsWriter // incoming procedures form other CopyDisk modules ReportBfsError; GetBuffer; ReleaseBuffer; FatalError // incoming procedures from OS and packages Enqueue; Dequeue; Unqueue; InsertAfter; QueueLength Zero; MoveBlock; SysErr; Usc; ReturnTo; MultEq Idle; Noop; Block // incoming statics CtxRunning; driveLock; freePageFid compressFlag; bootFlag ] //---------------------------------------------------------------------------- let BfsTryDisk(partition, drive, cylinder, sector) = valof //---------------------------------------------------------------------------- // If cylinder is 0, returns true if disk is on line // If cylinder is 203, returns true if disk is model 44 [ let kcb = vec lKCB; Zero(kcb, lKCB) kcb>>KCB.command = seekOnly kcb>>KCB.command.partition = partition kcb>>KCB.diskAddress.disk = drive kcb>>KCB.diskAddress.cylinder = cylinder kcb>>KCB.diskAddress.sector = sector until @diskCommand eq 0 loop @diskCommand = kcb until kcb>>KCB.status.done loop resultis (kcb>>KCB.status & DSTgoodStatusMask) eq DSTgoodStatus ] //--------------------------------------------------------------------------- and BfsInitializeCbStorage(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.status = 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 BfsDoDiskCommand(cb, buffer, command) be //--------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss cb>>CB.headerAddress = lv buffer>>BFSBuffer.header cb>>CB.labelAddress = lv buffer>>BFSBuffer.label cb>>CB.dataAddress = lv buffer>>BFSBuffer.data cb>>CB.diskAddress = ss>>BFSSS.currentDA cb>>CB.command = command if command eq seekOnly then [ cb>>CB.diskAddress.restore = 1 cb>>CB.diskAddress.cylinder = 0 ] cb>>CB.command.partition = ss>>BFSSS.partition let p = @diskCommand if p ne 0 then [ [ let np = p>>CB.link if np eq 0 break p = np ] repeat p>>CB.link = cb ] // If there are no disk commands queued at the moment, be very careful // about plopping down a pointer to our cb. We must be sure that the // previous cb for this cbz has NOT encountered an error (it's OK // if it is free or has been transferred already, but not OK if there // is an error or if it has not been transferred at all) let cbz = cb>>CB.cbz if @diskCommand eq 0 then [ // take from head, add to tail => tail newest let prevCb = cbz>>CBZ.head? cbz>>CBZ.tail, 0 let stat = prevCb>>CB.status & DSTgoodStatusMask if prevCb eq 0 % (stat ne 0 & (stat & DSTerrorBits) eq 0) then @diskCommand = cb ] // Put this CB on the tail of 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 //Enqueue(lv cbz>>CBZ.head, lv cb>>CB.nextCB) ] //--------------------------------------------------------------------------- and BfsGetCb(cbz) = valof //--------------------------------------------------------------------------- // Here we wait for a transfer to complete. If, for some reason, 521 // (diskCommand) has been zeroed, which means that disk has // gone idle without executing this command, we fake an error // in this command in order to get the rest of this (BfsGetCb) code // executed. The cbz will be rebuilt, and the transfer re-queued. // This means that several callers of the Bfs active at once // (i.e., disk commands from several cbzs are queued) should all // work: if no errors happen during transfer, everything is fine. If // errors occur in one cbz, all will stop. Then, as the control // blocks become "cleaned up," we will eventually find, in each // cbz, one that was not executed (and with the disk idle). So the // mechanism for "faking" an error (DSTfakeError) will cause // the proper transfers to be re-queued. [ let cb = cbz>>CBZ.head; if cb eq 0 then SysErr(cbz, ecBfsQueue) [ if (cb>>CB.status & DSTdoneBits) ne 0 break if @diskCommand eq 0 & (cb>>CB.status & DSTdoneBits) eq 0 then cb>>CB.status = DSTfakeError Idle() //Let someone else in ] repeat cbz>>CBZ.head = cb>>CB.nextCB cb>>CB.command.seal = 0 // This block returns true iff the cb corresponds to a completed transfer. if valof [ let s = cb>>CB.status & DSTgoodStatusMask if s eq DSTfreeStatus resultis false // Restore commands can only be initiated from within BfsGetCb, // so this is our command, not the client's. Treat cb as free. if cb>>CB.diskAddress.restore eq 1 resultis false if s eq DSTgoodStatus test cb>>CB.command.headerAction ne 0 ifso resultis true ifnot if (cb>>CB.diskAddress & -4) eq (cb>>CB.headerAddress>>DH.diskAddress & -4) resultis true until @diskCommand eq 0 do Idle() // Wait for disk to stop spinning let ec = cbz>>CBZ.errorCount if cb>>CB.status.dataLate eq 0 then cbz>>CBZ.errorCount = ec +1 cbz>>CBZ.errorDA = cb>>CB.diskAddress //we deal entirely in real DAs if cbz>>CBZ.errorCount ge CtxRunning>>CDCtx.ss>>BFSSS.retryCount then [ // Unrecoverable error (cbz>>CBZ.error)(cb, ecUnRecovDiskError) resultis true //treat it as if it completed normally ] BfsInitializeCbStorage(cbz) // If the error count is large enough, initiate a restore. Note // that the command is issued, but we do not wait to be sure // it completes. if ec gr (CtxRunning>>CDCtx.ss>>BFSSS.retryCount rshift 1) then [ @diskAddress = -1 BfsDoDiskCommand(BfsGetCb(cbz), nil, seekOnly) ] ReturnTo(cbz>>CBZ.retry) ] then [ cbz>>CBZ.errorCount = 0 (cbz>>CBZ.cleanup)(cb) ] Zero(cb, lVarCB) resultis cb ] //---------------------------------------------------------------------------- and BfsReader(ctx) be //a context //---------------------------------------------------------------------------- [ let done = false let ss = ctx>>CDCtx.ss let cbz = ss>>BFSSS.cbz let xp = lv ss>>BFSSS.tp>>CD.xferParams.params ss>>BFSSS.currentDA = xp>>BFSXferParams.firstDA ss>>BFSSS.currentDA.disk = ss>>BFSSS.driveNumber [ BfsInitializeCbStorage(cbz, lenCBZ, BfsReadRetry, BfsReadError, BfsReadCleanup) Idle() repeatwhile driveLock % (QueueLength(ss>>SS.inputQ) ls ss>>SS.maxBuffers & ss>>SS.otherSS>>SS.type eq ss>>SS.type) driveLock = ctx if false then [ BfsReadRetry: Idle() repeatuntil driveLock eq 0 % driveLock eq ctx driveLock = ctx ss>>BFSSS.currentDA = cbz>>CBZ.errorDA while (ss>>SS.tempQ)!0 ne 0 do ReleaseBuffer(Dequeue(ss>>SS.tempQ)) ReportBfsError(EtSoft+EtRead, ss>>BFSSS.currentDA) ] [ let cb = BfsGetCb(cbz) let buffer = GetBuffer(true); if buffer eq 0 break Enqueue(ss>>SS.tempQ, buffer) BfsDoDiskCommand(cb, buffer, readHLD) done = BfsBumpDA() ] repeatuntil done driveLock = 0 while cbz>>CBZ.head ne 0 do BfsGetCb(cbz) ] repeatuntil done % ss>>SS.fatalFlag let buffer = GetBuffer(false) buffer>>BFSBuffer.type = endOfTransfer buffer>>BFSBuffer.length = 2 Enqueue(ss>>SS.outputQ, buffer) ss>>SS.doneFlag = true Block() repeat ] //---------------------------------------------------------------------------- and BfsReadCleanup(cb) be //---------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss let buffer = Dequeue(ss>>SS.tempQ) if cb>>CB.dataAddress ne lv buffer>>BFSBuffer.data then FatalError("*N[BfsReadCleanup] tempQ bad") buffer>>BFSBuffer.length = lenBFSBuffer-offset Buffer.length/16 buffer>>BFSBuffer.type = hereIsDiskPage if MultEq(lv buffer>>BFSBuffer.label.fid, table [ -2; -2; -2 ], lFID) then MoveBlock(lv buffer>>BFSBuffer.label.fid, freePageFid, lFID) if MultEq(lv buffer>>BFSBuffer.label.fid, freePageFid, lFID) & compressFlag then buffer>>BFSBuffer.length = lenFreePage Enqueue(ss>>SS.outputQ, buffer) ] //---------------------------------------------------------------------------- and BfsReadError(cb, errorcode) be //---------------------------------------------------------------------------- ReportBfsError(EtHard+EtRead, cb) //---------------------------------------------------------------------------- and BfsWriter(ctx) be //a context //---------------------------------------------------------------------------- [ let done = false let ss = ctx>>CDCtx.ss if ss>>BFSSS.driveNumber eq 0 then bootFlag = true let cbz = ss>>BFSSS.cbz let xp = lv ss>>BFSSS.tp>>CD.xferParams.params ss>>BFSSS.currentDA = xp>>BFSXferParams.firstDA ss>>BFSSS.currentDA.disk = ss>>BFSSS.driveNumber [ BfsInitializeCbStorage(cbz, lenCBZ, BfsWriteRetry, BfsWriteError, BfsWriteCleanup) Idle() repeatwhile driveLock % (ss>>SS.inputQ)!0 eq 0 driveLock = ctx if false then [ BfsWriteRetry: Idle() repeatuntil driveLock eq 0 % driveLock eq ctx driveLock = ctx ss>>BFSSS.currentDA = cbz>>CBZ.errorDA let p = ss>>SS.inputQ; while (ss>>SS.tempQ)!0 ne 0 do [ InsertAfter(ss>>SS.inputQ, p, Dequeue(ss>>SS.tempQ)) p = p!0 ] ReportBfsError(EtSoft+EtWrite, ss>>BFSSS.currentDA) ] [ let cb = BfsGetCb(cbz) let buffer = Dequeue(ss>>SS.inputQ); if buffer eq 0 break if buffer>>BFSBuffer.type ne hereIsDiskPage then [ ReleaseBuffer(buffer); ss>>SS.fatalFlag = true; break ] Enqueue(ss>>SS.tempQ, buffer) BfsDoDiskCommand(cb, buffer, writeHLD) done = BfsBumpDA() ] repeatuntil done driveLock = 0 while cbz>>CBZ.head ne 0 do BfsGetCb(cbz) ] repeatuntil done % ss>>SS.fatalFlag ss>>SS.doneFlag = true Block() repeat ] //---------------------------------------------------------------------------- and BfsWriteCleanup(cb) be //---------------------------------------------------------------------------- [ let buffer = Dequeue(CtxRunning>>CDCtx.ss>>SS.tempQ) if cb>>CB.dataAddress ne lv buffer>>BFSBuffer.data then FatalError("*N[BfsWriteCleanup] tempQ bad") ReleaseBuffer(buffer) ] //---------------------------------------------------------------------------- and BfsWriteError(cb, errorcode) be //---------------------------------------------------------------------------- ReportBfsError(EtHard+EtWrite, cb) //---------------------------------------------------------------------------- and BfsBumpDA() = valof //---------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss let da = lv ss>>BFSSS.currentDA let dp = lv ss>>SS.dp>>CD.diskParams.params let tp = lv ss>>SS.tp>>CD.xferParams.params let currentDA = @da if dp>>BFSDiskParams.nDisks eq 1 then currentDA<>BFSXferParams.lastDA resultis true da>>DA.sector = da>>DA.sector +1 if da>>DA.sector eq dp>>BFSDiskParams.nSectors then [ da>>DA.sector = 0 da>>DA.head = da>>DA.head +1 if da>>DA.head eq 0 then [ da>>DA.head = 0 da>>DA.cylinder = da>>DA.cylinder +1 if da>>DA.cylinder eq dp>>BFSDiskParams.nCylinders then [ da>>DA.cylinder = 0 da>>DA.disk = da>>DA.disk +1 ] ] ] resultis false ]