// IfsScav2-3.bcpl - Pass 2 Phase 3
// Copyright Xerox Corporation 1980, 1981, 1982, 1983
// Last modified June 16, 1983  8:25 PM by Boggs

get "IfsScavenger.decl"
get "IfsDirs.decl"
get "BTree.decl"
get "Disks.d"

external
[
// outgoing procedures
Pass2Phase3

// incoming procedures
Gets; Puts; Closes; Resets
OpenFile; CreateDiskStream; CreateDiskFile
FileLength; GetCurrentFa; WriteBlock; ExtendFile
Allocate; Free; IFSError; MoveBlock; Zero; ReadCalendar
DoubleDifference; DoubleIncrement; MultEq; Usc
InitializeContext; Block; Enqueue; Unqueue
CreateStringStream; CopyString; StringCompare
ReadLPTE; WriteLPTE; GetLptLpte
OpenLPT; EnumerateLPT; CloseLPT
GetLpteIfsName; GetLpteIfp; GetLpteFa; GetLpteDIFRec
SetLpteIfsName; SetLpteIfp; GetLpteFlags; GetLpteType
DirEntryLength; CompareRecords; Password
MapTree; UpdateRecord; DeleteKey
OpenFPTree; CloseIFSTree; FlushBuffers
Ws; Wss; PutTemplate; PrintTime

// incoming statics
keys; dsp; sysZone; ifsCtxQ
scavDisk; scratchDisk; tree; phase; lpt
initTreeFlag; debugFlag
]

static
[
treeDR; lptDR; difDR; dupLpt
giveMeATreeDR; leftoverLPTE; treeChanged
]

manifest
[
// error codes
ecMalformedLPTE = 508
ecUpdateRecord = 509
]

//-----------------------------------------------------------------------------------------
let Pass2Phase3() = valof
//-----------------------------------------------------------------------------------------
// This phase enumerates the directory and the leader page table in parallel.
// The LPT is the truth about what should be in the directory, so any
//  disagreements are resolved by changing the tree.
// The algorithm is:
//	lptDR > treeDR: delete treeDR, read next treeDR
//	lptDR = treeDR: read next lptDR, read next treeDR
//	lptDR < treeDR: insert lptDR, read next lptDR
[
phase = 3
Ws("*N[2-3]"); if debugFlag then Gets(keys)
if initTreeFlag & not debugFlag then
   Ws("*N[2-3] Initializing the directory B-Tree; only DIFs will be mentioned")

// open the tree and set up its reader process
let fpIfsDir = vec lFP; Zero(fpIfsDir, lFP)
let ifsDir = OpenFile("Ifs.dir", 0, 0, 0, fpIfsDir, 0, 0, 0, scavDisk)
if ifsDir eq 0 then IFSError(ecScavengeeFile, "Ifs.dir")
Closes(ifsDir)
tree = OpenFPTree(fpIfsDir, scavDisk, CompareRecords, DirEntryLength, false)
let treeMapper = InitializeContext(Allocate(sysZone, 1024), 1024, TreeMapper)
Enqueue(ifsCtxQ, treeMapper)
giveMeATreeDR, treeChanged = false, false

Resets(lpt)
dupLpt = 0
leftoverLPTE = false
lptDR = Allocate(sysZone, maxDRLength); Zero(lptDR, maxDRLength)
difDR = Allocate(sysZone, maxDRLength); Zero(difDR, maxDRLength)
treeDR = Allocate(sysZone, maxDRLength); Zero(treeDR, maxDRLength)
CopyString(lv treeDR>>DR.pathName, "<!>!1")

// Pass2Phase3 (cont'd)

let startTime = vec 1; ReadCalendar(startTime)
ReadNextLPTDR()
ReadNextTreeDR()
   [
   switchon valof
      [
      if treeDR>>DR.type eq 0 & lptDR>>DR.type eq 0 break  //all done
      if lptDR>>DR.type eq 0 resultis -1  //lpt ran out
      if treeDR>>DR.type eq 0 resultis 1  //tree ran out
      resultis CompareRecords(treeDR, lptDR)
      ] into
      [
      case -1:  //treeDR < lptDR
         [
         PutTemplate(dsp, "*N[2-3] Deleting tree entry *"$S*"",
          lv treeDR>>DR.pathName)
         DeleteKey(tree, treeDR)
         treeChanged = true
         ReadNextTreeDR()
         endcase
         ]
      case 0:  //treeDR = lptDR
         [
         let update = false
         test lptDR>>DR.type eq drTypeDIF
            ifso update = true
            ifnot
               [
               @lv treeDR>>DR.fp.unit = treeDR>>DR.fp.unit
               @lv lptDR>>DR.fp.unit = lptDR>>DR.fp.unit
               unless MultEq(lv treeDR>>DR.fp,lv lptDR>>DR.fp,lFP) do
                  [
                  PutTemplate(dsp, "*N[2-3] Updating tree entry *"$S*"",
                   lv lptDR>>DR.pathName)
                  update = true
                  ]
               ]
         if update then UpdateRecord(tree, lptDR, UpdateRecGen, lptDR)
         ReadNextTreeDR()
         ReadNextLPTDR()
         endcase
         ]
      case 1:  //treeDR > lptDR
         [
         if not initTreeFlag % lptDR>>DR.type eq drTypeDIF % debugFlag do
            PutTemplate(dsp, "*N[2-3] Inserting tree entry *"$S*"",
             lv lptDR>>DR.pathName)
         UpdateRecord(tree, lptDR, InsertRecGen, lptDR)
         ReadNextLPTDR()
         endcase
         ]
      ]
   ] repeat

// Pass2Phase3 (cont'd)

UpdateRecord(tree, difDR, UpdateRecGen, difDR)  //updates last dif
PrintTime(startTime)

if dupLpt ne 0 then
   [
   EnumerateLPT(dupLpt, AddDuplicates)
   dupLpt = CloseLPT(dupLpt, true)
   ]

// If the tree is more than 90% full, extend it by 50% if there is room.
let greatestPage = tree>>TREE.GreatestPage
tree = CloseIFSTree(tree)
let st = CreateDiskStream(fpIfsDir, 0, 0, 0, 0, 0, 0, scavDisk)
let fa = vec lFA; FileLength(st); GetCurrentFa(st, fa)
Closes(st)
if (fa>>FA.pageNumber/10)*9 ls greatestPage then
   ExtendFile(st, (fa>>FA.pageNumber/2)*3, 0)

// clean up and go away
Unqueue(ifsCtxQ, treeMapper)
Free(sysZone, treeMapper)
treeDR = Free(sysZone, treeDR)
lptDR = Free(sysZone, lptDR)
difDR = Free(sysZone, difDR)
FlushBuffers()
resultis true
]

//-----------------------------------------------------------------------------------------
and AddDuplicates(lpt, lpte, nil) be
//-----------------------------------------------------------------------------------------
[
let drName = lv lptDR>>DR.pathName
let ss = CreateStringStream(drName, maxPathNameChars)
let ifp = GetLpteIfp(lpte)
PutTemplate(ss, "<System>Duplicate>VDA$EUO", lv ifp>>IFP.da)
let ifsName = GetLpteIfsName(lpte)
for i = 1 to ifsName>>String.length do
   [
   if drName>>String.length ge maxPathNameChars break
   // turn directory punctuation into harmless dashes
   let char = ifsName>>String.char↑i
   if char eq $> % char eq $< then char = $-
   Puts(ss, char)
   ]
Closes(ss)
PutTemplate(dsp, "*N[2-3] Inserting duplicate file *"$S*"", drName)
MoveBlock(lv lptDR>>DR.fp, ifp, lFP)
lptDR>>DR.type = drTypeNormal
lptDR>>DR.length = lenDRHeader + lptDR>>DR.pathName.length rshift 1 +1
UpdateRecord(tree, lptDR, InsertRecGen, lptDR)
]

//-----------------------------------------------------------------------------------------
and InsertRecGen(dr, newDR) = valof
//-----------------------------------------------------------------------------------------
// This record generator is passed to UpdateRecord when inserting a record
[
treeChanged = true

test dr ne 0  //two files with the same name?
   ifso
      [
      if dupLpt eq 0 then
         dupLpt = OpenLPT("IfsScavenger.dupLpt", true)
      let lpte = GetLptLpte(dupLpt, true)
      SetLpteIfsName(lpte, lv newDR>>DR.pathName)
      SetLpteIfp(lpte, lv newDR>>DR.fp)
      WriteLPTE(dupLpt)
      ]
   ifnot
      [
      dr = Allocate(sysZone, newDR>>DR.length)
      MoveBlock(dr, newDR, newDR>>DR.length)
      ]

resultis dr
]

//-----------------------------------------------------------------------------------------
and UpdateRecGen(dr, newDR) = valof
//-----------------------------------------------------------------------------------------
// This record generator is passed to UpdateRecord when updating a record
[
treeChanged = true
if dr eq 0 then IFSError(ecUpdateRecord)
Free(sysZone,dr)
dr = Allocate(sysZone, newDR>>DR.length)
MoveBlock(dr, newDR, newDR>>DR.length)
resultis dr
]

//-----------------------------------------------------------------------------------------
and TreeMapper() be  //a context used as a coroutine
//-----------------------------------------------------------------------------------------
[
Block() repeatuntil giveMeATreeDR  //wait for a request
if MapTree(tree, treeDR, MapTreeFunction, 0, 0, true) then
   [  //ran off the end of the tree
   treeDR>>DR.type = 0
   giveMeATreeDR = false  //request satisfied
   Block() repeatuntil giveMeATreeDR  //wait for a request
   ] repeat
] repeat

//-----------------------------------------------------------------------------------------
and MapTreeFunction(dr, nil, nil) = valof
//-----------------------------------------------------------------------------------------
[
if treeChanged then
   if CompareRecords(dr, treeDR) le 0 resultis true  //we want the next one
treeChanged = false
MoveBlock(treeDR, dr, dr>>DR.length)
giveMeATreeDR = false  //request satisfied
Block() repeatuntil giveMeATreeDR  //wait for a request
resultis not treeChanged  //return true unless our partner modifed tree
]

//-----------------------------------------------------------------------------------------
and ReadNextTreeDR() be
//-----------------------------------------------------------------------------------------
// Pokes the B-Tree process for the next record.
[
giveMeATreeDR = true  //make a request
Block() repeatwhile giveMeATreeDR  //wait for it to be satisfied
]

//-----------------------------------------------------------------------------------------
and ReadNextLPTDR() be
//-----------------------------------------------------------------------------------------
// Manufactures a directory record from the next leader page table entry.
[
let lpte = GetLptLpte(lpt)
   [
   unless leftoverLPTE do unless ReadLPTE(lpt) do
      [ lptDR>>DR.type = 0; return ]  //no more LPTEs
   if GetLpteType(lpte) eq dvTypeFile break
   ] repeat

let dirEnd = 1
let ifsName = GetLpteIfsName(lpte)
for i = 1 to ifsName>>String.length do
   if ifsName>>String.char↑i eq $> then [ dirEnd = i; break ]
if dirEnd eq 1 then IFSError(ecMalformedLPTE)
test StringCompare(ifsName, lv difDR>>DR.pathName, 1, dirEnd) eq -2
   ifso  //This file is in the same directory as the last file
      [
      CopyString(lv lptDR>>DR.pathName, ifsName)
      MoveBlock(lv lptDR>>DR.fp, GetLpteIfp(lpte), lFP)
      lptDR>>DR.type = drTypeNormal
      lptDR>>DR.length = lenDRHeader + lptDR>>DR.pathName.length rshift 1 +1
      DoubleIncrement(lv (DIFRecFromDR(difDR)>>DIFRec.diskPageUsage),
       GetLpteFa(lpte)>>FA.pageNumber +1)
      leftoverLPTE = false
      ]
   ifnot  //New directory
      [
      if difDR>>DR.type eq drTypeDIF then  //every time except the first
         UpdateRecord(tree, difDR, UpdateRecGen, difDR)
      let difRec = difDR + lenDRHeader
      let pathName = lv difDR>>DR.pathName
      Zero(difDR, maxDRLength)
      test (GetLpteFlags(lpte) & lfDIF) ne 0
         ifso  //This is the new directory's DIF.
            [
            CopyString(pathName, ifsName)
            MoveBlock(lv difDR>>DR.fp, GetLpteIfp(lpte), lFP)
            difRec = difRec + pathName>>String.length rshift 1 +1
            MoveBlock(difRec, GetLpteDIFRec(lpte), lenDIFRec)
            Zero(lv difRec>>DIFRec.diskPageUsage, 2)
            leftoverLPTE = false
            ]

// ReadNextLPTDR (cont'd)

         ifnot  //New directory's DIF seems to be missing.
            [
            // manufacture the DIF filename
            let s = CreateStringStream(pathName, maxPathNameChars)
            for i = 1 to dirEnd do Puts(s, ifsName>>String.char↑i)
            Wss(s, "!1")
            Closes(s)

            // create the Directory Information File
            PutTemplate(dsp, "*N[2-3] Creating *"$S*"", pathName)
            let pageLength = 1 lshift scavDisk>>DSK.lnPageSize
            let ld = Allocate(sysZone, pageLength); Zero(ld, pageLength)
            CopyString(lv ld>>ILD.pathName, pathName)
            CopyString(lv ld>>ILD.author, "System")
            ld>>ILD.readProt.owner = true
            ld>>ILD.type = ftBinary
            ld>>ILD.byteSize = 8
            ld>>ILD.undeletable = true
            CreateDiskFile(scavDisk, pathName, lv difDR>>DR.fp, 0, 0, 0, ld)
            Free(sysZone, ld)
            difDR>>DR.fp.unit = 0

            // fill the dif with vanilla things
            let dif = vec lenDIF; Zero(dif, lenDIF)
            Password("ifs", lv dif>>DIF.password, true)
            dif>>DIF.diskPageLimit↑1 = 1000
            dif>>DIF.createProt.owner = true
            dif>>DIF.connectProt.owner = true
            dif>>DIF.readProt.owner = true
            dif>>DIF.readProt.world = true
            dif>>DIF.writeProt.owner = true
            dif>>DIF.appendProt.owner = true
            let s = CreateDiskStream(lv difDR>>DR.fp, 0, 0, 0, 0, 0, 0, scavDisk)
            if s eq 0 then IFSError(ecCreateDiskStream, pathName)
            WriteBlock(s, dif, lenDIF)
            Closes(s)
            difRec = difRec + pathName>>String.length rshift 1 +1
            MoveBlock(difRec, dif, lenDIFRec)
            leftoverLPTE = true
            ]

      difDR>>DR.type = drTypeDIF
      difDR>>DR.length = lenDRHeader + lenDIFRec +
       difDR>>DR.pathName.length rshift 1 +1
      difRec>>DIFRec.diskPageUsage↑1 = 2
      MoveBlock(lptDR, difDR, difDR>>DR.length)
      ]
]

//-----------------------------------------------------------------------------------------
and DIFRecFromDR(dr) = valof
//-----------------------------------------------------------------------------------------
[
// returns pointer to the DIFRec portion of a directory entry
if dr>>DR.type ne drTypeDIF then IFSError(ecNotDIFRec)
resultis dr + dr>>DR.length - lenDIFRec
]