// IfsScavenger.bcpl - the resident stuff
// Copyright Xerox Corporation 1979, 1980, 1981, 1982, 1984
// Last modified February 16, 1984  3:38 PM by Boggs

get "IfsScavenger.decl"
get "AltoFileSys.d"
get "IfsDirs.decl"
get "Streams.d"
get "Disks.d"

external
[
// outgoing procedures
IfsScavenger; ScavNoBufsProc; Scratch
SplitPuts; LogErrors; ExtendFile

// incoming procedures
Pass1; Pass2; DiskEditor; DumpTree; DumpLPT
CreateKeywordTable; InsertKeyword; Confirm; GetNumber
OpenDisk; CloseDisk; SnarfBuffer
GetKeyword; InitCmd; WRITEUDT
Closes; Puts; Wss; Ws; Allocate; Free; SetBlock; Zero; Noop
CallSwat; IFSError; SysErr; ReturnFrom
OpenFile; CreateDiskStream; FileLength; PositionPage
ReleaseDiskPage; AssignDiskPage; ActOnDiskPages; WriteDiskPages
DiskFindHole; JumpToFa; GetCurrentFa

// outgoing statics
scratchDisk; scavDisk
numFiles; numPages; lpt; pass; phase
editHomeFlag; initTreeFlag; initLptFlag; debugFlag; justFixDirFlag

// incoming statics
dsp; keys; sysDisk; numVMemBufs; sysZone
wordsPerPage; bytesPerPage
]

static
[
scratchDisk; scavDisk
numFiles; numPages; lpt; pass; phase

editHomeFlag = false
initTreeFlag = false
initLptFlag = true
debugFlag = false
justFixDirFlag = false

kbdKT; kbdCS
]

//-----------------------------------------------------------------------------------------
let IfsScavenger() be
//-----------------------------------------------------------------------------------------
[
Ws("IFS Scavenger of February 16, 1984")
Ws("*NStarted at "); WRITEUDT(dsp, 0, true)

kbdKT = CreateKeywordTable(13, 1)
InsertKeyword(kbdKT, "Debug")!0 = Debug
InsertKeyword(kbdKT, "DiskEditor")!0 = SetupDiskEditor
InsertKeyword(kbdKT, "DumpLPT")!0 = DumpLPT
InsertKeyword(kbdKT, "DumpTree")!0 = DumpTree
InsertKeyword(kbdKT, "EditHome")!0 = EditHome
InsertKeyword(kbdKT, "InitLPT")!0 = InitLPT
InsertKeyword(kbdKT, "InitTree")!0 = InitTree
InsertKeyword(kbdKT, "JustFixDir")!0 = JustFixDir
InsertKeyword(kbdKT, "Pass1")!0 = Pass1
InsertKeyword(kbdKT, "Pass2")!0 = SetupPass2
InsertKeyword(kbdKT, "Quit")!0 = Quit
InsertKeyword(kbdKT, "Scavenge")!0 = Scavenge
InsertKeyword(kbdKT, "Scratch")!0 = Scratch

   [
   kbdCS = InitCmd(500, 15) repeatuntil kbdCS ne 0
   Wss(kbdCS, "*N**")
   let kte = GetKeyword(kbdCS, kbdKT)
   Puts(kbdCS, $*S)
   (kte!0)()
   Closes(kbdCS)
   ] repeat
]

//-----------------------------------------------------------------------------------------
and Setup(Proc, numVPages) be
//-----------------------------------------------------------------------------------------
[
let buffPtr, numBuffs = nil, (numVMemBufs-numVPages) *4
   [
   buffPtr = SnarfBuffer(0, numBuffs); if buffPtr ne 0 break
   numBuffs = numBuffs -1
   if numBuffs eq 0 then IFSError(13)
   ] repeat
Proc(buffPtr, numBuffs)
]

// The 16 below is 4 open files (lpt + 3 sort files) + 12 pages for overlays
// The 12 pages for overlays is determined empirically
//-----------------------------------------------------------------------------------------
and SetupPass2() be Setup(Pass2, 16)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and SetupDiskEditor() be Setup(DiskEditor, 10)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and Scavenge() be
//-----------------------------------------------------------------------------------------
[
let quitFlag = false
let driveList = vec 7; SetBlock(driveList, -1, 8)
if Confirm(kbdCS, "*NAre all of the packs spinning? ") then
   [
   Wss(kbdCS, "*NHow many packs are there? ")
   let numPacks = GetNumber(kbdCS)
   if numPacks gr 8 then [ Wss(kbdCS, "*NToo many: 8 max"); return ]
      [
      let disk = OpenDisk("*NScan pack on drive ", 0, true, false)
      if disk ne 0 then
         [
         let driveNumber = disk>>DSK.driveNumber
         CloseDisk(disk)
         let duplicate, hole = false, -1
         for i = 0 to 7 do
            [
            if driveList!i eq driveNumber then duplicate = true
            if driveList!i eq -1 & hole eq -1 then hole = i
            ]
         test duplicate
            ifso Wss(kbdCS, "*NSame drive specified twice")
            ifnot
               [
               driveList!hole = driveNumber
               if hole+1 eq numPacks break
               ]
         ]
      ] repeat
   quitFlag = Confirm(kbdCS, "*NReturn to Exec if all goes well? ")
   ]
initLptFlag = true
let driveIndex = 0
let ok = valof
   [
   ok = Pass1(driveList!driveIndex)
   driveIndex = driveIndex +1
   unless ok resultis false  //something is wrong
   if ok eq 123456b resultis true  //all packs present and accounted for
   // ok should be -1 now, indicating success scanning that pack
   ] repeat
if ok then SetupPass2()
if quitFlag then Quit()
]

//-----------------------------------------------------------------------------------------
and Debug() be ToggleFlag(lv debugFlag)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and InitLPT() be ToggleFlag(lv initLptFlag)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and InitTree() be ToggleFlag(lv initTreeFlag)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and EditHome() be ToggleFlag(lv editHomeFlag)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and JustFixDir() be ToggleFlag(lv justFixDirFlag)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and Quit() be finish
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and ToggleFlag(lvFlag) be
//-----------------------------------------------------------------------------------------
// toggle a flag
[
lvFlag!0 = not lvFlag!0
Wss(kbdCS, lvFlag!0? "Yes", "No")
]

//-----------------------------------------------------------------------------------------
and Scratch(nil; numargs na) = valof
//-----------------------------------------------------------------------------------------
[
if scratchDisk ne 0 & scratchDisk ne sysDisk then
   CloseDisk(scratchDisk, true)
if na gr 0 then Ws("*NScratch ")
scratchDisk = OpenDisk("disk: ", true, false, true)
if scratchDisk eq 0 then Wss(kbdCS, " (Is the pack formatted?)")
resultis scratchDisk
]

//-----------------------------------------------------------------------------------------
and ScavNoBufsProc() be CallSwat("No VMem buffers")
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
let SplitPuts(st, item) be
//-----------------------------------------------------------------------------------------
// split stream operation for dsp
[
Puts(st>>ST.par1, item)
Puts(st>>ST.par2, item)
]

//-----------------------------------------------------------------------------------------
and LogErrors(st, ec, param) = valof
//-----------------------------------------------------------------------------------------
[
manifest
   [
   BFSDiskFull = 1102
   TFSDiskFull = 1402
   ]
if ec eq BFSDiskFull % ec eq TFSDiskFull then
   [
   Closes(dsp>>ST.par2)
   dsp>>ST.par2 = Allocate(sysZone, lST)
   SetBlock(dsp>>ST.par2, Noop, lST)
   Ws("*NDP0 is full - log file truncated*N")
   ReturnFrom(Puts)
   ]
SysErr(st, ec, param)
]

//-----------------------------------------------------------------------------------------
and ExtendFile(tfsName, maxPN, minPN) be
//-----------------------------------------------------------------------------------------
[
// Extends a file using the least possible number of page runs,
//  each as long as possible.
let ifp = vec lFP; Zero(ifp, lFP)
let pn, fa = -1, vec lFA
let ca = Allocate(sysZone, wordsPerPage); Zero(ca, wordsPerPage)
   [
   let holeSize = nil
   let holeVDA = DiskFindHole(scavDisk, maxPN-pn, lv holeSize)
   if holeVDA eq -1 test pn uls minPN
      ifso IFSError(ecFileSystemFull)
      ifnot break
   ReleaseDiskPage(scavDisk, AssignDiskPage(scavDisk, holeVDA-1))
   let st = nil; test pn eq -1
      ifso st = OpenFile(tfsName, 0, 0, 0, ifp, 0, 0, 0, scavDisk)
      ifnot
         [
         let DAs = vec 2
         DAs!0 = eofDA; DAs!1 = fillInDA; DAs!2 = eofDA
         WriteDiskPages(scavDisk, 0, DAs-pn, ifp, pn+1, pn+1, DCwriteLD, 0, bytesPerPage, ca)
         DAs!0 = fa>>FA.da
         WriteDiskPages(scavDisk, 0, DAs-pn, ifp, pn+1, pn+1, -1, 0, bytesPerPage, ca)
         DAs!0 = fillInDA; DAs!1 = fa>>FA.da; DAs!2 = fillInDA
         ActOnDiskPages(scavDisk, 0, DAs-pn+1, ifp, pn, pn, DCreadD, 0, 0, ca)
         DAs!2 = holeVDA
         WriteDiskPages(scavDisk, 0, DAs-pn+1, ifp, pn, pn, -1, 0, bytesPerPage, ca)
         st = CreateDiskStream(ifp, 0, 0, 0, 0, 0, 0, scavDisk)
         fa>>FA.da = holeVDA
         fa>>FA.pageNumber = pn+1
         fa>>FA.charPos = 0
         JumpToFa(st, fa)
         ]
   PositionPage(st, pn+holeSize)
   GetCurrentFa(st, fa)
   Closes(st)
   pn = fa>>FA.pageNumber
   ] repeatuntil pn eq maxPN
Free(sysZone, ca)
]