// CopyDiskTfs.bcpl // Copyright Xerox Corporation 1979, 1980, 1981 // Last modified December 11, 1981 6:23 PM by Boggs get "AltoDefs.d" get "CopyDisk.decl" get "CopyDiskTfs.decl" external [ // outgoing procedures InitCopyDiskTfs // incoming procedures from other CopyDisk modules DeclareDevice; DeclareDiskParams GetBuffer; ReleaseBuffer; FatalError MulDiv; BlockEq; DoubleUsc; DataCompare // incoming procedures from OS and packages TFSInitializeCbStorage; TFSGetCb; TFSSwatContextProc TFSDoDiskCommand; TFSTryDisk; TFSDiskModel; TFSRecovery TFSModShift; TFSModShiftA Enqueue; Dequeue; Unqueue; InsertAfter; QueueLength Zero; MoveBlock; SetBlock; MultEq Allocate; Free; Block; Idle PutTemplate; Wss; Puts; ExtractSubstring // incoming statics debugFlag; compressFlag; seriousErrors driveLock; dsp CtxRunning; freePageFid; sysZone lvUserFinishProc; lvSwatContextProc; ramFlag ] static [ savedFinishProc; savedSwatProc displayCount = 0; savedDisplay ] structure String [ length byte; char^1,1 byte ] //---------------------------------------------------------------------------- let InitCopyDiskTfs() be //---------------------------------------------------------------------------- [ // LoadRam will fail on D0s and Dorados, but a trident will still work. let eng = (table [ 61014b; 1401b ])()<>KBLK.drive @mouseY = (KBLK>>KBLK.cylinder ls 0? 0, 20 + MulDiv(808-40-16, KBLK>>KBLK.cylinder, 815)) Block() ] //---------------------------------------------------------------------------- and MakeTFSSS(device, write) = valof //---------------------------------------------------------------------------- [ let drive = device>>String.char^(device>>String.length)-$0 if TFSTryDisk(drive) ne 1 then [ Wss(dsp, "- doesn't respond"); resultis false ] Idle = TfsIdle let ss = Allocate(sysZone, lenTFSSS); Zero(ss, lenTFSSS) CtxRunning>>CDCtx.ss = ss ss>>SS.read = TfsReader ss>>SS.write = TfsWriter ss>>SS.destroy = DestroyTFSSS ss>>SS.printDA = PrintCurrentDA ss>>SS.compatible = TfsCompatible ss>>SS.compare = TfsCompare ss>>SS.printBlock = TfsPrintBlock ss>>SS.lenBuffer = lenTFSBuffer ss>>SS.device = ExtractSubstring(device) ss>>SS.type = ssDisk ss>>TFSSS.cbz = Allocate(sysZone, lenCBZ) ss>>TFSSS.drive = drive ss>>TFSSS.retryCount = 16 // error block let length = lenErrors + lenTFSErrors let cd = Allocate(sysZone, length); Zero(cd, length) ss>>SS.errors = cd cd>>CD.length = length cd>>CD.type = hereAreErrors cd>>CD.errors.diskType = AltoTrident // disk parameters length = lenDiskParams + lenTFSDiskParams cd = Allocate(sysZone, length); Zero(cd, length) ss>>SS.dp = cd cd>>CD.length = length cd>>CD.type = hereAreDiskParams cd>>CD.diskParams.diskType = AltoTrident // Do a restore if the drive appears to be in trouble if KBLK>>KBLK.DeviceCk % KBLK>>KBLK.SeekInc then TFSRecovery(diskRestore) TFSDiskModel(ss) Puts(dsp, $*N); TfsPrintDiskParams(cd) resultis ss ] //---------------------------------------------------------------------------- and DestroyTFSSS(ss) = valof //---------------------------------------------------------------------------- [ Free(sysZone, ss>>TFSSS.cbz) Free(sysZone, ss>>SS.errors) Free(sysZone, ss>>SS.dp) Free(sysZone, ss>>SS.device) Free(sysZone, ss) TurnOnDisplay(true) Idle = Block resultis 0 ] //---------------------------------------------------------------------------- and TfsCompatible(srcSS, snkSS) = valof //---------------------------------------------------------------------------- [ let srcDPs = lv srcSS>>SS.dp>>CD.diskParams.params let snkDPs = lv (snkSS>>SS.dp>>CD.diskParams.diskType eq 0? srcSS, snkSS)>>SS.dp>>CD.diskParams.params if srcDPs>>TFSDiskParams.nCylinders ne snkDPs>>TFSDiskParams.nCylinders % srcDPs>>TFSDiskParams.nHeads ne snkDPs>>TFSDiskParams.nHeads % srcDPs>>TFSDiskParams.nSectors ne snkDPs>>TFSDiskParams.nSectors then [ Wss(dsp, "*NDisks are incompatible."); resultis 0 ] let length = lenXferParams + lenTFSXferParams let cd = Allocate(sysZone, length); Zero(cd, length) cd>>CD.length = length let xp = lv cd>>CD.xferParams.params (lv xp>>TFSXferParams.firstDA)>>DA.sector = 1 //don't copy bad page table let lastDA = lv xp>>TFSXferParams.lastDA lastDA>>DA.cylinder = srcDPs>>TFSDiskParams.nCylinders -1 lastDA>>DA.head = srcDPs>>TFSDiskParams.nHeads -1 lastDA>>DA.sector = srcDPs>>TFSDiskParams.nSectors -1 resultis cd ] //---------------------------------------------------------------------------- and TfsCompare(ss, buf1, buf2) = valof //---------------------------------------------------------------------------- [ if buf1>>TFSBuffer.type eq endOfTransfer % buf2>>TFSBuffer.type eq endOfTransfer resultis true unless MultEq(lv buf1>>TFSBuffer.header, lv buf2>>TFSBuffer.header) do [ Wss(dsp, "*N[TfsCompare] Buffer DAs not equal") ss>>SS.fatalFlag = true resultis false ] let length = lenTFSHeader + lenTFSLabel + ((buf1>>TFSBuffer.length eq lenFreePage % buf2>>TFSBuffer.length eq lenFreePage)? 0, lenTFSData) test BlockEq(lv buf1>>TFSBuffer.header, lv buf2>>TFSBuffer.header, length) ifso resultis true ifnot [ Wss(dsp, "*NData compare error at ") TfsPrintDA(dsp, lv buf1>>TFSBuffer.header, ss) if debugFlag then DataCompare(lv buf1>>TFSBuffer.header, lv buf2>>TFSBuffer.header, length) resultis false ] ] //---------------------------------------------------------------------------- and TfsReader(ctx) be //a context //---------------------------------------------------------------------------- [ let ss = ctx>>CDCtx.ss let cbz = ss>>TFSSS.cbz let tp = lv ss>>TFSSS.tp>>CD.xferParams.params TurnOffDisplay() MoveBlock(lv ss>>TFSSS.currentDA, lv tp>>TFSXferParams.firstDA, 2) [ TFSInitializeCbStorage(cbz, lenCBZ, TfsReadRetry, TfsReadError, TfsReadCleanup) Idle() repeatwhile driveLock % (QueueLength(ss>>SS.inputQ) ls ss>>SS.maxBuffers & ss>>SS.otherSS>>SS.type eq ssDisk) driveLock = ctx if false then [ TfsReadRetry: Idle() repeatuntil driveLock eq 0 % driveLock eq ctx driveLock = ctx MoveBlock(lv ss>>TFSSS.currentDA, lv ((ss>>SS.tempQ)!0)>>TFSBuffer.header, 2) while (ss>>SS.tempQ)!0 ne 0 do ReleaseBuffer(Dequeue(ss>>SS.tempQ)) ReportTfsError(EtSoft+EtRead, lv ss>>TFSSS.currentDA) ] [ let cb = TFSGetCb(cbz) let buffer = GetBuffer(true); if buffer eq 0 break Enqueue(ss>>SS.tempQ, buffer) TFSDoDiskCommand(cb, buffer, DCreadLD) BumpDA() ] repeatuntil DoubleUsc(lv ss>>TFSSS.currentDA, lv tp>>TFSXferParams.lastDA) gr 0 driveLock = 0 while cbz>>CBZ.head ne 0 do TFSGetCb(cbz) ] repeatuntil DoubleUsc(lv ss>>TFSSS.currentDA, lv tp>>TFSXferParams.lastDA) gr 0 let buffer = GetBuffer(false) buffer>>TFSBuffer.type = endOfTransfer buffer>>TFSBuffer.length = 2 Enqueue(ss>>SS.outputQ, buffer) TurnOnDisplay() ss>>SS.doneFlag = true Block() repeat ] //---------------------------------------------------------------------------- and TfsReadCleanup(cb) be //---------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss let buffer = Dequeue(ss>>SS.tempQ) if cb>>CB.AddrD ne lv buffer>>TFSBuffer.data then FatalError("*N[TfsReadCleanup] tempQ bad") buffer>>TFSBuffer.length = lenTFSBuffer-offset Buffer.length/16 buffer>>TFSBuffer.type = hereIsDiskPage if MultEq(lv buffer>>TFSBuffer.label.fileId, table [ -2; -2; -2 ], lFID) then MoveBlock(lv buffer>>TFSBuffer.label.fileId, freePageFid, lFID) if MultEq(lv buffer>>TFSBuffer.label.fileId, freePageFid, lFID) & compressFlag then buffer>>TFSBuffer.length = lenFreePage Enqueue(ss>>SS.outputQ, buffer) ] //---------------------------------------------------------------------------- and TfsReadError(cb, errorcode) be //---------------------------------------------------------------------------- ReportTfsError(EtHard+EtRead, cb) //---------------------------------------------------------------------------- and TfsWriter(ctx) be //a context //---------------------------------------------------------------------------- [ let ss = ctx>>CDCtx.ss ss>>TFSSS.action = DCwriteLD ss>>TFSSS.checkErrors = 0 let cbz = ss>>TFSSS.cbz let tp = lv ss>>TFSSS.tp>>CD.xferParams.params TurnOffDisplay() MoveBlock(lv ss>>TFSSS.currentDA, lv tp>>TFSXferParams.firstDA, 2) [ TFSInitializeCbStorage(cbz, lenCBZ, TfsWriteRetry, TfsWriteError, TfsWriteCleanup) Idle() repeatwhile (ss>>SS.inputQ)!0 eq 0 % driveLock driveLock = ctx if false then [ TfsWriteRetry: Idle() repeatuntil driveLock eq 0 % driveLock eq ctx driveLock = ctx MoveBlock(lv ss>>TFSSS.currentDA, lv ((ss>>SS.tempQ)!0)>>TFSBuffer.header, 2) 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 ] if cbz>>CBZ.errorCount ge ss>>TFSSS.retryCount rshift 1 then [ //ok. You asked for it ss>>TFSSS.action = DCwriteHLD ss>>TFSSS.checkErrors = ss>>TFSSS.checkErrors +1 if ss>>TFSSS.checkErrors eq 25 then [ PutTemplate(dsp, "*N$S appears to be unformatted.", ss>>SS.device) Wss(dsp, "*NI will format it for you, but beware:") Wss(dsp, "*NThis is not as safe as formatting using TFU.") ] ] ReportTfsError(EtSoft+EtWrite, lv ss>>TFSSS.currentDA) ] [ let cb = TFSGetCb(cbz) let buffer = Dequeue(ss>>SS.inputQ); if buffer eq 0 break unless MultEq(lv buffer>>TFSBuffer.header, lv ss>>TFSSS.currentDA) do FatalError("*N[TfsWriter] inputQ bad ") Enqueue(ss>>SS.tempQ, buffer) TFSDoDiskCommand(cb, buffer, ss>>TFSSS.action) if ss>>TFSSS.checkErrors ls errorThreshold then ss>>TFSSS.action = DCwriteLD BumpDA() ] repeatuntil DoubleUsc(lv ss>>TFSSS.currentDA, lv tp>>TFSXferParams.lastDA) gr 0 driveLock = 0 while cbz>>CBZ.head ne 0 do TFSGetCb(cbz) ] repeatuntil DoubleUsc(lv ss>>TFSSS.currentDA, lv tp>>TFSXferParams.lastDA) gr 0 TurnOnDisplay() ss>>SS.doneFlag = true Block() repeat ] //---------------------------------------------------------------------------- and TfsWriteCleanup(cb) be //---------------------------------------------------------------------------- [ let buffer = Dequeue(CtxRunning>>CDCtx.ss>>SS.tempQ) if cb>>CB.AddrD ne lv buffer>>TFSBuffer.data then FatalError("*N[TfsWriteCleanup] tempQ bad") ReleaseBuffer(buffer) ] //---------------------------------------------------------------------------- and TfsWriteError(cb, ec) be //---------------------------------------------------------------------------- [ if ec eq ecReadOnly then FatalError("*N$S is Read Only!", CtxRunning>>CDCtx.ss>>SS.device) ReportTfsError(EtHard+EtWrite, cb) ] //---------------------------------------------------------------------------- and PrintCurrentDA(stream, ss) be //---------------------------------------------------------------------------- TfsPrintDA(stream, lv ss>>TFSSS.currentDA, ss) //---------------------------------------------------------------------------- and TfsPrintDA(stream, lvRealDA, ss) be //---------------------------------------------------------------------------- PutTemplate(stream, "$S: cyl $3UF0D hd $UD sec $UD", ss>>SS.device, lvRealDA>>DA.cylinder, lvRealDA>>DA.head, lvRealDA>>DA.sector) //---------------------------------------------------------------------------- and BumpDA() be //---------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss let da = lv ss>>TFSSS.currentDA let dp = lv ss>>SS.dp>>CD.diskParams.params da>>DA.sector = da>>DA.sector +1 if da>>DA.sector eq dp>>TFSDiskParams.nSectors then [ da>>DA.sector = 0 da>>DA.head = da>>DA.head +1 if da>>DA.head eq dp>>TFSDiskParams.nHeads then [ da>>DA.head = 0 da>>DA.cylinder = da>>DA.cylinder +1 ] ] ] //---------------------------------------------------------------------------- and ReportTfsError(type, daOrCb) be //---------------------------------------------------------------------------- [ let ss = CtxRunning>>CDCtx.ss let tfsErrors = ss>>SS.errors>>CD.errors.errors switchon type & 177400b into [ case EtHard: [ PutTemplate(dsp, "*NHard $S error at ", (type & 377b) eq EtWrite? "write", "read") TfsPrintDA(dsp, lv daOrCb>>CB.diskAddress, ss) tfsErrors>>TFSErrors.hardError = tfsErrors>>TFSErrors.hardError +1 endcase ] case EtSoft: [ if debugFlag then [ PutTemplate(dsp, "*NSoft $S error at ", (type & 377b) eq EtWrite? "write", "read") TfsPrintDA(dsp, daOrCb, ss) ] tfsErrors>>TFSErrors.softError = tfsErrors>>TFSErrors.softError +1 endcase ] ] ] //---------------------------------------------------------------------------- and TfsPrintBlock(ss, cd) be //---------------------------------------------------------------------------- [ if cd eq 0 return switchon cd>>CD.type into [ case no: [ Wss(dsp, lv cd>>CD.codeString.string) endcase ] case hereAreErrors: [ if cd>>CD.errors.diskType eq 0 endcase let printedDevice = false let tfsErrors = lv cd>>CD.errors.errors if tfsErrors>>TFSErrors.softError ne 0 & debugFlag then [ unless printedDevice do PutTemplate(dsp, "*N$S: ", ss>>SS.device) printedDevice = true PutTemplate(dsp, "$UD soft errors ", tfsErrors>>TFSErrors.softError) ] if tfsErrors>>TFSErrors.hardError ne 0 then [ unless printedDevice do PutTemplate(dsp, "*N$S: ", ss>>SS.device) printedDevice = true PutTemplate(dsp, "$UD hard errors ", tfsErrors>>TFSErrors.hardError) seriousErrors = true ] endcase ] case storeDisk: case retrieveDisk: [ let tp = lv cd>>CD.xferParams.params Wss(dsp, "*N FirstDA: ") TfsPrintDA(dsp, lv tp>>TFSXferParams.firstDA, ss) Wss(dsp, "*N LastDA: ") TfsPrintDA(dsp, lv tp>>TFSXferParams.lastDA, ss) endcase ] case hereAreDiskParams: [ TfsPrintDiskParams(cd) endcase ] ] ] //---------------------------------------------------------------------------- and TfsPrintDiskParams(cd) be //---------------------------------------------------------------------------- [ if cd>>CD.diskParams.diskType eq 0 return let dp = lv cd>>CD.diskParams.params PutTemplate(dsp, "Type: Trident, Cyl: $D, Hd: $D, Sec: $D", dp>>TFSDiskParams.nCylinders, dp>>TFSDiskParams.nHeads, dp>>TFSDiskParams.nSectors) ]