// IfsScav1-5.bcpl - Pass 1 Phase 5
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 27, 1982  5:36 PM by Boggs

get "CmdScan.decl"
get "IfsScavenger.decl"
get "Ifs.decl"
get "Disks.d"

external
[
// outgoing procedures
Pass1Phase5

// incoming procedures
DeleteDiskPages; ReadLeaderPage; WriteLeaderPage; LnPageSize
OpenFile; CreateDiskStream; ReadBlock; WriteBlock; GetCurrentFa
Gets; Puts; Closes; Errors; Resets; ExtendFile
Allocate; Free; IFSError
Zero; MoveBlock; ReadCalendar; Enqueue; MultEq
WriteLPTE; EnumerateLPT; GetLptLpte; GetLptFs; GetLptHome
GetLpteTfsName; GetLpteIfsName; GetLpteIfp; GetLpteType
SetLpteTfsName; SetLpteIfsName; SetLpteIfp; SetLpteType
GetLpteFa; GetLpteFlags; SetLpteDIFRec
CreateStringStream; CopyString; StringCompare
CreateKeywordTable; DestroyKeywordTable
EnumerateKeywordTable; InsertKeyword
InitCmd; GetString; GetKeyword; GetNumber; Confirm
DefaultPhrase; BeginDefaultPhrase; EndDefaultPhrase
CmdError; BackupPhrase
PutTemplate; Ws; Wss; Wns; WRITEUDT; UNPACKDT

// incoming statics
keys; dsp; sysZone
phase; wordsPerPage; scavDisk; lpt
editHomeFlag; initLptFlag; debugFlag; justFixDirFlag
]

static [ sft; home ]

structure SFTE:		// Special File Table Entry
[
name word		// -> string
minLength word		// minimum reasonable length in pages
normLength word		// length in pages if it must be created
flags word =
   [
   unitZeroOnly bit	// file is special on unit 0 only
   primaryOnly bit	// file is special on primary fs only
   includesUnit bit	// name includes unit: "<system>name.unit!1"
   mustExist bit	// if this doesn't exist by now, its a scavenger bug
   foundit bit		// checkLPT found an lpte for this one
   readWorld bit	// value of readProt.world
   blank bit 8
   type bit 2		// ftText, ftBinary  MUST BE LSBs
   ]
]

manifest
[
numSFTE = 7
unitZeroOnly = 1b15 rshift (offset SFTE.unitZeroOnly rem 16)
primaryOnly = 1b15 rshift (offset SFTE.primaryOnly rem 16)
includesUnit = 1b15 rshift (offset SFTE.includesUnit rem 16)
mustExist = 1b15 rshift (offset SFTE.mustExist rem 16)
readWorld = 1b15 rshift (offset SFTE.readWorld rem 16)
]

structure SFT: [ SFTE↑1,numSFTE:@SFTE ]
manifest lenSFT = size SFT/16

//----------------------------------------------------------------------------
let Pass1Phase5(fsAndDrive) = valof
//----------------------------------------------------------------------------
// This phase is not executed unless the pack is part of an IFS.
// It verifies Ifs.home, sets the unit number in the IFPs of all
//  lpt entries for this pack, and verifies the existance (although
//  not necessarily the contents) of the critical system files.
[
phase = 5
Ws("*N[1-5]"); if debugFlag then Gets(keys)

let ifsHome = OpenFile("Ifs.home", 0, 0, verLatest, 0, 0, 0, 0, scavDisk)
if ifsHome eq 0 then  //It didn't exist.  Create and enter it in lpt.
   [
   Ws("*N[1-5] Creating Ifs.home")
   let fpIfsHome = vec lFP; Zero(fpIfsHome, lFP)
   ifsHome = OpenFile("Ifs.home", 0, 0, verLatestCreate, fpIfsHome, 0, 0, 0, scavDisk)
   if ifsHome eq 0 then IFSError(ecScavengeeFile, "Ifs.home")

   // enter newly created file into lpt
   let lpte = GetLptLpte(lpt, true)
   SetLpteTfsName(lpte, "Ifs.home.")
   SetLpteIfp(lpte, fpIfsHome)
   WriteLPTE(lpt)
   ]

home = Allocate(sysZone, lenHome)
let lptHome = GetLptHome(lpt)
let cs = nil
cs = InitCmd(256, 10) repeatuntil cs ne 0
if ReadBlock(ifsHome, home, lenHome) ne lenHome then
   [
   Wss(cs, "*N[1-5] Malformed home block")
   Zero(home, lenHome)
   ReadCalendar(lv home>>Home.created)
   editHomeFlag = true
   ]
test MultEq(lv lptHome>>Home.created, table [ 0; 0 ])
   ifnot  //already locked onto a file system
      [
      unless MultEq(lv lptHome>>Home.created, lv home>>Home.created) do
         unless Confirm(cs, "*N[1-5] Are you sure this pack belongs to the same file system as the last pack?") do
            [  //bail out
            Closes(ifsHome)
            Closes(cs)
            resultis false
            ]
      let savedUnit = home>>Home.thisUnit
      MoveBlock(home, lptHome, lenHome)
      home>>Home.thisUnit = savedUnit
      ]

// Pass1Phase5 (cont'd)

   ifso  //this is the first home block we have procesed
      [
      // Home.type
      Wss(cs, "*N[1-5] File system type: ")
      let typeKT = CreateKeywordTable(2, 1)
      InsertKeyword(typeKT, "Primary")!0 = ifsTypePrimary
      InsertKeyword(typeKT, "Backup")!0 = ifsTypeBackup
      EnumerateKeywordTable(typeKT, PrintDefaultType, cs)
      home>>Home.type = GetKeyword(cs, typeKT)!0
      DestroyKeywordTable(typeKT)

      // Home.id
      Wss(cs, "*N[1-5] File system ID: ")
      if home>>Home.type eq ifsTypePrimary then
         CopyString(lv home>>Home.id, "Primary")
      DefaultPhrase(cs, lv home>>Home.id, (editHomeFlag? 0, $*N))
      let fsID = GetString(cs)
      CopyString(lv home>>Home.id, fsID)
      Free(sysZone, fsID)

      // Home.name
      Wss(cs, "*N[1-5] File system name: ")
      DefaultPhrase(cs, lv home>>Home.name, (editHomeFlag? 0, $*N))
      let fsName = GetString(cs, BreakCr)
      CopyString(lv home>>Home.name, fsName)
      Free(sysZone, fsName)

      // Home.numUnits
      Wss(cs, "*N[1-5] Number of units: ")
      if home>>Home.numUnits ne 0 then
         [
         BeginDefaultPhrase(cs)
         Wns(cs, home>>Home.numUnits)
         EndDefaultPhrase(cs, (editHomeFlag? 0, $*N))
         ]
      home>>Home.numUnits = GetNumber(cs)

      // Home.created
      Ws("*N[1-5] Created ")
      let utv = vec 10
      UNPACKDT(lv home>>Home.created, utv)
      WRITEUDT(cs, utv, true)
      ]

// Home.thisUnit
Wss(cs, "*N[1-5] Logical unit number: ")
BeginDefaultPhrase(cs)
Wns(cs, home>>Home.thisUnit)
EndDefaultPhrase(cs, (editHomeFlag? 0, $*N))
home>>Home.thisUnit = GetNumber(cs)
if GetLptFs(lpt)!(home>>Home.thisUnit) ne -1 then
   [ CmdError(cs, " already used"); BackupPhrase(cs) ]
GetLptFs(lpt)!(home>>Home.thisUnit) = fsAndDrive

if editHomeFlag then
   unless Confirm(cs) do
      Errors(cs, ecCmdDelete)
Closes(cs)

// done messing with home blocks; yech, ack, fooey!
if MultEq(lv lptHome>>Home.created, table [ 0; 0 ]) then
   MoveBlock(lptHome, home, lenHome)
Resets(ifsHome)
WriteBlock(ifsHome, home, lenHome)
Closes(ifsHome)

// Pass1Phase5 (cont'd)

unless justFixDirFlag do
   [
   // Now verify the existance of the critical system files and
   //  set the unit number (which we just discovered) in all lpt entries.
   Ws("*N[1-5] LPT"); if debugFlag then Gets(keys)

   let v = vec lenSFT; sft = v; Zero(sft, lenSFT)
   InsertSFTE(1, "SysDir.", 0, 0,
    includesUnit+mustExist+ftBinary)
   InsertSFTE(2, "DiskDescriptor.", 0, 0,
    includesUnit+mustExist+ftBinary)
   InsertSFTE(3, "Ifs.Home.", 0, 0,
    includesUnit+mustExist+ftBinary)
   InsertSFTE(4, "Ifs.Swap.", ifsSwapPages, ifsSwapPages,
    unitZeroOnly+primaryOnly+ftBinary)
   InsertSFTE(5, "Ifs.Dir.", 500, 500*lptHome>>Home.numUnits,
    unitZeroOnly+primaryOnly+ftBinary)
   InsertSFTE(6, "Ifs.Syms.", 2, ifsSymsPages,
    unitZeroOnly+primaryOnly+ftBinary+readWorld)
   InsertSFTE(7, "Ifs.Errors.", 2, ifsErrorPages,
    unitZeroOnly+primaryOnly+ftText+readWorld)
   ]

EnumerateLPT(lpt, CheckLPT)

unless justFixDirFlag do
   [
   Ws("*N[1-5] SFT"); if debugFlag then Gets(keys)
   for i = 1 to numSFTE do
      [
      let sfte = lv sft>>SFT.SFTE↑i
      if sfte>>SFTE.foundit %
       (home>>Home.thisUnit ne 0 & sfte>>SFTE.unitZeroOnly) %
       (home>>Home.type ne ifsTypePrimary & sfte>>SFTE.primaryOnly) loop

      let tfsName = sfte>>SFTE.name
      if sfte>>SFTE.mustExist then  //Bug.  It should exist by now
         IFSError(ecScavengeeFile, tfsName)
      PutTemplate(dsp, "*N[1-5] Creating special file *"$S*"", tfsName)
      ExtendFile(tfsName, sfte>>SFTE.normLength, sfte>>SFTE.minLength)
      let ifp = vec lFP; Zero(ifp, lFP)
      let sf = OpenFile(tfsName, ksTypeReadOnly, 0, 0, ifp, 0, 0, 0, scavDisk)
      let ifsName = vec lenPathName; MakeIFSName(ifsName, tfsName,
       (sfte>>SFTE.includesUnit? home>>Home.thisUnit, -1))
      SetLeaderPage(sf, ifsName, sfte)
      Closes(sf)

      // add newly created file to lpt
      let lpte = GetLptLpte(lpt, true)
      SetLpteIfsName(lpte, ifsName)
      SetLpteTfsName(lpte, tfsName)
      ifp>>IFP.unit = home>>Home.thisUnit
      SetLpteIfp(lpte, ifp)
      WriteLPTE(lpt)
      ]
   ]

initLptFlag = false
Free(sysZone, home)
let fs = GetLptFs(lpt)
let numUnits = 0
for i = 0 to nDisks-1 do
   if fs!i ne -1 then numUnits = numUnits +1
resultis numUnits eq lptHome>>Home.numUnits? 123456b, -1
]

//----------------------------------------------------------------------------
and CheckLPT(l, lpte, nil) be
//----------------------------------------------------------------------------
[
if GetLpteType(lpte) ne dvTypeFile return

let ifp = GetLpteIfp(lpte)
ifp>>IFP.unit = home>>Home.thisUnit
SetLpteIfp(lpte, ifp)  //just marks it dirty

let tfsName = GetLpteTfsName(lpte)
let ifsName = vec lenPathName
CopyString(ifsName, GetLpteIfsName(lpte))

test (GetLpteFlags(lpte) & lfDIF) ne 0
   ifso
      [
      let s = CreateDiskStream(ifp, 0, 0, 0, 0, 0, 0, scavDisk)
      if s eq 0 then IFSError(ecScavengeeFile, ifsName)
      let dif = vec lenDIF
      let ok = ReadBlock(s, dif, lenDIF) ge minLenDIF
      Closes(s)
      test ok
         ifso SetLpteDIFRec(lpte, dif)
         ifnot
            [
            PutTemplate(dsp, "*N[1-5] Deleting malformed DIF *"$S*"", ifsName)
            let ca = Allocate(sysZone, wordsPerPage)
            DeleteDiskPages(scavDisk, ca, ifp>>IFP.page, ifp, 0)
            Free(sysZone, ca)
            SetLpteType(lpte, dvTypeFree)
            ]
      ]
   ifnot unless justFixDirFlag for i = 1 to numSFTE do
      if StringCompare(tfsName, sft>>SFT.SFTE↑i.name) eq 0 then
         [
         let sfte = lv sft>>SFT.SFTE↑i
         if (sfte>>SFTE.unitZeroOnly & home>>Home.thisUnit ne 0) %
          (sfte>>SFTE.primaryOnly & home>>Home.type ne ifsTypePrimary) loop
         sfte>>SFTE.foundit = true
         // Remanufacture ifsName to be sure currect unit # is installed.
         MakeIFSName(ifsName, tfsName,
          (sfte>>SFTE.includesUnit? home>>Home.thisUnit,-1))
         SetLpteIfsName(lpte, ifsName)
         // If the file is shorter than reasonable, lengthen it
         if sfte>>SFTE.minLength ne 0 &
          GetLpteFa(lpte)>>FA.pageNumber uls sfte>>SFTE.minLength then
            [
            PutTemplate(dsp, "*N[1-5] Extending special file *"$S*"", tfsName)
            ExtendFile(tfsName, sfte>>SFTE.normLength, sfte>>SFTE.minLength)
            ]
         let sf = CreateDiskStream(ifp, 0, 0, 0, 0, 0, 0, scavDisk)
         SetLeaderPage(sf, ifsName, sfte)
         Closes(sf)
         break
         ]
]

//----------------------------------------------------------------------------
and PrintDefaultType(kte, kt, key, cs) be
//----------------------------------------------------------------------------
   if kte!0 eq home>>Home.type then
      DefaultPhrase(cs, key, editHomeFlag? 0, $*N)

//----------------------------------------------------------------------------
and BreakCr(cs, char) = char eq $*N
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and InsertSFTE(index, name, minLen, normLen, flags, type; numargs na) be
//----------------------------------------------------------------------------
[
sft>>SFT.SFTE↑index.name = name
sft>>SFT.SFTE↑index.minLength = minLen
sft>>SFT.SFTE↑index.normLength = normLen
sft>>SFT.SFTE↑index.flags = flags
]

//---------------------------------------------------------------------------
and MakeIFSName(ifsName, tfsName, unit) be
//---------------------------------------------------------------------------
[
let s = CreateStringStream(ifsName, maxPathNameChars)
Wss(s, "<System>")
for i = 1 to tfsName>>String.length-1 do Puts(s, tfsName>>String.char↑i)
PutTemplate(s, (unit ge 0? ".$O!1", "!1"), unit)
Closes(s)
]

//----------------------------------------------------------------------------
and SetLeaderPage(stream, ifsName, sfte) be
//----------------------------------------------------------------------------
// sets up the IFS part of leader pages for critical system files
[
let pageLength = 1 lshift LnPageSize(stream)
let ld = Allocate(sysZone, pageLength)
ReadLeaderPage(stream, ld)
manifest lLD = offset ILD.pathName/16
Zero(ld+lLD, pageLength-lLD)
CopyString(lv ld>>ILD.pathName, ifsName)
ld>>ILD.readProt.owner = true  //owner can read
ld>>ILD.readProt.world = sfte>>SFTE.readWorld
CopyString(lv ld>>ILD.author, "System")
ld>>ILD.type = sfte>>SFTE.type
ld>>ILD.byteSize = 8
ld>>ILD.undeletable = true
ld>>ILD.noBackup = true
WriteLeaderPage(stream, ld)
Free(sysZone, ld)
]