// IfsScav1-4.bcpl - Pass 1 Phase 4
// Copyright Xerox Corporation 1979, 1980, 1983
// Last modified May 1, 1983  6:49 PM by Boggs

get "IfsScavenger.decl"
get "Streams.d"
get "Disks.d"
get "TFS.d"

external
[
// outgoing procedures
Pass1Phase4

// incoming procedures
DoubleIncrement; MultEq
IFSError; Allocate; Free; MoveBlock; Zero; SetBlock
StringCompare; CopyString; Ws; PutTemplate
OpenFile; DeleteFile; CreateDiskStream; GetCurrentFa
SetFilePos; FilePos; FileLength; PositionPage; TruncateDiskStream
Gets; Puts; Resets; Endofs; Closes; ReadBlock; WriteBlock
ActOnDiskPages; CreateDiskFile; DeleteDiskPages
ReleaseDiskPage; AssignDiskPage; VirtualDiskDA; RealDiskDA
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
TFSCreateFile; TFSDeletePages; TFSInit; CloseDisk
WriteLPTE; EnumerateLPT; GetLptLpte
GetLpteIfp; GetLpteTfsName; GetLpteType
SetLpteIfp; SetLpteTfsName; SetLpteType

// incoming statics
debugFlag; oneBits; freePageFid; sysZone; dsp; keys; lpt
scratchDisk; scavDisk; tfsDDMgr; wordsPerPage; phase
]

static [ bitTable; sysDirFp; newVDA; data; label ]

manifest
[
ecAllocPage = 503
ecHardDiskError = 505
]

//-----------------------------------------------------------------------------------------
let Pass1Phase4(fsAndDrive) = valof
//-----------------------------------------------------------------------------------------
// This phase makes a well formed Alto filesystem.  When the smoke
//  clears, SysDir is guaranteed to exist and contain at least two
//  entries: SysDir and DiskDescriptor.
[
phase = 4
Ws("*N[1-4]"); if debugFlag then Gets(keys)

// set up our bit table
bitTable = OpenFile("IfsScavenger.bitTable", 0, 0, 0, 0, 0, 0, 0, scratchDisk)
if bitTable eq 0 then IFSError(ecScratchFile, "IfsScavenger.bitTable")
scavDisk>>TFSDSK.diskBTsize = FileLength(bitTable) rshift 1
// enable operations which involve page allocation
scavDisk>>DSK.CreateDiskFile = TFSCreateFile
scavDisk>>DSK.DeleteDiskPages = TFSDeletePages
// use our bit table until DiskDescriptor is verified
scavDisk>>DSK.AssignDiskPage = ScavAssignDiskPage
scavDisk>>DSK.ReleaseDiskPage = ScavReleaseDiskPage

// Now consider SysDir.  Its leader page address must be 1, and
//  its Fid must be 100000|144;1.  There are three cases:
// 1. VDA 1 is in use but is not SysDir's leader page:
//	Move it elsewhere and make vda 1 free.
// 2. VDA 1 is free:
//	Create an empty SysDir.
// 3. VDA 1 is SysDir's leader page:
//	Pour Scavenger.lpt into it.
Ws("*N[1-4] SysDir"); if debugFlag then Gets(keys)
data = Allocate(sysZone, wordsPerPage)
label = Allocate(sysZone, lDL)
sysDirFp = table [ 100000b; 144b; 1; 0; 1 ]
newVDA = nil  //new vda of page at VDA 1 in case 1

// Pass1Phase4 (cont'd)

// case 1: if VDA 1 is in use then is it SysDir's leader page?
TransferPage(1, label, data, DCreadLD)
unless MultEq(lv label>>DL.fileId, freePageFid, 3) %
 (MultEq(lv label>>DL.fileId, sysDirFp, 3) & label>>DL.pageNumber eq 0) do
   [
   newVDA = AssignDiskPage(scavDisk, 0)  //get a free page hint
   if newVDA eq -1 then IFSError(ecAllocPage)
   let lab = vec lDL
   TransferPage(newVDA, lab, nil, DCreadLnD)  //check the hint
   unless MultEq(lv lab>>DL.fileId, freePageFid, 3) loop  //BT lied
   Ws("*N[1-4] Moving page at VDA 1")
   TransferPage(newVDA, label, data, DCwriteLD)
   let prevVDA = VirtualDiskDA(scavDisk, lv label>>DL.previous)
   if prevVDA ne eofDA then
      [
      TransferPage(prevVDA, lab, nil, DCreadLnD)
      RealDiskDA(scavDisk, newVDA, lv lab>>DL.next)
      TransferPage(prevVDA, lab, nil, DCwriteLnD)
      ]
   let nextVDA = VirtualDiskDA(scavDisk, lv label>>DL.next)
   if nextVDA ne eofDA then
      [
      TransferPage(nextVDA, lab, nil, DCreadLnD)
      RealDiskDA(scavDisk, newVDA, lv lab>>DL.previous)
      TransferPage(nextVDA, lab, nil, DCwriteLnD)
      ]
   MoveBlock(lv lab>>DL.fileId, freePageFid, lDL)
   TransferPage(1, lab, nil, DCwriteLnD)
   break
   ] repeat

// case 2: is VDA 1 free?
TransferPage(1, label, data, DCreadLD)
if MultEq(lv label>>DL.fileId, freePageFid, 3) then
   [
   Ws("*N[1-4] Creating SysDir")
   let tempSn, lastSn = vec lSN, lv scavDisk>>TFSDSK.lastSn
   MoveBlock(tempSn, lastSn, lSN)
   lastSn!0 = 0; lastSn!1 = 143b
   ReleaseDiskPage(scavDisk, 1)  //for good luck
   scavDisk>>TFSDSK.lastPageAlloc = 0
   CreateDiskFile(scavDisk, "SysDir.", sysDirFp, sysDirFp, 100000b)
   MoveBlock(lastSn, tempSn, lSN)

   // enter it in the leader page table
   let lpte = GetLptLpte(lpt, true)
   SetLpteTfsName(lpte, "SysDir.")
   SetLpteIfp(lpte, sysDirFp)
   WriteLPTE(lpt)
   ]

// case 3: SysDir exists.  Recreate contents from info in lpt.
let sysDir = CreateDiskStream(sysDirFp, ksTypeWriteOnly, 0, 0, 0, 0, 0, scavDisk)
if sysDir eq 0 then IFSError(ecCreateDiskStream, "SysDir.")
EnumerateLPT(lpt, FillSysDir, sysDir)
for i = 1 to 40 do  //fill out directory with free blocks
   [
   let a = vec 1
   a>>DV.type = dvTypeFree
   a>>DV.length = 100
   WriteBlock(sysDir, a, a>>DV.length)
   ]
Closes(sysDir)  //truncates

Free(sysZone, data)
Free(sysZone, label)

// Pass1Phase4 (cont'd)

//Now consider DiskDescriptor.  Scavenger.dd on the scratch disk
//contains an accurate bit table, and the Disk Descriptor Header
//in scavDisk's TFSDSK is now mostly right.

//Here is the full TFSKDH, for consultation while pondering this code:
compileif false then
[
//*	Set by TFSInit when initMode = 0 and freshDisk = true
//***	Set by phase 3
//****	Set by Phase 4

structure TFSKDH:
[
kd word =		//First word (for lv...)
nDisks word		//* Number of disks
nTracks word		//* Number of tracks
nHeads word		//* Number of heads
nSectors word		//* Number of sectors
lastSn @SN		//*** Last serial number used on disk
blank word		// (formerly bitTableChanged)
diskBTsize word		//**** Number of valid words in the bit table
blank word		// (formerly defaultVersionsKept)
freePages word
blank word 6

//TFS specific extension to KDH
version word		//**** version number of this DiskDescriptor
model word		//* disk model (80 = T-80, 300 = T-300)
packID word		//**** field setup when disk initialized
VDAdiskDD word lengthTFSBT+1	//**** VDAs of the data part of DD
firstVTrack word	//* first track used in file system
nVTracks word		//* number of tracks used in file system
nTransfers word 2	//**** total number of transfers on this disk
nErrors word 2		//**** total number of errors -- see TfsGetCb
nECCErrors word 2	//**** total number of ECC errors encountered
nECCFixes word 2	//**** total number of times recovery successful
nRestores word 2	//**** number of "restore" operations done
nUnRecov word 2		//**** number of unrecoverable errors
nBTErrors word 2	//**** number of bit table discrepancies
lastPageAlloc word	//**** last VDA allocated -- for biasing search

// words beyond here are not saved on the disk
// ...
]
]

// Pass1Phase4 (cont'd)

Ws("*N[1-4] DiskDescriptor"); if debugFlag then Gets(keys)
let dd = OpenFile("DiskDescriptor.", ksTypeReadWrite, wordItem,
 verLatest, scavDisk>>DSK.fpDiskDescriptor, 0, 0, 0, scavDisk)
if dd eq 0 then  //didn't exist.  Create it and enter it in lpt
   [
   Ws("*N[1-4] Creating DiskDescriptor")
   Zero(scavDisk>>DSK.fpDiskDescriptor, lFP)
   dd = OpenFile("DiskDescriptor.", ksTypeReadWrite, wordItem,
    verLatestCreate, scavDisk>>DSK.fpDiskDescriptor, 0, 0, 0, scavDisk)

   let lpte = GetLptLpte(lpt, true)
   SetLpteTfsName(lpte, "DiskDescriptor.")
   SetLpteIfp(lpte, scavDisk>>DSK.fpDiskDescriptor)
   WriteLPTE(lpt)
   ]

let diskKd = vec lTFSKDHeader  //the KD we read from the disk
let coreKd = scavDisk>>TFSDSK.diskKd  //the KD we are constructing
coreKd>>TFSKD.version = TFSKDversion
// someday, we should do something with the packID.
let lenKDH = ReadBlock(dd, diskKd, lTFSKDHeader)
if lenKDH eq lTFSKDHeader &
 diskKd>>TFSKD.version eq coreKd>>TFSKD.version &
 diskKd>>TFSKD.model eq coreKd>>TFSKD.model then
   [
   // In general, the DD we write out is constructed from whole cloth.
   // However, if there seems to be one out there already, we preserve
   //  selected fields which are not vital to correct operation.
   coreKd>>TFSKD.lastPageAlloc = diskKd>>TFSKD.lastPageAlloc
   MoveBlock(lv coreKd>>TFSKD.nTransfers, lv diskKd>>TFSKD.nTransfers, 2)
   MoveBlock(lv coreKd>>TFSKD.nErrors, lv diskKd>>TFSKD.nErrors, 2)
   MoveBlock(lv coreKd>>TFSKD.nECCErrors, lv diskKd>>TFSKD.nECCErrors, 2)
   MoveBlock(lv coreKd>>TFSKD.nECCFixes, lv diskKd>>TFSKD.nECCFixes, 2)
   MoveBlock(lv coreKd>>TFSKD.nRestores, lv diskKd>>TFSKD.nRestores, 2)
   MoveBlock(lv coreKd>>TFSKD.nUnRecov, lv diskKd>>TFSKD.nUnRecov, 2)
   MoveBlock(lv coreKd>>TFSKD.nBTErrors, lv diskKd>>TFSKD.nBTErrors, 2)
   ]

// Extend file to max length, setting VDAs in DD as we go.
for i = 1 to (TFSwordsPerPage+scavDisk>>TFSDSK.diskBTsize-1) rshift
 TFSlnWordsPerPage +1 do
   [
   PositionPage(dd, i)
   let fa = vec lFA; GetCurrentFa(dd, fa)
   (lv scavDisk>>TFSDSK.VDAdiskDD)!(i-1) = fa>>FA.da
   ]
TruncateDiskStream(dd)
Resets(dd)

// write KDH:
WriteBlock(dd, scavDisk>>TFSDSK.diskKd, lTFSKDHeader)
PositionPage(dd, lengthTFSDDpreamble)
Resets(bitTable)

// write BT:
until Endofs(bitTable) do Puts(dd, Gets(bitTable))

Closes(bitTable)
Closes(dd)
DeleteFile("IfsScavenger.bitTable", 0, 0, 0, 0, scratchDisk)

CloseDisk(scavDisk, true)
scavDisk = TFSInit(sysZone, true, fsAndDrive, tfsDDMgr)
resultis scavDisk ne 0
]

//-----------------------------------------------------------------------------------------
and FillSysDir(l, lpte, sysDir) be
//-----------------------------------------------------------------------------------------
[
let tfsName = GetLpteTfsName(lpte)
if GetLpteType(lpte) ne dvTypeFile % tfsName>>String.length eq 0 return

manifest [ address = 1; fid = 2; name = 4 ]
let state = 0
let ifp = GetLpteIfp(lpte)
if ifp>>IFP.page eq 1 then state = state + address
if MultEq(sysDirFp, lv ifp>>IFP.serialNumber, lFID) then state = state + fid
if StringCompare(tfsName, "SysDir.") eq 0 then state = state + name

switchon state into
   [
   case address+fid+name:  //SysDir.  Everything is consistant.
   case 0:  //ordinary file
      [
      let lenTfsName = tfsName>>String.length rshift 1 +1
      let dv = nil
      dv<<DV.type = dvTypeFile
      dv<<DV.length = 1 + lFP + lenTfsName
      Puts(sysDir, dv)
      WriteBlock(sysDir, ifp, lFP)
      WriteBlock(sysDir, tfsName, lenTfsName)
      endcase
      ]
   case address:  //Correct address but wrong name and FID
      [     //actually, the address was changed above...
      ifp>>IFP.page = newVDA
      docase 0
      ]
   case address+fid:  //Correct FID and address but wrong name
      [
      SetLpteTfsName(lpte, "SysDir.")
      tfsName = GetLpteTfsName(lpte)
      docase address+fid+name
      ]
   case address+name:  //Correct name and address but wrong FID
      [     //actually, the address was changed above...
      ifp>>IFP.page = newVDA
      docase fid+name
      ]
   case fid:  //Correct FID but wrong name and address
   case name:  //Correct name but wrong FID and address
   case fid+name:  //Correct name and FID but wrong address
      [
      PutTemplate(dsp, "*N[1-4] Deleting *"$S*"", tfsName)
      DeleteDiskPages(scavDisk, data, ifp>>IFP.page, ifp, 0)
      SetLpteType(lpte, dvTypeFree)
      endcase
      ]
   ]
]

//-----------------------------------------------------------------------------------------
and ScavAssignDiskPage(disk, prevVDA, nil; numargs na) = valof
//-----------------------------------------------------------------------------------------
// Assigns in a sequential manner, in order of increasing vda.
// Second argument is a VDA previously assigned;
//  the code tries to assign pages sequentially in this case.
// However, for a new file, the VDA passed is eofDA; in
//  this case, the code resumes looking in the bit table where it
//  last left off trying to allocate a file.
// Returns -1 if the bit table is full, else VDA

// Special three-argument form does not really to an assignment --
//  returns 0 if VDA+1 is assigned; true if it is available

// This implementation uses streams to be independent of
//  the page size of the scratch disk.  Speed is not important.
[
let base = prevVDA +1	//next page to look for
if base eq eofDA+1 then	//new file
   base = disk>>TFSDSK.lastPageAlloc
let toBeExamined = disk>>TFSDSK.diskBTsize
SetFilePos(bitTable, 0, (base rshift 3) & -2)
   [
   // At top of loop: base = VDA to be examined next.
   // toBeExamined = # bit table words remaining to examine.
   if Endofs(bitTable) then Resets(bitTable)  //wrap around
   let bitWord = Gets(bitTable)  //item size is word
   // Test the bit corresponding to "base".
   // If it fails, look in the remainder of the same word.
   let bitt = oneBits!(base & 17b)
      [
      if (bitWord & bitt) eq 0 then
         [
         if na eq 3 resultis true
         bitWord = bitWord % bitt
         SetFilePos(bitTable, 0, FilePos(bitTable)-2)
         Puts(bitTable, bitWord)
         disk>>TFSDSK.lastPageAlloc = base
         resultis base
         ]
      if na eq 3 resultis false
      bitt = bitt rshift 1
      base = base+1
      ] repeatuntil bitt eq 0
   toBeExamined = toBeExamined -1
   ] repeatuntil toBeExamined le 0
resultis -1  //fail.  Disk appears to be full
]

//-----------------------------------------------------------------------------------------
and ScavReleaseDiskPage(disk, vda) be
//-----------------------------------------------------------------------------------------
[
SetFilePos(bitTable, 0, (vda rshift 3) & -2)
let bitWord = Gets(bitTable)  //a word
SetFilePos(bitTable, 0, FilePos(bitTable)-2)
Puts(bitTable, bitWord & not oneBits!(vda & 17b))
]

//-----------------------------------------------------------------------------------------
and TransferPage(vda, label, data, action) be
//-----------------------------------------------------------------------------------------
[
let cbz = Allocate(sysZone, CBzoneLength)
InitializeDiskCBZ(scavDisk, cbz, 0, CBzoneLength, TransferRetry)
TransferRetry:
let cb = GetDiskCb(scavDisk, cbz)
cb>>CB.AddrL = label
DoDiskCommand(scavDisk, cb, data, vda, lv label>>DL.fileId,
 label>>DL.pageNumber, action)
while @cbz>>CBZ.queueHead ne 0 do GetDiskCb(scavDisk, cbz)
Free(sysZone, cbz)
]