// TfsWrite.Bcpl -- WriteDiskPages and AssignDiskPage procedures
// Copyright Xerox Corporation 1979, 1980, 1981

//	Last modified January 14, 1981  2:59 PM by Taft

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

external
[
// procedures defined here
TFSWritePages
TFSAssignDiskPage

// defined elsewhere
ActOnDiskPages
AssignDiskPage
RealDiskDA
TFSInitializeCbStorage
TFSGetCb
TFSDoDiskCommand
DefaultTFSErrorRtn
TFSIncrement
MoveBlock
DefaultArgs
Dvec
ReadDDPage
LockDD
UnlockDD

// statics defined elsewhere
freePageFp
freePageFid
oneBits
]

//----------------------------------------------------------------------------
let TFSWritePages(disk, CAs, DAs, fp, firstPage, lastPage, lastAction,
    lvNumChars, lastNumChars, fixedCA, nil, errorRtn, nil, hintLastPage;
    numargs na) = valof
//----------------------------------------------------------------------------
// See WriteDiskPages description in BFS section of O.S. manual.
// 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 = nil; let firstNewPage = nil
DefaultArgs(lv na, 6, 0, 0, TFSwordsPerPage*2, 0, nil,
 lv DefaultTFSErrorRtn, nil, 0)
if lastAction eq 0 then lastAction = DCwriteD
if lvNumChars eq 0 then lvNumChars = lv numChars

if lastAction ne -1 then
   [
   // Rewrite all existing pages
   test DAs!firstPage eq fillInDA
      ifso firstNewPage = firstPage
      ifnot
         [
         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
      [
      for i = firstNewPage to lastPage do
         [
         DAs!i = AssignDiskPage(disk, DAs!(i-1))
         if DAs!i eq -1 then
            (@errorRtn)(errorRtn, disk>>DSK.driveNumber, ecDiskFull)
         ]

      // Check that the assigned pages are really free
      let errorRtnVec = vec 1
      errorRtnVec!0 = CheckFreePageErr  // error routine for this call
      errorRtnVec!1 = errorRtn  // my caller's error routine
      ActOnDiskPages(disk, 0, DAs, freePageFp, firstNewPage,
       lastPage, DCreadLnD, 0, 0, nil, CheckFreePage, errorRtnVec)
      for i = firstNewPage to lastPage do
         [
         DAs!firstNewPage = DAs!i
         if DAs!i ne fillInDA then firstNewPage = firstNewPage+1
         ]
      ] repeatuntil firstNewPage-lastPage gr 0
   ]

// TFSWritePages (cont'd)

// All the pages have been checked.  Write labels and data.
// Create the CBZ dynamically so as not to have two of them (~250 words each)
// on the stack during the preceding calls to TFSActOnPages.
@lvNumChars = lastNumChars  //lvNumChars may be invalidated by Dvec
let cbz = CBzoneLength
Dvec(TFSWritePages, lv cbz)
TFSInitializeCbStorage(disk, cbz, firstPage, CBzoneLength, Wretry, errorRtn)

Wretry:
   [
   for i = cbz>>CBZ.currentPage to lastPage do
      [
      let cb = TFSGetCb(disk, cbz)

      // Set up eofDA as the page after the end of the file
      if ((i eq lastPage & lastNumChars ne TFSwordsPerPage*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, TFSwordsPerPage*2

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

resultis lastPage
]

//----------------------------------------------------------------------------
and CheckFreePage(disk, cb, cbz) be
//----------------------------------------------------------------------------
[
let fid = lv cb>>CB.AddrL>>DL.fileId
for i = 0 to lFID-1 do if fid!i ne freePageFid!i then
   [
   (cbz>>CBZ.DAs)!(cb>>CB.truePageNumber) = fillInDA
   TFSIncrement(lv disk>>TFSDSK.nBTErrors)
   ]
]

//----------------------------------------------------------------------------
and CheckFreePageErr(errorRtnVec, cb, ec) be
//----------------------------------------------------------------------------
// Error routine called when checking free pages.
// If we get an unrecoverable data error, just ignore the bad page and
// plunge on (TFSWritePages will assign another page instead).
// Call the normal error error routine for other errors.
[
test ec eq ecUnRecovDiskError
   ifso (cb>>CB.cbz>>CBZ.DAs)!(cb>>CB.truePageNumber) = fillInDA
   ifnot (@(errorRtnVec!1))(errorRtnVec!1, cb, ec)
]

//----------------------------------------------------------------------------
and TFSAssignDiskPage(disk, vda, nil; numargs na) = valof
//----------------------------------------------------------------------------
// See AssignDiskPage description in BFS section of O.S. manual.
// Assigns in a sequential manner, in order of increasing
// virtual disk addresses.  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.  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 form does not really to an assignment --
// returns 0 if VDA+1 is assigned; true if it is available
[
let ddMgr = disk>>TFSDSK.ddMgr
LockDD(ddMgr, disk)
vda = vda eq eofDA? disk>>TFSDSK.lastPageAlloc, vda+1

// May have to do as many as n+2 iterations, where n is the number of
// bit table pages.
for i = 1 to (disk>>TFSDSK.diskBTsize rshift TFSlnWordsPerPage)+3 do
   [
   // At top of loop: vda = VDA to be examined next.
   if vda<<VDA.wordNum ge disk>>TFSDSK.diskBTsize then vda = 0 // Wrap around
   let pa = vda<<VDA.pageNum
   let diskBTaddr = ReadDDPage(ddMgr, disk, pa+lengthTFSDDpreamble)
   
   // 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
         [
         diskBTaddr!wa = (diskBTaddr!wa) % bitMask
         disk>>TFSDSK.freePages = disk>>TFSDSK.freePages-1
         disk>>TFSDSK.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 TFSwordsPerPage % diskBTaddr!wa ne -1

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

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