// BFSNewDisk.Bcpl -- Procedures to create a virgin Alto File System
//  on a Diablo disk, and extend an existing file system.
// Copyright Xerox Corporation 1979, 1980, 1982
// Last modified April 27, 1982  11:00 PM by Boggs

get "Streams.d"
get "AltoFileSys.d"
get "Disks.d"
get "Bfs.d"
get "SysDefs.d"

external
[
// outgoing procedures
BFSNewDisk; BFSExtendDisk

// incoming procedures
OpenFile
PositionPage; GetCurrentFa; TruncateDiskStream
CreateDiskStream; WriteBlock; SetFilePos; FilePos
ReadLeaderPage; WriteLeaderPage
Closes; Resets; Puts; Gets; Allocate; Free
Zero; MoveBlock; SysErr; DefaultArgs; Usc; Max
CreateDiskFile; AssignDiskPage; ReleaseDiskPage; ActOnDiskPages
InitializeDiskCBZ; GetDiskCb; DoDiskCommand; CloseDisk
BFSInit; BFSAssignDiskPage; BFSWriteDiskDescriptor
ReadDDPage

// incoming statics
freePageFp; oneBits
]

manifest
[
defaultDirLen = 5000  //default size of SysDir in words
bDir = 100000b rshift offset SN.directory
]

//----------------------------------------------------------------------------
let BFSNewDisk(diskZone, driveNum, nDisks, nTracks, dirLen, nSectors;
    numargs na) = valof
//----------------------------------------------------------------------------
// Creates a virgin Alto file system on the specified disk.
// nDisks is 2 to make a file system that occupies two packs.
// nTracks may be anything up to the physical size of the disk.
// nSectors may be 14 on D0s and Dorados.
[
DefaultArgs(lv na, -1, 0, 0, 0, defaultDirLen, 0)

// Init the disk object
let disk = BFSInit(diskZone, true, driveNum, 0, true)
if disk eq 0 resultis false
// BFSInit fills in DSK with the physical shape of the disk.
// The user may want some other logical shape, such as two packs.
if nDisks ne 0 then disk>>BFSDSK.nDisks = nDisks
if nTracks ne 0 then disk>>BFSDSK.nTracks = nTracks
if nSectors ne 0 then disk>>BFSDSK.nSectors = nSectors

// # of pages in this file system
let diskSize = disk>>BFSDSK.nDisks * disk>>BFSDSK.nTracks *
 disk>>BFSDSK.nHeads * disk>>BFSDSK.nSectors

// Allocate a page sized temporary bit table and
//  plug in our own AssignDiskPage procedure for initial allocations.
// This procedure will put assigned addresses in tempBT.
// We must not allocate more than 255 pages here, or we
//  will have to figure out a new way around this Catch-22.
let buf = Allocate(diskZone, BFSwordsPerPage)
Zero(buf, BFSwordsPerPage)
disk>>BFSDSK.initmode = buf
disk>>DSK.AssignDiskPage = NewDiskAssignPage

// It's too late to back out now:
ClearDisk(disk, 0, diskSize-1)

let fpSysDir = disk>>DSK.fpSysDir
let fpDiskDescriptor = disk>>DSK.fpDiskDescriptor

// Create SysDir.  Its SN must be 100 with the directory bit set.
// Its leader page must be at virtual address 1.
(lv disk>>BFSDSK.lastSn)!1 = 99  //init last SN used
disk>>BFSDSK.lastPageAlloc = 0	//skip page 0
let dir = NewDiskCreateFile(disk, "SysDir.", fpSysDir, diskZone, 0, bDir)
let pos = FilePos(dir)
SetFilePos(dir, 0, dirLen lshift 1)  //make nice contiguous dir
SetFilePos(dir, 0, pos)

// Create DiskDescriptor and make sure it is consecutively allocated.
let ddStream = NewDiskCreateFile(disk, "DiskDescriptor.", fpDiskDescriptor,
 diskZone, dir, 0)
let diskBTsize = (diskSize-1) rshift 4 +1  //total words in BT
disk>>BFSDSK.diskBTsize = diskBTsize

// Extend disk descriptor and fill it with zeros.
// DD file is made big enough to handle a Double 44 filesystem without
//  having to extend it.  KDH.diskBTsize tells how many words are
//  really part of the bit table; the remaining ones should be ignored.
PositionPage(ddStream, 5)
let q, r = diskSize rshift 4, diskSize & 17B
SetFilePos(ddStream, 0, (lKDHeader+q) lshift 1)
// Last word of BT needs special treatment since number of pages
//  on disk may not be a mulitple of 16.
if r ne 0 then Puts(ddStream, -1 rshift r)

// DDMgr needs VDAs of disk descriptor pages to function.
// This is normally done by BFSInit, but DiskDescriptor didn't exist then.
for i = 1 to (lKDHeader+diskBTsize-1) rshift BFSlnWordsPerPage +1 do
   [
   PositionPage(ddStream, i)
   let fa = vec lFA
   GetCurrentFa(ddStream, fa)
   disk>>BFSDSK.VDAdiskDD^i = fa>>FA.da
   ]
Closes(ddStream)

// BFSNewDisk (cont'd)

// Fill out rest of directory with empties of small enough size.
   [
   let len = dirLen - FilePos(dir) rshift 1
   if len le 0 then break
   if len gr 100 then len = 100
   let a = vec 1
   a>>DV.type = dvTypeFree
   a>>DV.length = len
   WriteBlock(dir, a, len)
   ] repeat
TruncateDiskStream(dir)

// Now put back the normal AssignDiskPage procedure and mark the pages
//  we have allocated in the bit table in the normal way.
disk>>DSK.AssignDiskPage = BFSAssignDiskPage
for i = 1 to buf!0 do
   if AssignDiskPage(disk, buf!i-1) ne buf!i then
      SysErr(disk, ecBadAssignPage)
// Assign page zero.  This is slightly tricky since zero = eofDA+1
disk>>BFSDSK.lastPageAlloc = 0
if AssignDiskPage(disk, eofDA) ne 0 then SysErr(disk, ecBadAssignPage)

// Install the disk shape parameters as a file property in the leader
//  page of SysDir.  This is mostly for Mesa's benefit.
ReadLeaderPage(dir, buf)
let fProp = buf + buf>>LD.propertyBegin
fProp>>FPROP.type = fpropTypeDShape
fProp>>FPROP.length = lDSHAPE+1
let dShape = fProp+1
dShape>>DSHAPE.nDisks = disk>>BFSDSK.nDisks
dShape>>DSHAPE.nTracks = disk>>BFSDSK.nTracks
dShape>>DSHAPE.nHeads = disk>>BFSDSK.nHeads
dShape>>DSHAPE.nSectors = disk>>BFSDSK.nSectors
WriteLeaderPage(dir, buf)

Closes(dir)
Free(diskZone, buf)

// Flush DiskDescriptor out to the disk
CloseDisk(disk)

resultis true
]

//----------------------------------------------------------------------------
and BFSExtendDisk(zone, disk, nDisks, nTracks) be
//----------------------------------------------------------------------------
// 'disk' is the file system to extend.  Presumably either 'nTracks' or
//  'nDisks' or both is bigger than the corresponding current parameter.
[
let pgsPerCyl = disk>>BFSDSK.nSectors * disk>>BFSDSK.nHeads
let firstVDA = pgsPerCyl * disk>>BFSDSK.nTracks * disk>>BFSDSK.nDisks
let lastVDA = pgsPerCyl * nTracks * nDisks -1
if Usc(firstVDA, lastVDA) ge 0 return  // nothing to do

let buf = Allocate(zone, BFSwordsPerPage); Zero(buf, BFSwordsPerPage)
disk>>BFSDSK.initmode = buf
disk>>DSK.AssignDiskPage = NewDiskAssignPage
disk>>BFSDSK.nTracks = nTracks
disk>>BFSDSK.nDisks = nDisks

ClearDisk(disk, firstVDA, lastVDA)
disk>>DSK.AssignDiskPage = ExtendDiskAssignPage

let ddStream = OpenFile("DiskDescriptor.", ksTypeReadWrite, wordItem,
 0, disk>>BFSDSK.fpDiskDescriptor, 0, zone, 0, disk)
let q, r = firstVDA rshift 4, firstVDA & 17B
SetFilePos(ddStream, 0, (lKDHeader+q) lshift 1)
if r ne 0 then
   [
   let bits = Gets(ddStream)
   SetFilePos(ddStream, 0, (lKDHeader+q) lshift 1)
   Puts(ddStream, bits & not -1 rshift r)
   ]
q, r = (lastVDA+1) rshift 4, (lastVDA+1) & 17B
for i = FilePos(ddStream) rshift 1 to lKDHeader+q do
   Puts(ddStream, 0)  //fill with zeros
if r ne 0 then Puts(ddStream, -1 rshift r)
let diskBTsize = lastVDA rshift 4 +1  //total words in BT
for i = 1 to (lKDHeader+diskBTsize-1) rshift BFSlnWordsPerPage +1 do
   [
   PositionPage(ddStream, i)
   let fa = vec lFA; GetCurrentFa(ddStream, fa)
   disk>>BFSDSK.VDAdiskDD^i = fa>>FA.da
   ]
Closes(ddStream)
disk>>BFSDSK.diskBTsize = diskBTsize
disk>>DSK.AssignDiskPage = BFSAssignDiskPage
for i = 1 to buf!0 do
   [
   let vda = AssignDiskPage(disk, buf!i-1)
   if vda ne buf!i then ReleaseDiskPage(disk, vda)
   ]
disk>>BFSDSK.freePages = lastVDA - firstVDA + disk>>BFSDSK.freePages +1

let DAs = vec 2; DAs!1 = 1
ActOnDiskPages(disk, 0, DAs+1, disk>>DSK.fpSysDir, 0, 0, DCreadD, 0, 0, buf)
let fProp = buf + buf>>LD.propertyBegin
fProp>>FPROP.type = fpropTypeDShape
fProp>>FPROP.length = lDSHAPE+1
let dShape = fProp+1
dShape>>DSHAPE.nDisks = disk>>BFSDSK.nDisks
dShape>>DSHAPE.nTracks = disk>>BFSDSK.nTracks
dShape>>DSHAPE.nHeads = disk>>BFSDSK.nHeads
dShape>>DSHAPE.nSectors = disk>>BFSDSK.nSectors
ActOnDiskPages(disk, 0, DAs+1, disk>>DSK.fpSysDir, 0, 0, DCwriteD, 0, 0, buf)
Free(zone, buf)

BFSWriteDiskDescriptor(disk)
]

//----------------------------------------------------------------------------
and NewDiskCreateFile(disk, name, fp, zone, dirStream, word1) = valof
//----------------------------------------------------------------------------
//Creates the file on the disk and appends a directory entry to dirStream.
//If dirStream is zero, the new file itself is assumed to be the directory
// and the entry is appended to it.  Returns an open stream.
[
CreateDiskFile(disk, name, fp, 0, word1)

// Make stream
let s = CreateDiskStream(fp, 0, 0, 0, 0, zone, 0, disk)
if s eq 0 then SysErr(disk, ecEssentialFile)

// Now make directory entry
if dirStream eq 0 then dirStream = s	//SysDir is first
let dv = vec lDV
dv>>DV.type = dvTypeFile
let lName = (name>>STRING.length+2) rshift 1
dv>>DV.length = lDV+lName
MoveBlock(lv dv>>DV.fp, fp, lFP)
WriteBlock(dirStream, dv, lDV)
WriteBlock(dirStream, name, lName)

// return stream
resultis s
]

//----------------------------------------------------------------------------
and NewDiskAssignPage(disk, vda, nil) = valof
//----------------------------------------------------------------------------
// The AssignDiskPage procedure used while creating the initial files
//  (SysDir and DiskDescriptor).
// Keeps a list of assigned pages in the buffer pointed to by the
//  initmode word in the disk structure.
// Number of allocated pages is in buf!0, followed by that many VDAs.
[
vda = vda eq eofDA? disk>>BFSDSK.lastPageAlloc+1, vda+1
disk>>BFSDSK.lastPageAlloc = vda
let tempBT = disk>>BFSDSK.initmode

// search for first unused slot, and make sure page not already assigned
let assigned = false
for i = 1 to tempBT!0 if vda eq tempBT!i then [ assigned = true; break ]
unless assigned do  //assign the page
   [
   if tempBT!0 eq 255 then SysErr(disk, ecBadAssignPage)  //full!
   tempBT!0 = tempBT!0 +1  //bump count of pages allocated
   tempBT!(tempBT!0) = vda  //remember vda of allocated page
   resultis vda
   ]
] repeat

//----------------------------------------------------------------------------
and ExtendDiskAssignPage(disk, vda, nil) = valof
//----------------------------------------------------------------------------
// During extension, no new files are created, so vda can't be eofDA.
[
if vda ls disk>>BFSDSK.diskBTsize lshift 4 then
   [
   vda = BFSAssignDiskPage(disk, vda)
   ReadDDPage(disk>>BFSDSK.ddMgr, disk, 1)  //flush it out
   vda = vda eq -1? disk>>BFSDSK.diskBTsize lshift 4, vda-1
   ]
resultis NewDiskAssignPage(disk, vda)
]

//----------------------------------------------------------------------------
and ClearDisk(disk, firstVDA, lastVDA) be
//----------------------------------------------------------------------------
// The idea here is to initialize every page in the file system.
// The simple way is to write 'free' in every page, but this will make
//  incorrigable pages free again, causing future problems.
// It is the job of a disk certification program such as DiEx to test
//  each page and mark it incorrigable, and we shouldn't disturb them.
// If the disk has never been formatted before, we should assume that
//  all pages are good and set them all to free.
[
let tempBT = disk>>BFSDSK.initmode  //temp bit table
let cbz = vec CBzoneLength

// Read each page to see if it is incorrigable or unreadable.
// If there are more than 20 of them then assume the disk is
//  unformatted and abandon the read pass.
// Pages 0 and 1 are not checked and are unconditionally marked free.
// They are critical, and must be good or else chuck the disk!
let buf1 = vec 256  //I wish I could disable data record transfers
InitializeDiskCBZ(disk, cbz, Max(2, firstVDA), CBzoneLength,
 RetryRead, lv ClearDiskError)
cbz>>CBZ.cleanupRoutine = ClearDiskCleanup
RetryRead: test tempBT!0 le 20
   ifso
      [
      for page = cbz>>CBZ.currentPage to lastVDA do
         DoDiskCommand(disk, GetDiskCb(disk, cbz), buf1, page,
          freePageFp, page, DCreadLD)
      while cbz>>CBZ.head ne 0 do GetDiskCb(disk, cbz)
      ]
   ifnot Zero(tempBT, 256)  //abandon read pass, assume all pages are good
Zero(buf1, 256)  //write zeros in data records

// Write each page, marking it free or incorrigable.
let incorrigableFp = table [ -2; -2; -2 ]
InitializeDiskCBZ(disk, cbz, firstVDA, CBzoneLength, RetryWrite)
RetryWrite:
   [
   for page = cbz>>CBZ.currentPage to lastVDA do
      [
      let bad = false
      for i = 1 to tempBT!0 if page eq tempBT!i then [ bad = true; break ]
      DoDiskCommand(disk, GetDiskCb(disk, cbz), buf1, page,
       (bad? incorrigableFp, freePageFp), page, DCwriteHLD)
      ]
   while cbz>>CBZ.head ne 0 do GetDiskCb(disk, cbz)
   ]
]

//----------------------------------------------------------------------------
and ClearDiskCleanup(nil, cb, cbz) be
//----------------------------------------------------------------------------
// Cleanup routine called during the read pass.
// If the label says incorrigable, mark the page used in the bit table.
[
let label = lv cb>>CB.labelAddress>>DL.fileId
for i = 0 to 2 do if label!i ne -2 return
// The page is bad and should be marked used in the bit table.
ClearDiskError(nil, cb)
]

//----------------------------------------------------------------------------
and ClearDiskError(nil, cb, nil) be
//----------------------------------------------------------------------------
// Error routine called for a hard error during the read pass.
// Also called from ClearDiskCleanup for a sector labelled incorrigable.
[
let vda = cb>>CB.truePageNumber
let disk = cb>>CB.cbz>>CBZ.disk
if AssignDiskPage(disk, vda-1) ne vda then SysErr(disk, ecBadAssignPage)
// Zero the label so ClearDiskCleanup doesn't think it incorrigable
//  and try to mark it in use again.
Zero(lv cb>>CB.labelAddress>>DL.fileId, lFID)
]