// IfsScav1-1.bcpl - Pass 1 Phase 1
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified April 27, 1981  1:17 PM by Boggs

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

external
[
// outgoing procedures
Pass1Phase1

// incoming procedures
VirtualDiskDA; ActOnDiskPages
InitializeDiskCBZ; DoDiskCommand; GetDiskCb
Closes; Gets; Allocate; Free; Enqueue; Dequeue
CreateStringStream; CopyString
LockCell; UnlockCell; PVWR; FlushBuffers
ParseFD; WriteLPTE; GetLptLpte; SetLpteIfsName; SetLpteTfsName
SetLpteIfp; SetLpteFa; SetLpteFlags; SetLpteDIFRec
MoveBlock; SetBlock; Zero; Usc; MultEq
IFSIdle; IFSError; SysErr; Block
PrintRealDA; PrintTime; PrintDiskError
PutTemplate; Ws; ReadCalendar

// incoming statics
scratchDisk; scavDisk; sysDisk; numFiles; phase
dsp; keys; sysZone; freePageFid
debugFlag; ifsPackFlag; justFixDirFlag; bpl; plme; lpt
maxVDA; wordsPerPage; bytesPerPage
]

static [ freeQ; cmdQ ]

manifest
[
numCBs = 6  //this many page sized buffers will be allocated too

ecCmdQ = 501
ecFreeQEmpty = 510

snIncorr = -2
]

structure P1B:		// Phase 1 Buffer
[
link word		// -> next P1B or zero if last
cb word			// -> CB
vda word		// TFS virtual disk address
label word = @DL	// TFS label record
data word		// -> data buffer
]
manifest lenP1B = size P1B/16

//-----------------------------------------------------------------------------------------
let Pass1Phase1() = valof
//-----------------------------------------------------------------------------------------
// Phase 1 never writes on the Scavengee.
// It scans the pack and makes a PLM entry per page.
// When a leader page is encountered, an LPT entry is made.
// It takes 3.3 minutes to scan a T-80 writing only PLM entries.
// As the number of files increases, the number of LPT entries
//  increases and this number will grow.
[
phase = 1
Ws("*N[1-1]"); if debugFlag then Gets(keys)

// disk control block zone
let lenCBZ = scavDisk>>DSK.lengthCBZ + numCBs*scavDisk>>DSK.lengthCB
let cbz = Allocate(sysZone, lenCBZ)

unless justFixDirFlag do
   [
   // Read bad page list.  Can't use ActOnPages because
   //   we want REAL da 0, not just vda 0 for scavDisk.
   InitializeDiskCBZ(scavDisk, cbz, 0, lenCBZ, readBplRetry, lv ReadBplError)
   readBplRetry:  //<-------------===   *****
   let fpBPL = vec lFP; Zero(fpBPL, lFP)
   let cb = GetDiskCb(scavDisk, cbz)
   DoDiskCommand(scavDisk, cb, bpl, fillInDA, fpBPL, 0, DCreadD)
   while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(scavDisk, cbz)
   unless bpl>>BPL.seal eq bplSeal do
      [
      Ws("*N[1-1] Initializing the bad page list")
      Zero(bpl, wordsPerPage)
      bpl>>BPL.seal = bplSeal
      ]
   ]

// phase 1 buffer pool
let queues = vec 4; Zero(queues, 4)
freeQ = queues; cmdQ = queues+2
for i = 1 to numCBs do
   [
   let p1b = Allocate(sysZone, lenP1B)
   // wordsPerPage has the ganularity of the vMem page size.
   // So P1B.data is made out of snarfed vMem pages.
   p1b>>P1B.data = Allocate(sysZone, wordsPerPage)
   Enqueue(freeQ, p1b)
   ]

// Pass1Phase1 (cont'd)

// scan all pages in file system
plme = 0; unless justFixDirFlag do LockCell(lv plme)
let startTime = vec 1; ReadCalendar(startTime)
let curVDA = 0
numFiles = 0
InitializeDiskCBZ(scavDisk, cbz, 0, lenCBZ, Phase1Retry, lv Phase1Error)
cbz>>CBZ.cleanupRoutine = Phase1Cleanup

if false then
   [
   Phase1Retry:  //flush pending commands, restart at DA in error
   curVDA = (cmdQ!0)>>P1B.vda
   while cmdQ!0 ne 0 do Enqueue(freeQ, Dequeue(cmdQ))
   if debugFlag then PutTemplate(dsp, "*N[1-1] Soft read error at vda $UO", curVDA)
   ]

   [  //main loop
   let cb = GetDiskCb(scavDisk, cbz)
   let p1b = Dequeue(freeQ)
   if p1b eq 0 then IFSError(ecFreeQEmpty)
   p1b>>P1B.cb = cb
   p1b>>P1B.vda = curVDA
   cb>>CB.AddrL = lv p1b>>P1B.label
   Enqueue(cmdQ, p1b)
   DoDiskCommand(scavDisk, cb, p1b>>P1B.data, curVDA, 0, 0, DCreadLD)
   curVDA = curVDA +1
   ] repeatuntil Usc(curVDA, maxVDA) gr 0

while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(scavDisk, cbz)
PrintTime(startTime)
PutTemplate(dsp, "*N[1-1] Files = $UD", numFiles)

// destroy buffer pool
while freeQ!0 ne 0 do
   [
   let p1b = Dequeue(freeQ)
   Free(sysZone, p1b>>P1B.data)
   Free(sysZone, p1b)
   ]

// destroy control block zone
Free(sysZone, cbz)

// clean up and go away
unless justFixDirFlag do
   [
   UnlockCell(lv plme)
   FlushBuffers()
   ]
resultis true
]

//-----------------------------------------------------------------------------------------
and ReadBplError(nil, cb, errorCode) be
//-----------------------------------------------------------------------------------------
[
test errorCode eq ecUnRecovDiskError
   ifso PrintDiskError(cb)
   ifnot SysErr(0, errorCode, cb)
bpl>>BPL.seal = 0
]

//-----------------------------------------------------------------------------------------
and Phase1Cleanup(scavDisk, cb) be
//-----------------------------------------------------------------------------------------
// This is where the work gets done in phase 1.
// This procedure is called for each page.
[
let p1b = Dequeue(cmdQ)  //buffer and cb better match
if p1b>>P1B.cb ne cb then IFSError(ecCmdQ)
let vda = p1b>>P1B.vda

let v = vec lenPLME
plme = justFixDirFlag? v, PVWR(vda)
Zero(plme, lenPLME)
MoveBlock(lv plme>>PLME.fileId, lv p1b>>P1B.fileId, lFID)

// free, good, bad, or incorrigable page?
plme>>PLME.type = ptGood

// Is it a free page?
if MultEq(lv plme>>PLME.fileId, freePageFid, lFID) then
   plme>>PLME.type = ptFree

// Is it an incorrigable page?
// Pages that give hard read errors look incorrigable by here
if not justFixDirFlag & MultEq(lv plme>>PLME.fileId,
 table [ snIncorr; snIncorr; snIncorr ], lFID) then
   [
   plme>>PLME.type = ptIncorr
   plme>>PLME.rewrite = true  //always rewrite incorrigable labels
   let lvRealDA = lv cb>>CB.diskAddress
   if debugFlag then
      PutTemplate(dsp, "*N[1-1] incorrigable page at vda $UO ($P)",
       vda, PrintRealDA, lvRealDA)

   // check for duplicate bad page list entry
   let numEntries, found = bpl>>BPL.nBadPages, false
   for i = 0 to numEntries-1 do
      if MultEq(lvRealDA, lv bpl>>BPL.da↑i) then  //already listed
         [ found = true; break ]

   // check for bad page list overflow
   unless found test (numEntries+1)*2 ge wordsPerPage
      ifso
         [
         Ws("*N[1-1] The bad page list overflowed.  ")
         PutTemplate(dsp, "An entry for $P was discarded.",
          PrintRealDA, lvRealDA)
         ]
      ifnot
         [  //append the bad page to the list
         MoveBlock(lv bpl>>BPL.da↑numEntries, lvRealDA, 2)
         bpl>>BPL.nBadPages = numEntries +1
         ]
   ]

// It's not free, and it's not incorrigable
if plme>>PLME.type eq ptGood then
   [
   plme>>PLME.pn = p1b>>P1B.pageNumber
   plme>>PLME.numChars = p1b>>P1B.numChars
   plme>>PLME.nextP = VirtualDiskDA(scavDisk, lv p1b>>P1B.next)
   plme>>PLME.backP = VirtualDiskDA(scavDisk, lv p1b>>P1B.previous)

   // check backP and nextP
   if plme>>PLME.nextP eq fillInDA then
      [
      PutTemplate(dsp, "*N[1-1] page at VDA $UO has illegal next link of $P",
       vda, PrintRealDA, lv p1b>>P1B.next)
      plme>>PLME.type = ptBad
      ]
   if plme>>PLME.backP eq fillInDA then
      [
      PutTemplate(dsp, "*N[1-1] page at VDA $UO has illegal back link of $P",
       vda, PrintRealDA, lv p1b>>P1B.previous)
      plme>>PLME.type = ptBad
      ]
   ]

// Pass1Phase1 (cont'd)

// If it survived, see if it is a leader page
// Leader pages:
//  have label back pointers of eofDA and
//  have page numbers of zero and
//  are completely full and
//  are not bad, free or incorrigable and
//  are not vda 0 which is extra special.
if plme>>PLME.backP eq eofDA & plme>>PLME.pn eq 0 &
 plme>>PLME.numChars eq bytesPerPage &
 plme>>PLME.type eq ptGood & vda ne 0 then
   [leaderPage
   numFiles = numFiles +1
   let ld = p1b>>P1B.data
   let lpteFlags = 0

   // leader page (file) FP
   let ifp = vec lFP; Zero(ifp, lFP)
   MoveBlock(lv ifp>>IFP.serialNumber, lv p1b>>P1B.fileId, lFID)
   ifp>>IFP.page = cb>>CB.vDiskAddress

   // check syntax of IFS path name
   let ifsName = 0
   if ifsPackFlag then
      [
      ifsName = lv ld>>ILD.pathName
      let fd = vec lenFD; Zero(fd, lenFD)
      fd>>FD.lc = lcVHighest
      let dr = vec (lenDRHeader+128)  //why screw around ?
      fd>>FD.dr = dr
      CopyString(lv dr>>DR.pathName, ifsName)
      let ifsNameOK = true
      // Run ifsName through ParseFD so that the Scavenger
      //  uses exactly the same legality checks.
      test ParseFD(fd) eq 0
         ifnot ifsNameOK = false  //prima facie evidence that it is bad
         ifso test fd>>FD.lc.vc eq lcVExplicit
            ifnot ifsNameOK = false  //must have a version number
            ifso if (fd>>FD.lenBodyString-fd>>FD.lenDirString) eq 1 &
             fd>>FD.version eq 1 then  //"<string>!1" is a DIF filename
               lpteFlags = lpteFlags % lfDIF

      unless ifsNameOK do
         [
         PutTemplate(dsp, "*N[1-1] *"$S*" is not a legal IFS name.", ifsName)
         // Manufacture a name and mark the lpte so that the new name
         //  is rewritten into the leader page during a later phase.
         let ss = CreateStringStream(ifsName, maxPathNameChars)
         PutTemplate(ss, "<System>Anonymous>SN$EUO.scavenger!1",
          lv p1b>>P1B.fileId)
         Closes(ss)
         PutTemplate(dsp, "  I renamed it *"$S*"", ifsName)
         lpteFlags = lpteFlags % lfRewrite
         ]
      ]

   // Pass1Phase1 (cont'd)

   // Check syntax of Alto file system name.
   // IFS files have the first 39 chars of the Ifs name in the Alto
   //  name area.  Ifs names always begin with a directory so these files
   //  will have $< as their first character.  If this pack is not
   //  part of an Ifs, or the first char is not $<, then it belongs in
   //  the Alto filesystem directory (sysdir), so check it for legality.
   let tfsName = 0
   if (lv ld>>LD.name)>>String.char↑1 ne $< % not ifsPackFlag then
      [
      tfsName = lv ld>>LD.name

      // turn illegal characters into "-" characters
      for i = 1 to tfsName>>String.length do
         [
         let char = tfsName>>String.char↑i
         unless (char ge $a & char le $z) % char eq $. %
          (char ge $A & char le $Z) % char eq $+ %
          (char ge $0 & char le $9) % char eq $- %
          char eq $! % char eq $$ do
            tfsName>>String.char↑i = $-
         ]

      // append a "." if last character is not one
      if tfsName>>String.char↑(tfsName>>String.length) ne $. then
         [
         tfsName>>String.length = tfsName>>String.length +1
         tfsName>>String.char↑(tfsName>>String.length) = $.
         ]

      // Minimum length for a filename is 2:
      //  a single character + the obligatory ending dot.
      // Maximum length is an Alto file system constant: 39.
      if tfsName>>String.length ls 2 %
       tfsName>>String.length gr maxLengthFn then  //not legal
         [
         PutTemplate(dsp, "*N[1-1] *"$S*" is not a legal TFS name.", tfsName)
         // Manufacture a name and mark the lpte so that the new name
         //  is rewritten into the leader page during a later phase.
         let ss = CreateStringStream(tfsName, maxLengthFn)
         PutTemplate(ss,"SN$EUO.scavenger.", lv p1b>>P1B.fileId)
         Closes(ss)
         PutTemplate(dsp,"  I renamed it *"$S*"", tfsName)
         lpteFlags = lpteFlags % lfRewrite
         ]
      ]

   // Generate Leader Page Table Entry (lpte) for this file
   let lpte = GetLptLpte(lpt, true)
   if ifsName ne 0 then SetLpteIfsName(lpte, ifsName)
   if tfsName ne 0 then SetLpteTfsName(lpte, tfsName)
   SetLpteIfp(lpte, ifp)
   SetLpteFa(lpte, lv ld>>LD.hintLastPageFa)
   SetLpteFlags(lpte, lpteFlags)
   if (lpteFlags & lfDIF) ne 0 then SetLpteDIFRec(lpte, nil) //reserve space
   WriteLPTE(lpt)
   ]leaderPage

Enqueue(freeQ, p1b)
]

//-----------------------------------------------------------------------------------------
and Phase1Error(nil, cb, errorCode) be
//-----------------------------------------------------------------------------------------
// This procedure is called when a page gets a hard read error.
// It is marked 'incorrigable' without trying to correct it.
// Often a page can be manually repaired with TriEx.
test errorCode eq ecUnRecovDiskError
   ifso
      [
      PrintDiskError(cb)
      SetBlock(lv cb>>CB.AddrL>>DL.fileId, snIncorr, lFID)
      ]
   ifnot SysErr(0, errorCode, cb)