// 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 ])()<<VERS.eng
@613b = eng gr 1
unless ramFlag % eng ge 4 return
if eng ge 4 then TFSModShift = TFSModShiftA
savedSwatProc = @lvSwatContextProc; @lvSwatContextProc = TFSSwatContextProc
savedFinishProc = @lvUserFinishProc; @lvUserFinishProc = TfsFinishProc
let p = TFSTryDisk(37b)
if p ne 0 then // we have a TriCon
[
DeclareDiskParams(AltoTrident, TfsPrintDiskParams)
DeclareDevice("TP0", MakeTFSSS)
if p ne 1 then // but no TriMux
[
DeclareDevice("TP1", MakeTFSSS)
DeclareDevice("TP2", MakeTFSSS)
DeclareDevice("TP3", MakeTFSSS)
DeclareDevice("TP4", MakeTFSSS)
DeclareDevice("TP5", MakeTFSSS)
DeclareDevice("TP6", MakeTFSSS)
DeclareDevice("TP7", MakeTFSSS)
]
]
]
//----------------------------------------------------------------------------
and TfsFinishProc() be
//----------------------------------------------------------------------------
[
TurnOnDisplay(true)
@lvSwatContextProc = savedSwatProc
@lvUserFinishProc = savedFinishProc
]
//----------------------------------------------------------------------------
and TurnOffDisplay() be
//----------------------------------------------------------------------------
[
if (table [ 61014b; 1401b ])()<<VERS.eng gr 3 return
displayCount = displayCount +1
if displayCount gr 1 return
savedDisplay = @displayListHead; @displayListHead = 0
]
//----------------------------------------------------------------------------
and TurnOnDisplay(force; numargs na) be
//----------------------------------------------------------------------------
[
if na ls 1 then force = false
if displayCount eq 0 return //already on
displayCount = displayCount -1
test force
ifnot if displayCount ne 0 return
ifso displayCount = 0
@displayListHead = savedDisplay
]
//----------------------------------------------------------------------------
and TfsIdle() be
//----------------------------------------------------------------------------
// The Idle() procedure called while TFS is waiting for the disk
[
@mouseX = 20 + ((606-40-16)/(maxDsk+1))*KBLK>>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)
]