// CopyDiskBfs.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 14, 1982 1:14 PM by Boggs
get "AltoDefs.d"
get "AltoFileSys.d"
get "CopyDisk.decl"
get "CopyDiskBfs.decl"
external
[
// outgoing procedures
InitCopyDiskBfs; ReportBfsError
// incoming procedures from other CopyDisk modules
DeclareDevice; DeclareDiskParams; FatalError
BfsTryDisk; BfsReader; BfsWriter; DataCompare
// incoming procedures from OS and packages
Zero; MoveBlock; MultEq; BlockEq
Allocate; Free; Block; MulDiv
PutTemplate; Wss; Puts; Confirm
Idle; Noop; ExtractSubstring; StringCompare
// incoming statics
debugFlag; model44Flag; seriousErrors
dsp; CtxRunning; sysZone
]
structure String [ length byte; char↑1,1 byte ]
//----------------------------------------------------------------------------
let InitCopyDiskBfs() be
//----------------------------------------------------------------------------
[
DeclareDiskParams(AltoDiablo, BfsPrintDiskParams)
DeclareDevice("DP0", MakeBFSSS)
DeclareDevice("DP1", MakeBFSSS)
DeclareDevice("BFS", MakeBFSSS)
DeclareDevice("BFS0", MakeBFSSS)
let eng = (table [ 61014b; 1401b ])()<<VERS.eng
if eng eq 4 % eng eq 5 then
[
DeclareDevice("DP10", MakeBFSSS)
DeclareDevice("DP11", MakeBFSSS)
DeclareDevice("BFS1", MakeBFSSS)
DeclareDevice("DP20", MakeBFSSS)
DeclareDevice("DP21", MakeBFSSS)
DeclareDevice("BFS2", MakeBFSSS)
]
if eng eq 5 then
[
DeclareDevice("DP30", MakeBFSSS)
DeclareDevice("DP31", MakeBFSSS)
DeclareDevice("BFS3", MakeBFSSS)
DeclareDevice("DP40", MakeBFSSS)
DeclareDevice("DP41", MakeBFSSS)
DeclareDevice("BFS4", MakeBFSSS)
DeclareDevice("DP50", MakeBFSSS)
DeclareDevice("DP51", MakeBFSSS)
DeclareDevice("BFS5", MakeBFSSS)
]
]
//----------------------------------------------------------------------------
and BfsIdle() be
//----------------------------------------------------------------------------
[
@mouseX = 200 + 200*diskAddress>>DA.disk
@mouseY = (diskAddress>>DA.cylinder ls 0? 0,
20 + MulDiv(808-40-16, diskAddress>>DA.cylinder, 406))
Block()
]
//----------------------------------------------------------------------------
and MakeBFSSS(device, write) = valof
//----------------------------------------------------------------------------
[
let drive, partition, fs = nil, nil, nil
let l = device>>String.length
test StringCompare("DP", device) eq -2
ifso //DPxy -- x is partition, y drive
[
fs = false
drive = device>>String.char↑l - $0
partition = device>>String.char↑(l-1)
]
ifnot //BFSx -- x is partition
[
fs = true
drive = 0
partition = device>>String.char↑l
]
partition = (partition ge $0 & partition le $5)? partition-$0, 0
unless BfsTryDisk(partition, drive, 0, 0) do
[ Wss(dsp, "- doesn't respond"); resultis false ]
let dShape = vec lDSHAPE; Zero(dShape, lDSHAPE)
if fs & not write then //read DSHAPE property in leader page of sysDir
[
// set up disk command block
let kcb = vec lKCB; Zero(kcb, lKCB)
kcb>>KCB.headerAddress = lv kcb>>KCB.header
kcb>>KCB.header.diskAddress.sector = 1
let label = vec lDL; Zero(label, lDL)
kcb>>KCB.labelAddress = label
label>>DL.numChars = 512
label>>DL.version = 1
label>>DL.directory = 1
label>>DL.sn2 = 144b
kcb>>KCB.dataAddress = Allocate(sysZone, 256)
kcb>>KCB.command = readD
kcb>>KCB.command.partition = partition
let ok = valof
[
@diskCommand = kcb
while kcb>>KCB.status eq 0 loop
if (kcb>>KCB.status & DSTgoodStatusMask) ne DSTgoodStatus then
[ Wss(dsp, "- can't find SysDir's leader page"); resultis false ]
// search for the DSHAPE property
let data = kcb>>KCB.dataAddress
if data>>LD.propertyBegin ge offset LD.leaderProps/16 &
data>>LD.propertyBegin + data>>LD.propertyLength le
(offset LD.leaderProps + size LD.leaderProps)/16 then
[
let fProp = data + data>>LD.propertyBegin
let maxFProp = fProp + data>>LD.propertyLength
until fProp>>FPROP.type eq 0 do
[
let length = fProp>>FPROP.length
if length eq 0 % fProp+length gr maxFProp break
if fProp>>FPROP.type eq fpropTypeDShape then
[
MoveBlock(dShape, fProp+1, lDSHAPE)
resultis true
]
fProp = fProp + length
]
]
Wss(dsp, "- can't find DSHAPE property")
resultis false
]
Free(sysZone, kcb>>KCB.dataAddress)
unless ok resultis false
if dShape>>DSHAPE.nDisks eq 2 then
unless BfsTryDisk(partition, 1, 0, 0) do
[ Wss(dsp, "- drive 1 doesn't respond"); resultis false ]
]
// MakeBFSSS (cont'd)
let ss = Allocate(sysZone, lenBFSSS); Zero(ss, lenBFSSS)
Idle = BfsIdle
ss>>SS.read = BfsReader
ss>>SS.write = BfsWriter
ss>>SS.destroy = DestroyBFSSS
ss>>SS.printDA = PrintCurrentDA
ss>>SS.compatible = fs? BfsCompatible, DPCompatible
ss>>SS.compare = BfsCompare
ss>>SS.printBlock = BfsPrintBlock
ss>>SS.lenBuffer = lenBFSBuffer
ss>>SS.device = ExtractSubstring(device)
ss>>SS.type = ssDisk
ss>>BFSSS.cbz = Allocate(sysZone, lenCBZ)
ss>>BFSSS.retryCount = 8
ss>>BFSSS.driveNumber = drive
ss>>BFSSS.partition = partition
// error block
let length = lenErrors + lenBFSErrors
let cd = Allocate(sysZone, length); Zero(cd, length)
ss>>SS.errors = cd
cd>>CD.length = length
cd>>CD.type = hereAreErrors
cd>>CD.errors.diskType = AltoDiablo
// disk parameters
length = lenDiskParams + lenBFSDiskParams
cd = Allocate(sysZone, length); Zero(cd, length)
ss>>SS.dp = cd
cd>>CD.length = length
cd>>CD.type = hereAreDiskParams
cd>>CD.diskParams.diskType = AltoDiablo
let dp = lv cd>>CD.diskParams.params
test fs & not write
ifso
[
dp>>BFSDiskParams.nDisks = dShape>>DSHAPE.nDisks
dp>>BFSDiskParams.nCylinders = dShape>>DSHAPE.nTracks
dp>>BFSDiskParams.nHeads = dShape>>DSHAPE.nHeads
dp>>BFSDiskParams.nSectors = dShape>>DSHAPE.nSectors
]
ifnot
[
dp>>BFSDiskParams.nDisks = (fs & write)? (BfsTryDisk(partition, 1, 0, 0)? 2, 1), 1
dp>>BFSDiskParams.nCylinders = BfsTryDisk(partition, 0, 203, 0)? 406,203
dp>>BFSDiskParams.nHeads = 2
dp>>BFSDiskParams.nSectors = BfsTryDisk(partition, 0, 0, 13)? 14, 12
]
Puts(dsp, $*N); BfsPrintDiskParams(cd)
resultis ss
]
//----------------------------------------------------------------------------
and DestroyBFSSS(ss) = valof
//----------------------------------------------------------------------------
[
Free(sysZone, ss>>BFSSS.cbz)
Free(sysZone, ss>>SS.errors)
Free(sysZone, ss>>SS.dp)
Free(sysZone, ss>>SS.device)
Free(sysZone, ss)
Idle = Block
resultis 0
]
//----------------------------------------------------------------------------
and DPCompatible(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
let sectors = 12
let srcSecs = srcDPs>>BFSDiskParams.nSectors
let snkSecs = snkDPs>>BFSDiskParams.nSectors
if (srcSecs eq 12 % snkSecs eq 12) & srcSecs ne snkSecs then
Wss(dsp, "*NI will treat the 14-sector disk as a 12-sector disk")
if srcSecs eq 14 & snkSecs eq 14 then
sectors = srcSS>>SS.type eq ssNetLog? 14,
(Confirm("*NShall I pretend this is a 12-sector disk?")? 12, 14)
srcDPs>>BFSDiskParams.nSectors = sectors
let cylinders = 203
let srcCyls = srcDPs>>BFSDiskParams.nCylinders
let snkCyls = snkDPs>>BFSDiskParams.nCylinders
if (srcCyls eq 203 % snkCyls eq 203) & srcCyls ne snkCyls then
Wss(dsp, "*NI will treat the model-44 disk as a model-31 disk")
if srcCyls eq 406 & snkCyls eq 406 then
cylinders = srcSS>>SS.type eq ssNetLog % model44Flag? 406,
(Confirm("*NShall I pretend this is a model-31 disk?")? 203, 406)
srcDPs>>BFSDiskParams.nCylinders = cylinders
resultis CreateXferParams(srcDPs)
]
//----------------------------------------------------------------------------
and BfsCompatible(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>>BFSDiskParams.nDisks gr snkDPs>>BFSDiskParams.nDisks %
srcDPs>>BFSDiskParams.nCylinders gr snkDPs>>BFSDiskParams.nCylinders %
srcDPs>>BFSDiskParams.nHeads gr snkDPs>>BFSDiskParams.nHeads %
srcDPs>>BFSDiskParams.nSectors gr snkDPs>>BFSDiskParams.nSectors then
[ Wss(dsp, "*NSource filesystem larger than destination disk."); resultis 0 ]
resultis CreateXferParams(srcDPs)
]
//----------------------------------------------------------------------------
and CreateXferParams(srcDPs) = valof
//----------------------------------------------------------------------------
[
let length = lenXferParams + lenBFSXferParams
let cd = Allocate(sysZone, length); Zero(cd, length)
cd>>CD.length = length
let lastDA = lv (lv cd>>CD.xferParams.params)>>BFSXferParams.lastDA
lastDA>>DA.disk = srcDPs>>BFSDiskParams.nDisks -1
lastDA>>DA.cylinder = srcDPs>>BFSDiskParams.nCylinders -1
lastDA>>DA.head = 1
lastDA>>DA.sector = srcDPs>>BFSDiskParams.nSectors -1
resultis cd
]
//----------------------------------------------------------------------------
and BfsCompare(ss, buf1, buf2) = valof
//----------------------------------------------------------------------------
[
if buf1>>BFSBuffer.type eq endOfTransfer %
buf2>>BFSBuffer.type eq endOfTransfer resultis true
if buf1>>BFSBuffer.header.diskAddress ne buf2>>BFSBuffer.header.diskAddress then
[
Wss(dsp, "*N[BfsCompare] Buffer DAs not equal")
ss>>SS.fatalFlag = true
resultis false
]
let length = lenBFSHeader + lenBFSLabel +
((buf1>>BFSBuffer.length eq lenFreePage %
buf2>>BFSBuffer.length eq lenFreePage)? 0, lenBFSData)
test BlockEq(lv buf1>>BFSBuffer.header, lv buf2>>BFSBuffer.header, length)
ifso resultis true
ifnot
[
Wss(dsp, "*NData compare error at ")
BfsPrintDA(dsp, buf1>>BFSBuffer.header.diskAddress, ss)
if debugFlag then DataCompare(lv buf1>>BFSBuffer.header,
lv buf2>>BFSBuffer.header, length)
resultis false
]
]
//----------------------------------------------------------------------------
and PrintCurrentDA(stream, ss) be
//----------------------------------------------------------------------------
BfsPrintDA(stream, ss>>BFSSS.currentDA, ss)
//----------------------------------------------------------------------------
and BfsPrintDA(stream, da, ss) be
//----------------------------------------------------------------------------
PutTemplate(stream, "$S: un $D cyl $3F0D hd $D sec $2F0D",
ss>>SS.device, da<<DA.disk, da<<DA.cylinder, da<<DA.head, da<<DA.sector)
//----------------------------------------------------------------------------
and ReportBfsError(type, daOrCb) be
//----------------------------------------------------------------------------
[
let ss = CtxRunning>>CDCtx.ss
let bfsErrors = lv ss>>SS.errors>>CD.errors.errors
switchon type & 177400b into
[
case EtHard:
[
PutTemplate(dsp, "*NHard $S error at ",
(type & 377b) eq EtWrite? "write","read")
BfsPrintDA(dsp, daOrCb>>CB.diskAddress, ss)
PutTemplate(dsp, ", SN $EUO", lv daOrCb>>CB.labelAddress>>DL.sn1)
bfsErrors>>BFSErrors.hardError = bfsErrors>>BFSErrors.hardError +1
endcase
]
case EtSoft:
[
if debugFlag then
[
PutTemplate(dsp, "*NSoft $S error at ",
(type & #377) eq EtWrite? "write","read")
BfsPrintDA(dsp, daOrCb, ss)
]
bfsErrors>>BFSErrors.softError = bfsErrors>>BFSErrors.softError +1
endcase
]
]
]
//----------------------------------------------------------------------------
and BfsPrintBlock(ss, cd) be
//----------------------------------------------------------------------------
[
if cd eq 0 return
switchon cd>>CD.type into
[
case no:
[
Wss(dsp, lv cd>>CD.codeString.string)
seriousErrors = true
endcase
]
case hereAreErrors:
[
if cd>>CD.errors.diskType eq 0 endcase
let printedDevice = false
let bfse = lv cd>>CD.errors.errors
if bfse>>BFSErrors.softError ne 0 & debugFlag then
[
unless printedDevice do PutTemplate(dsp, "*N$S: ", ss>>SS.device)
printedDevice = true
PutTemplate(dsp, "$UD soft errors ", bfse>>BFSErrors.softError)
]
if bfse>>BFSErrors.hardError ne 0 then
[
unless printedDevice do PutTemplate(dsp, "*N$S: ", ss>>SS.device)
printedDevice = true
PutTemplate(dsp, "$UD hard errors ", bfse>>BFSErrors.hardError)
seriousErrors = true
]
endcase
]
case storeDisk: case retrieveDisk:
[
let tp = lv cd>>CD.xferParams.params
Wss(dsp, "*N FirstDA: ")
BfsPrintDA(dsp, tp>>BFSXferParams.firstDA, ss)
Wss(dsp, "*N LastDA: ")
BfsPrintDA(dsp, tp>>BFSXferParams.lastDA, ss)
endcase
]
case hereAreDiskParams:
[
BfsPrintDiskParams(cd)
endcase
]
]
]
//----------------------------------------------------------------------------
and BfsPrintDiskParams(cd) be
//----------------------------------------------------------------------------
[
if cd>>CD.diskParams.diskType eq 0 return
let dp = lv cd>>CD.diskParams.params
let nDisks = (cd>>CD.length eq lenBFSDiskParams+lenDiskParams-1)? 1,
dp>>BFSDiskParams.nDisks
PutTemplate(dsp, "Type: Diablo, Dsk: $D, Cyl: $D, Hd: $D, Sec: $D",
nDisks, dp>>BFSDiskParams.nCylinders,
dp>>BFSDiskParams.nHeads, dp>>BFSDiskParams.nSectors)
]