// DiskStreamsMain.bcpl
// Copyright Xerox Corporation 1979
// Last modified December 9, 1979  2:46 PM by Taft

//This module contains the 'main line' code which is called whenever
// the stream buffer overflows or underflows.
//It does NOT call DiskStreams.bcpl or DiskStreamsAux.bcpl

get "DiskStreams.decl"

external
[
// outgoing procedures
FixupDiskStream; CleanupDiskStream
SetLengthHint; MustBeKs
ReadBlock; WriteBlock
TransferPages; PosPtr; PositionPtr

// incoming procedures from diskStreams.bcpl
AccessError

// incoming procedures from FastStreamsB.bcpl
SetupFstream; SetEof
CurrentPos; Dirty; SetDirty

// incoming procedures from Calls.asm
Endofs; Errors; ActOnDiskPages; WriteDiskPages

// incoming procedures BfsMl.asm
MoveBlock; Zero; Usc; RetryCall; Umin

// incoming procedures from miscellaneous
DefaultArgs; Dvec; SysErr
]

//----------------------------------------------------------------------------
let FixupDiskStream(s, datum) be
//----------------------------------------------------------------------------
// This routine should only be called from the fast stream Gets,
// Puts or Endofs. It always retries its call.
[
CleanupDiskStream(s, true)
if CurrentPos(s) ge s>>KS.numChars then
   [
   // ran into end of file (reason for ge test is to read
   // char file in word mode)
   SetEof(s, true)
   SetupFstream(s, s>>KS.bufferAddress, CurrentPos(s), s>>KS.charsPerPage)
   ]
RetryCall(s, datum)
]

//----------------------------------------------------------------------------
and CleanupDiskStream(s, dontFlush; numargs na) be
//----------------------------------------------------------------------------
// Make the disk state of the file reflect the current state
// of the stream.  This includes advancing the stream to the next page
// of the file (creating it if appropriate) if the stream is now positioned
// at the end of the current page.
// If dontFlush=true (default false) then don't flush a dirty page to the disk
// unless we are advancing to the next page.
[
// Update numChars if we have written past the current end-of-file.
// Use PosPtr for all numChars changes to be sure to check
// not extending an odd-length file just because read in word mode
let pos = CurrentPos(s)
if s>>KS.numChars ls pos then PosPtr(s, pos)

// If we are now positioned at end-of-page, or the current page is full
// and is the last page of the file, then call TransferPages with np=1
// to cause the current page to be flushed (if dirty) and the next page
// to be created (if necessary) and read in.
// Otherwise, just flush the current page (if dirty and not dontFlush) by
// calling TransferPages with np=0, which does not advance to the next page.
test pos eq s>>KS.charsPerPage %
 (s>>KS.numChars eq s>>KS.charsPerPage & s>>KS.DAs.next eq eofDA & Dirty(s))
   ifso
      [
      // The only reason for the following Dirty test is to avoid writing
      // possibly damaged data into a read-only file.
      TransferPages(s, 0, 1, (Dirty(s)? WriteDiskPages, ActOnDiskPages))

      // If we got here because the page was full and was the last page
      // of the file then we are now positioned at the wrong page, so
      // we have to back up one page and restore our previous position.
      if pos ne s>>KS.charsPerPage then
         [ TransferPages(s, 0, -1, ActOnDiskPages); PosPtr(s, pos) ]
      ]
   ifnot if Dirty(s) & (na ls 2 % not dontFlush) then
      [
      TransferPages(s, 0, 0, WriteDiskPages, false, 0, s>>KS.numChars)
      PosPtr(s, pos)
      ]
]

//----------------------------------------------------------------------------
and SetLengthHint(s) be
//----------------------------------------------------------------------------
// Updates the length hint if stream is now positioned at end-of-file.
// Does nothing if not at end-of-file.
[
if s>>KS.DAs.next eq eofDA &
 (s>>KS.hintLastPageFa.da ne s>>KS.DAs.current %
 s>>KS.hintLastPageFa.pageNumber ne s>>KS.pageNumber %
 s>>KS.hintLastPageFa.charPos ne s>>KS.numChars) then
   [
   s>>KS.hintLastPageFa.da = s>>KS.DAs.current
   s>>KS.hintLastPageFa.pageNumber = s>>KS.pageNumber
   s>>KS.hintLastPageFa.charPos = s>>KS.numChars
   s>>KS.lengthChanged = true
   ]
]

//----------------------------------------------------------------------------
and MustBeKs(s) be
//----------------------------------------------------------------------------
   if s>>KS.fs.type ne stTypeDisk then SysErr(s, ecNotKs)

//----------------------------------------------------------------------------
and WriteBlock(s, addr, length) =
//----------------------------------------------------------------------------
   ReadBlock(s, addr, length, WriteDiskPages)

//----------------------------------------------------------------------------
and ReadBlock(s, addr, length, TransferFn ; numargs na) = valof
//----------------------------------------------------------------------------
[
// returns the number of words transferred
// legal only on streams positioned on a word boundary
if na ls 4 then TransferFn = ActOnDiskPages
let read = TransferFn eq ActOnDiskPages
MustBeKs(s)
let lnWpp = s>>KS.lnCharsPerPage-1
let wordsPerPage = s>>KS.charsPerPage rshift 1
if (CurrentPos(s) & 1) ne 0 then Errors(s, ecNotWordS)

let done = 0
while done ne length do
   [
   let left = length-done
   let wordPos = CurrentPos(s) rshift 1
   let wordsInBuffer =
    (read? (s>>KS.numChars+1) rshift 1, wordsPerPage) - wordPos
   let count = Umin(wordsInBuffer, left)

   PosPtr(s, (wordPos+count)*2, not read)  //'not read' u/b 'true'
   test read ne 0
      ifso
         [
         //if s>>KS.type eq ksTypeWriteOnly then AccessError(s)
         MoveBlock(addr, s>>KS.bufferAddress+wordPos, count)
         if (s>>KS.numChars ne s>>KS.charsPerPage) & Endofs(s) then
            resultis done + count
         ]
      ifnot 
         [
         if s>>KS.type eq ksTypeReadOnly then AccessError(s)
         MoveBlock(s>>KS.bufferAddress+wordPos, addr, count)
         SetDirty(s, true)
         ]

   if (left-count) ne 0 then
      count = count +
       TransferPages(s, addr+count, (left-count) rshift lnWpp,
        TransferFn) lshift lnWpp
   addr = addr + count; done = done + count
   ]
resultis done
]

//----------------------------------------------------------------------------
and TransferPages(s, addr, np, TransferFn, returnOnCheckError,
 action, lastActionOrNumChars; numargs na) = valof
//----------------------------------------------------------------------------
// Transfer np pages (or fewer if the file runs out while reading),
// starting at addr in memory and the current position in the file.
// Leave the next page in the buffer, with the stream set up before
// the first character.  In the case of a write, the next page is
// read into the buffer, not written; if the file is extended, the
// buffer is zeroed and numChars set to 0.  Returns the number of
// pages transferred to addr, i.e. not counting the last one which
// was read into the buffer.  It is legal to call TransferPages
// when the buffer is either full or empty -- use ReadBlock/WriteBlock
// otherwise.
// NOTE: only this routine and TruncateDiskStream call the bfs.

// The last three arguments are for special uses, which cannot be
// described as a simple transfer of words between the stream and
// memory; don't supply them unless you know what you are doing:
//   addr=0 forces all transfers to be into the buffer - convenient
//     for positioning operations and for buffered transfers.
//     Warning: it suppresses the CleanupDiskStream which is
//     otherwise done.
//   TransferPages can be called with np eq 0 to just transfer one
//     page to or from the buffer, or with np eq -1 to transfer
//     page pageNumber-1
[
MustBeKs(s)
// Default only missing arguments, not zeroes
DefaultArgs(lv na, 1, 0, 1, WriteDiskPages, false, DCreadD, 0)

// make sure that buffer gets flushed properly if the transfer
// won't do it in the ordinary course of events
test TransferFn eq ActOnDiskPages & action ne DCwriteD
   ifso if Dirty(s) then CleanupDiskStream(s)
   ifnot unless s>>KS.pageNumber eq 0 do s>>KS.oldWriteDate.h = 0

let firstTransferBuffer = 0
let wordsPerPage = s>>KS.charsPerPage rshift 1
let pn = s>>KS.pageNumber
let b = s>>KS.bufferAddress

// an extra page is xferred if the page is not dirty; costs 3 ms.
if addr ne 0 & CurrentPos(s) eq s>>KS.charsPerPage then
   [
   firstTransferBuffer = 1
   addr = addr - wordsPerPage
   np = np +1
   ]
PosPtr(s)

let backup = (np eq -1); if backup then [ pn = pn -1; np = 0 ]
let lastPn = pn + np

let CAs = np+3; let DAs = np+3
Dvec(TransferPages, lv CAs, lv DAs)
CAs = CAs - (pn-1); DAs = DAs - (pn-1)

for i = pn-1 to lastPn+1 do
   [
   CAs!i = (addr eq 0 ? b, addr+(i-pn)*wordsPerPage)
   DAs!i = fillInDA
   ]
CAs!lastPn = b
if firstTransferBuffer ne 0 then CAs!pn = b
MoveBlock(lv DAs!(backup ? pn, pn-1), lv s>>KS.DAs.last, 3)

let i = TransferFn(s>>KS.disk, CAs, DAs, lv s>>KS.fp, pn, lastPn,
 action, lv s>>KS.numChars, lastActionOrNumChars, 0, 0,
 lv s>>KS.bfsErrorRtn, returnOnCheckError, s>>KS.hintLastPageFa.pageNumber)

// error check is for TransferFn result outside of [pn..lastPn]
if returnOnCheckError & Usc(i-pn, lastPn-pn) gr 0 resultis -1
if s>>KS.numChars eq 0 then Zero(b, wordsPerPage)

// the next line can only be executed when reading
if i ne lastPn then MoveBlock(b, CAs!i, wordsPerPage)

// Update state in stream to reflect last page transferred.
s>>KS.pageNumber = i
MoveBlock(lv s>>KS.DAs.last, lv DAs!(i-1), lKSDAs)
SetLengthHint(s)
SetupFstream(s, b, 0, s>>KS.numChars)
SetDirty(s, false)
resultis i-pn-firstTransferBuffer
]

//----------------------------------------------------------------------------
and PositionPtr(s, newPos, extend; numargs na) = valof
//----------------------------------------------------------------------------
[
if Usc(newPos, s>>KS.charsPerPage) gr 0 then
   Errors(s, ecPosOutsidePage)
resultis PosPtr(s, newPos, na ls 3 % extend)
]

//----------------------------------------------------------------------------
and PosPtr(s, newPos, extend; numargs na) = valof
//----------------------------------------------------------------------------
// Returns true if it wanted to extend the file but was told not to
// (in which case the pointer is left positioned to the current end-of-file).
// Must have 0 <=newPos<=charsPerPage; newPos is truncated by itemSize.
// This routine does no disk transfers.
// It is called from several places
// Default newPos = 0; default extend = false
[
if na eq 1 then newPos = 0
let wantedToExtend = false

// Skip all the eof checking if this is not the last page of the file.
if s>>KS.DAs.next eq eofDA then
   [
   let okExtend = s>>KS.type ne ksTypeReadOnly
   if na ls 3 % okExtend eq false then extend = false

   let pos = CurrentPos(s)
   if pos gr s>>KS.numChars & okExtend ne 0 & Dirty(s) then
      s>>KS.numChars = pos

   if newPos gr s>>KS.numChars then
      [
      test extend
         ifso [ s>>KS.numChars = newPos; SetDirty(s, true) ]
         ifnot [ newPos = s>>KS.numChars; wantedToExtend = true ]
      SetLengthHint(s)
      ]
   ]

// If we are at eof, SetupFstream will deal with it
SetEof(s, false)
SetupFstream(s, s>>KS.bufferAddress, newPos, s>>KS.numChars)
resultis wantedToExtend
]