// BFSWrite.Bcpl -- Routines to extend files. 
// Copyright Xerox Corporation 1979, 1981
// Last modified October 27, 1981  3:53 PM by Boggs

get "AltoFileSys.d"	// Definitions for structures in the file system
get "Disks.d"		// Definitions for the disk object
get "Bfs.d"		// Definitions for the Diablo 31/44 disk

// outgoing procedures
BFSWritePages; BFSAssignDiskPage

// incoming procedures from BFSBase.bcpl

// incoming procedures from the OS
InitializeDiskCBZ; GetDiskCb; DoDiskCommand
ActOnDiskPages; AssignDiskPage
VirtualDiskDA; RealDiskDA
ReadDDPage; LockDD; UnlockDD
MoveBlock; Zero; SetBlock

// incoming statics From BfsMl.Asm
freePageFp; freePageFid; oneBits
let BFSWritePages(disk, CAs, DAs, fp, firstPage, lastPage, lastAction,
  lvNumChars, lastNumChars, fixedCA, nil, errorRtn, nil, hintLastPage;
  numargs na) = valof
// Note that DAs!(firstpage-1) will be referenced except when the
//  label of firstPage doesn't need to be rewritten.
// The arguments following lastPage are optional, as for ActOnDiskPages
let numChars, firstNewPage = nil, nil
DefaultArgs(lv na, 6, 0, 0, BFSwordsPerPage*2, 0, nil,
 lv DefaultBfsErrorRtn, nil, 0)
if lastAction eq 0 then lastAction = DCwriteD
if lvNumChars eq 0 then lvNumChars = lv numChars

if lastAction ne -1 then
   // First proceed as for a read until there are no more
   //  preallocated pages to write into
   test DAs!firstPage eq fillInDA
      ifso firstNewPage = firstPage
         firstPage = ActOnDiskPages(disk, CAs, DAs, fp, firstPage,
          lastPage, DCwriteD, lvNumChars, lastAction, fixedCA, 0, errorRtn,
          false, hintLastPage)
         if firstPage eq lastPage & (lastAction ne DCwriteD %
          @lvNumChars eq lastNumChars) resultis lastPage
         firstNewPage = firstPage +1

   // code to assign more pages
      let sink = vec 256
      for i = firstNewPage to lastPage do
         DAs!i = AssignDiskPage(disk, DAs!(i-1))
         if DAs!i eq -1 then
            [ (@errorRtn)(errorRtn, 0, ecDiskFull) ] repeat
      ActOnDiskPages(disk, 0, DAs, freePageFp, firstNewPage,
       lastPage, DCreadLD, 0, 0, sink, CheckFreePage, errorRtn)
      for i = firstNewPage to lastPage do
         DAs!firstNewPage = DAs!i
         if DAs!i ne fillInDA then firstNewPage = firstNewPage +1
      ] repeatuntil firstNewPage gr lastPage
// BFSWritePages (cont'd)

// All the pages have been checked.  Write labels and data.
// The CB zone resues the same stack space as the sink vector.
@lvNumChars = lastNumChars
let cbz = vec CBzoneLength
InitializeDiskCBZ(disk, cbz, firstPage, CBzoneLength, Wretry, errorRtn)

   for i = cbz>>CBZ.currentPage to lastPage do
      let cb = GetDiskCb(disk, cbz)

      // Set up eofDA as the page after the end of the file
      if ((i eq lastPage & lastNumChars ne BFSwordsPerPage*2) %
       (DAs!(i+1) eq fillInDA)) then DAs!(i+1) = eofDA

      // Set up label to be written on this page
      RealDiskDA(disk, DAs!(i+1), lv cb>>CB.label.next)
      RealDiskDA(disk, DAs!(i-1), lv cb>>CB.label.previous)
      cb>>CB.label.numChars = i eq lastPage? lastNumChars, BFSwordsPerPage*2

      DoDiskCommand(disk, cb, (fixedCA ne 0? fixedCA, CAs!i),
       DAs!i, fp, i, DCwriteLD)
   while cbz>>CBZ.head ne 0 do GetDiskCb(disk, cbz)
   ]  //End of Wretry block

resultis lastPage

and CheckFreePage(disk, cb, cbz) be
let fid = lv cb>>CB.labelAddress>>DL.fileId
for i = 0 to lFID-1 do if fid!i ne freePageFid!i then  //oop! bit table lied
   (cbz>>CBZ.DAs)!(cb>>CB.truePageNumber) = fillInDA
and BFSAssignDiskPage(disk, vda, nil; numargs na) = valof
// Assigns in a sequential manner, in order of increasing
//  virtual disk address.  Second argument is the 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.  The idea is to reduce bit table
//  scanning time and also page in/outs.
// Returns -1 if the bit table is full; else the VDA of the page assigned.
// Special three-argument for does not really do an assignment.
// Returns false if VDA+1 is assigned; true if it is available.
let ddMgr = disk>>BFSDSK.ddMgr
LockDD(ddMgr, disk)
vda = vda eq eofDA? disk>>BFSDSK.lastPageAlloc, vda+1

// The first lKDHeader words of DD aren't bit table bits
vda = vda + bitTableBias

// May have to do as many as n+2 iterations,
// where n is the number of bit table pages.
let diskBTsize = disk>>BFSDSK.diskBTsize
for i = 1 to (diskBTsize+lKDHeader) rshift BFSlnWordsPerPage +3 do
   // At top of loop: vda = VDA to be examined next.
   if vda<<VDA.wordNum ge diskBTsize+lKDHeader then
      vda = bitTableBias // Wrap around
   let pa = vda<<VDA.pageNum
   let diskBTaddr = ReadDDPage(ddMgr, disk, pa+1)
   // Test the bit corresponding to "vda".  If it fails, test the remainder
   // of the word one bit at a time.
   let wa = vda<<VDA.wordNumInPage
   let bitMask = oneBits!(vda<<VDA.bitNum)
      let free = ((diskBTaddr!wa) & bitMask) eq 0
      if na eq 3 then [ UnlockDD(ddMgr, disk); resultis free ]
      if free then
         vda = vda - bitTableBias
         diskBTaddr!wa = (diskBTaddr!wa) % bitMask
         disk>>BFSDSK.freePages = disk>>BFSDSK.freePages-1
         disk>>BFSDSK.lastPageAlloc = vda
         UnlockDD(ddMgr, disk, true)  //mark bt page dirty
         resultis vda
      bitMask = bitMask rshift 1
      vda = vda+1
      ] repeatuntil bitMask eq 0
   // Now search the rest of the page one word at a time.
   // On the last page we may run past the end of real data, but that's ok
   // because on the next pass vda will be wrapped around to zero.
   wa = wa+1 repeatuntil wa ge BFSwordsPerPage % diskBTaddr!wa ne -1

   // wa now addresses a word containing other than -1 if one was found.
   // wa eq BFSwordsPerPage otherwise.
   vda = (pa lshift BFSlnWordsPerPage + wa) lshift 4

UnlockDD(ddMgr, disk)
resultis -1  // Bit table full