// 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)
]