// 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
]