// ScavUtilB.bcpl -- Scavenger utility routines
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 10, 1982 5:48 PM by Boggs
get "AltoFileSys.d"
get "AltoDefs.d"
get "Streams.d"
get "Disks.d"
get "BFS.d"
get "Scavenger.decl"
external
[
// outgoing procedures
DiskToCursor; SysErr; CopyString
XferPage; XferError; TryDisk; FindDShape
ScavAssignDiskPage; ScavReleaseDiskPage
GetString; Confirm; Ws; Wss; WouldHave
// incoming procedures
GetBit; SetBit; MulDiv
SimpleDspEraseBits; SimpleDspCharWidth
Gets; Puts; MoveBlock; Zero; Allocate; DefaultArgs
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
VirtualDiskDA; BfsMakeFpFromLabel
PutTemplate
// incoming statics
sysZone; sysDisk; dsp; keys
logFlag; alterFlag; label; data
maxVDA; usedBT; badBT
]
structure String [ length byte; char↑1,1 byte ]
//-----------------------------------------------------------------------------------------
let DiskToCursor() be
//-----------------------------------------------------------------------------------------
[
@mouseX = 450 + diskAddress>>DA.disk lshift 7 //450 or 578
@mouseY = diskAddress>>DA.track ls 0? 0,
20 + MulDiv(808-40-16, diskAddress>>DA.track, sysDisk>>BFSDSK.nTracks)
]
//-----------------------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------
and Wss(stream, string) be
//-----------------------------------------------------------------------------------------
for i = 1 to string>>String.length do Puts(stream, string>>String.char↑i)
//-----------------------------------------------------------------------------------------
and WouldHave(nil, nil) be unless alterFlag do Ws("Would have ")
//-----------------------------------------------------------------------------------------
//-----------------------------------------------------------------------------------------
and SysErr(p1, errNo, p2, p3, p4, p5) be
//-----------------------------------------------------------------------------------------
[
let temp = p1; p1 = errNo; errNo = temp
(table [ 77403b; 1401b ])("Sys.Errors", lv p1)
]
//-----------------------------------------------------------------------------------------
and Confirm(prompt) = valof
//-----------------------------------------------------------------------------------------
[
Ws(prompt)
switchon Gets(keys) into
[
case $Y: case $y: case $*N:
[ Ws(" Yes"); resultis true ]
case $N: case $n: case $*177:
[ Ws(" No"); resultis false ]
default: Ws(" ?")
] repeat
]
//-----------------------------------------------------------------------------------------
and CopyString(dest, source) be
//-----------------------------------------------------------------------------------------
MoveBlock(dest, source, source>>String.length rshift 1 +1)
//-----------------------------------------------------------------------------------------
and GetString(prompt) = valof
//-----------------------------------------------------------------------------------------
[
Ws(prompt)
let string, count = vec 128, 0
[
let char = Gets(keys)
switchon char into
[
case $*001: case $*010:
[
if count ne 0 then
[
SimpleDspEraseBits(dsp, -SimpleDspCharWidth(dsp, string>>String.char↑count))
count = count -1
]
endcase
]
case $*S: case $*N: case $*033: break
case $*027:
[
for i = count to 1 by -1 do
SimpleDspEraseBits(dsp, -SimpleDspCharWidth(dsp, string>>String.char↑i))
count = 0
endcase
]
case $*177:
[
Ws(" XXX ")
count = 0
break
]
default:
[
if char ge $*S & char le $*177 & count ls 255 then
[
count = count +1
string>>String.char↑count = char
Puts(dsp, char)
]
endcase
]
]
] repeat
// leave room for the string to get longer by one character
let res = Allocate(sysZone, count/2+2)
res>>String.length = count
for i = 1 to count do res>>String.char↑i = string>>String.char↑i
resultis res
]
//-----------------------------------------------------------------------------------------
and XferPage(action, vda, d, l, h, lvError; numargs na) = valof
//-----------------------------------------------------------------------------------------
[
let header = vec 1
DefaultArgs(lv na, -2, data, label, header, lv XferError)
let cbz = vec CBzoneLength
InitializeDiskCBZ(sysDisk, cbz, 0, CBzoneLength, XferRetry, lvError)
cbz>>CBZ.cleanupRoutine = XferCleanup
cbz>>CBZ.client = h
XferRetry: let cb = GetDiskCb(sysDisk, cbz)
cb>>CB.labelAddress = l
let fp = vec lFP; BfsMakeFpFromLabel(fp, l)
DoDiskCommand(sysDisk, cb, d, vda, fp, l>>DL.pageNumber, action)
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(sysDisk, cbz)
resultis cbz>>CBZ.currentPage
]
//-----------------------------------------------------------------------------------------
and XferCleanup(disk, cb, cbz) be
//-----------------------------------------------------------------------------------------
[
MoveBlock(cbz>>CBZ.client, cb>>CB.headerAddress, 2)
cbz>>CBZ.currentPage = cb>>CB.status
]
//-----------------------------------------------------------------------------------------
and XferError(nil, cb, nil) be
//-----------------------------------------------------------------------------------------
[
logFlag = true
let rda, vda = cb>>CB.diskAddress, VirtualDiskDA(sysDisk, lv cb>>CB.diskAddress)
PutTemplate(dsp, "*NHard error at VDA $UOb = Unit $D, Cylinder $D, Head $D, Sector $D.",
vda, rda<<DA.disk, rda<<DA.track, rda<<DA.head, rda<<DA.sector)
let dl = cb>>CB.labelAddress
if cb>>CB.command.labelAction eq 0 & cb>>CB.status.finalStatus ne 1 then
PutTemplate(dsp, "*NLabel was: SerialNumber $EUOb, PageNumber $D, NumChars $D.",
lv dl>>DL.fileId.serialNumber, dl>>DL.pageNumber, dl>>DL.numChars)
Ws("*NAttempted action was:")
for i = 1 to 3 do
[
let action = selecton i into
[
case 1: cb>>CB.command.headerAction
case 2: cb>>CB.command.labelAction
case 3: cb>>CB.command.dataAction
]
action = selecton action into
[ case 0: "Read"; case 1: "Check"; case 2 to 3: "Write" ]
let record = selecton i into
[ case 1: "Header"; case 2: "Label"; case 3: "Data" ]
PutTemplate(dsp, " $S $S$C", action, record, (i eq 3? $., $,))
]
Ws("*NResulting status was:")
let dst = cb>>CB.status
if dst<<DST.seekFail then Ws(" SeekFailed")
if dst<<DST.seeking then Ws(" Seeking")
if dst<<DST.notReady then Ws(" NotReady")
if dst<<DST.dataLate then Ws(" DataLate")
if dst<<DST.noTransfer then Ws(" NoTransfer")
if dst<<DST.checksumError then Ws(" ChecksumError")
if dst<<DST.finalStatus then Ws(selecton dst<<DST.finalStatus into
[
case 1: (dst&360b) ne 0? "", " SectorLate"
case 2: " CheckError"
case 3: " IllegalSector"
])
]
//-----------------------------------------------------------------------------------------
and TryDisk(dsk, trk, hd, sect) = valof
//-----------------------------------------------------------------------------------------
[
let kcb = vec lKCB; Zero(kcb, lKCB)
kcb>>KCB.command = readLD
kcb>>KCB.headerAddress = lv kcb>>KCB.header
kcb>>KCB.labelAddress = label
kcb>>KCB.dataAddress = data
kcb>>KCB.diskAddress.disk = dsk
kcb>>KCB.diskAddress.track = trk
kcb>>KCB.diskAddress.head = hd
kcb>>KCB.diskAddress.sector = sect
until @diskCommand eq 0 loop
for trys = 1 to 5 do
[
kcb>>KCB.status = 0
@diskCommand = kcb
while (kcb>>KCB.status & DSTdoneBits) eq 0 loop
if (kcb>>KCB.status & DSTgoodStatusMask) eq DSTgoodStatus break
]
resultis kcb>>KCB.status
]
//-----------------------------------------------------------------------------------------
and FindDShape(ld) = valof
//-----------------------------------------------------------------------------------------
[
if ld>>LD.propertyBegin ge offset LD.leaderProps/16 &
ld>>LD.propertyBegin + ld>>LD.propertyLength le
offset LD.leaderProps/16 + size LD.leaderProps/16 then
[
let ofset = ld>>LD.propertyBegin
while ofset ls ld>>LD.propertyLength-lDSHAPE-1 do
[
let prop = ld + ofset
if prop>>FPROP.type eq fpropTypeDShape then
test prop>>FPROP.length eq lDSHAPE+1
ifso resultis ofset
ifnot break // bogus leader page
test prop>>FPROP.length eq 0
ifso resultis ofset
ifnot ofset = ofset + prop>>FPROP.length
]
]
ld>>LD.propertyBegin = offset LD.leaderProps/16
ld>>LD.propertyLength = size LD.leaderProps/16
Zero(lv ld>>LD.leaderProps, size LD.leaderProps/16)
resultis offset LD.leaderProps/16
]
//-----------------------------------------------------------------------------------------
and ScavAssignDiskPage(disk, vda) = valof
//-----------------------------------------------------------------------------------------
[
if vda eq eofDA then vda = 0
// first, try to assign a free page
let i = vda +1
[
if i eq vda break
if i eq maxVDA+1 then i = 0
if GetBit(usedBT, i) eq 0 then
[
SetBit(usedBT, i, true)
disk>>BFSDSK.freePages = sysDisk>>BFSDSK.freePages -1
resultis i
]
i = i +1
] repeat
// next, try to reuse a bad page
i = vda +1
[
if i eq vda then SysErr(0, ecDiskFull, 0)
if i eq maxVDA+1 then i = 0
if GetBit(badBT, i) then
[
SetBit(badBT, i, false)
resultis i
]
i = i+1
] repeat
]
//-----------------------------------------------------------------------------------------
and ScavReleaseDiskPage(disk, vda) = valof
//-----------------------------------------------------------------------------------------
[
SetBit(usedBT, vda, false)
disk>>BFSDSK.freePages = sysDisk>>BFSDSK.freePages +1
]