// TFSNewDisk.Bcpl -- Disk refresh sequence
// Copyright Xerox Corporation 1979, 1981

//	Last modified April 30, 1981  8:31 PM by Taft

get "Altofilesys.d"
get "Disks.d"
get "Tfs.d"
get "Streams.d"

external
[
//outgoing procedures
TFSNewDisk

//incoming procedures
TFSInit; TFSClose; TFSInitializeCbStorage; TFSGetCb; TFSDoDiskCommand
TFSAssignDiskPage; ActOnDiskPages
RealDiskDA; VirtualDiskDA; AssignDiskPage
DefaultArgs; Allocate; Free; Zero; MoveBlock; SysErr
CreateDiskFile; CreateDiskStream; TruncateDiskStream; SetWorkingDir
WriteBlock; Puts; Closes; FilePos; SetFilePos; PositionPage; GetCurrentFa

//incoming statics
freePageFp
]

manifest
[
dirLen = 25000  //initial size of SysDir in words
bDir = #100000 rshift offset SN.directory
bNoLog = #100000 rshift offset SN.nolog
]

//---------------------------------------------------------------------------
let TFSNewDisk(diskZone, driveNumber, diskSize, ddVDA; numargs na) = valof
//---------------------------------------------------------------------------
//Creates a virgin Alto file system on the specified disk.
//If supplied, diskSize is the number of pages to include in the file system.
//If supplied, ddVDA is the virtual disk address at which to locate the
//DiskDescriptor file (default is in the middle of the disk).
//Allocates storage from diskZone
[
DefaultArgs(lv na, -1, 0, 0, 0)

// init the disk object 
let disk = TFSInit(diskZone, true, driveNumber, 0, true)
if disk eq 0 then resultis 0
let defaultDiskSize =
   disk>>TFSDSK.nVTracks * disk>>TFSDSK.nHeads * disk>>TFSDSK.nSectors
if diskSize eq 0 % diskSize ugr defaultDiskSize then
   diskSize = defaultDiskSize
if ddVDA eq 0 then ddVDA = diskSize rshift 1
let da = vec 2
RealDiskDA(disk, diskSize-1, da)
disk>>TFSDSK.nVTracks = da>>DA.track - disk>>TFSDSK.firstVTrack +1
let buf = Allocate(diskZone, TFSwordsPerPage)
disk>>TFSDSK.initmode = buf  // Stick it where NewDiskAssignPage can find it
let kdAddr = lv disk>>TFSDSK.kd

// setup important init conditions for this disk, etc.
disk>>TFSDSK.version = TFSKDversion
let fpTFSSysDir = disk>>DSK.fpSysDir
let fpTFSDiskDescriptor = disk>>DSK.fpDiskDescriptor

// Read physical page 0 to get the bad page list, if there is one.
// Write virgin bad page list if there isn't
unless TransferPage0(disk, buf, DCreadD) & buf>>BPL.seal eq bplSeal do
   [
   Zero(buf, TFSwordsPerPage)
   buf>>BPL.seal = bplSeal
   TransferPage0(disk, buf, DCwriteHLD)
   ]

// Convert real disk addresses to virtual, and discard duplicate entries
// and entries not contained in the portion of the disk we are initializing
let n = 0
for i = 0 to buf>>BPL.nBadPages-1 do
   [
   let vda = VirtualDiskDA(disk, lv buf>>BPL.da^i)
   for j = 0 to n-1 do if vda eq buf!j then vda = fillInDA
   if vda ne fillInDA then [ buf!n = vda; n = n+1 ]
   ]
Zero(buf+n, TFSwordsPerPage-n)

// Sort the list of virtual addresses
for i = 0 to n-1 do for j = i+1 to n-1 do
   if buf!i ugr buf!j then [ let t = buf!i; buf!i = buf!j; buf!j = t ]

// Clear the disk.  Overwrite page 0 only if vda 0 is not real da 0.
ClearDisk(disk, buf, (disk>>TFSDSK.firstVTrack eq 0? 1, 0), diskSize-1)

// TFSNewDisk (cont'd)

// Plug in our own AssignDiskPage procedure for initial allocations.
// This procedure will append assigned addresses to the list now in buf.
disk>>DSK.AssignDiskPage = NewDiskAssignPage

// Create SysDir.  Its SN must be 100 with the directory bit set.
// Its leader page must be at virtual address 1 (we would otherwise prefer
// to locate the file in the middle of the disk).
(lv disk>>TFSDSK.lastSn)!1 = 99      // Last sn used
let dir = NewDiskMakeFile(disk, "SysDir.",fpTFSSysDir, diskZone, 0, bDir)
let pos = FilePos(dir)
SetFilePos(dir, 0, dirLen lshift 1)   // Make nice contiguous dir
SetFilePos(dir, 0, pos)

// Create disk descriptor, and try to make it be consecutively allocated.
// Place it in the middle of the disk to minimize average seek distance
// between bit table pages and all other files.
disk>>TFSDSK.lastPageAlloc = ddVDA
let ddStream = NewDiskMakeFile(disk, "DiskDescriptor.", fpTFSDiskDescriptor,
 diskZone, dir, bNoLog)
let diskBTsize = (diskSize-1) rshift 4 +1  //Total number of words in BT
kdAddr>>KDH.diskBTsize = diskBTsize

// Extend disk descriptor to desired length and fill it with zeroes.
// Last word of BT needs special treatment since number of pages on disk
// may not be a multiple of 16.
let q, r = diskSize rshift 4, diskSize & #17
SetFilePos(ddStream, 0, (TFSwordsPerPage+q) lshift 1)
if r ne 0 then Puts(ddStream, -1 rshift r)

// Fill out rest of directory with empties of small enuf size.
   [  // repeat
   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)
Closes(dir)

// Finish initing the disk descriptor
SetWorkingDir("<SysDir.", fpTFSSysDir, disk)
Zero(lv kdAddr>>TFSKD.nTransfers, 2)

// Save virtual disk addresses of disk descriptor pages
for i = 1 to (TFSwordsPerPage+diskBTsize-1) rshift TFSlnWordsPerPage +1 do
   [
   PositionPage(ddStream, i)
   let fa = vec lFA
   GetCurrentFa(ddStream, fa)
   disk>>TFSDSK.VDAdiskDD^i = fa>>FA.da
   ]
Closes(ddStream)

// TFSNewDisk (cont'd)

// 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 = TFSAssignDiskPage
let i = 0
while buf!i ne 0 do
   [
   if AssignDiskPage(disk, buf!i -1) ne buf!i then
      SysErr(disk, ecBadAssignPage)
   i = i+1
   ]
Free(diskZone, buf)

// Assign page zero.  This is slightly tricky because zero = eofDA+1
disk>>TFSDSK.lastPageAlloc = 0
if AssignDiskPage(disk, eofDA) ne 0 then SysErr(disk, ecBadAssignPage)

// The TFSClose call will write out the KD onto the disk descriptor file.
TFSClose(disk)
resultis true
]


//---------------------------------------------------------------------------
and NewDiskAssignPage(disk, nil, nil) = valof
//---------------------------------------------------------------------------
// The AssignDiskPage procedure used while creating the initial files
// (SysDir and DiskDescriptor).  Always assigns the next page in sequence,
// and keeps a list of assigned pages in the buffer pointed to by
// the initmode word in the disk structure.
[
let vda = disk>>TFSDSK.lastPageAlloc+1
disk>>TFSDSK.lastPageAlloc = vda
let buf = disk>>TFSDSK.initmode
let i = 0
while buf!i ne 0 do
   [  //search for first unused slot, and make sure page not already assigned
   if vda eq buf!i then [ vda = 0; break ]
   i = i+1
   ]
if vda ne 0 then [ buf!i = vda; resultis vda ]
] repeat


//---------------------------------------------------------------------------
and TransferPage0(disk, buf, action) = valof
//---------------------------------------------------------------------------
// Transfers physical page 0 to or from the buffer, returning true
// if successful and false otherwise.
[
let DAs = vec 2

// Passing a DA of fillInDA causes TFSDoDiskCommand not to compute
// the real DA.  Since the CB has been zeroed, a real DA of zero results.
DAs!0 = eofDA; DAs!1 = fillInDA; DAs!2 = eofDA
resultis ActOnDiskPages(disk, lv buf, DAs+1, table [ 0; 0; 0 ], 0, 0, action,
 0, 0, 0, 0, 0, true) eq 0
]

//---------------------------------------------------------------------------
and NewDiskMakeFile(disk, nam, fp, diskZone, 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, nam, fp, 0, word1)

// Make stream:
// Will not be logged because nolog on
// temp use of Allocated zone because of CreateDiskStream bug
let s=CreateDiskStream(fp, 0, 0, 0, 0, diskZone, 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 lNam=(nam>>STRING.length+2) rshift 1
dv>>DV.length=lDV+lNam
MoveBlock(lv dv>>DV.fp, fp, lFP)
WriteBlock(dirStream, dv, lDV)
WriteBlock(dirStream, nam, lNam)

// return stream
resultis s
]

//---------------------------------------------------------------------------
and ClearDisk(disk, buf, firstPage, lastPage) be
//---------------------------------------------------------------------------
// Makes pages firstPage, through lastPage appear free, except that page 0
// has an illegal label written in it.  This is to prevent its ever being
// assigned, as it plays a crucial role in end-of-file detection.
// buf must contain a sorted list of virtual disk addresses to be
// marked permanently bad (zero ends list).
[
let checkErrors = 0
let action = DCwriteLD
let zone = vec CBzoneLength
TFSInitializeCbStorage(disk, zone, firstPage, CBzoneLength, CDretry)
CDretry:
   [
   if zone>>CBZ.errorCount ge disk>>DSK.retryCount rshift 1 then
      [
      //having trouble checking header, try writing it instead.
      //if this occurs more than 25 times then write all remaining headers.
      checkErrors = checkErrors+1
      action = DCwriteHLD
      ]
   let vda = zone>>CBZ.currentPage
   let iBad = 0
      [
      let cb = TFSGetCb(disk, zone)
      while buf!iBad ne 0 & vda ugr buf!iBad do iBad = iBad+1
      let useFp = (vda eq 0? table [ 0; 0; 0 ],  // page 0
       (vda eq buf!iBad? table [ -2; -2; -2 ],  // permanently bad
       freePageFp))  // normal, make it free
      TFSDoDiskCommand(disk, cb, buf, vda, useFp, vda, action)
      if checkErrors ls 25 then action = DCwriteLD
      if vda eq lastPage then break
      vda = vda+1
      ] repeat
   while zone>>CBZ.head ne 0 do TFSGetCb(disk, zone)
   ]  // end of CDretry
]