// DiskStreamsAux.bcpl -- Auxiliary disk stream functions
// Copyright Xerox Corporation 1979
// Last modified December 1, 1979  3:02 PM by Taft

// This module calls both DiskStreamMain and DiskStream

get "DiskStreams.decl"

external
[
// outgoing procedures
PositionPage; JumpToFa
FilePos; SetFilePos; FileLength
GetCurrentFa; GetCompleteFa

// incoming procedures from DiskStreamsMain.bcpl
TransferPages; CleanupDiskStream; PosPtr; PositionPtr

// incoming procedures from DiskStreams.bcpl
ResetKsState; ResetDiskStream

// incoming procedures from FastStreamsB.bcpl
CurrentPos

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

// incoming procedures BfsMl.asm
MoveBlock; Usc; Umin
]

//----------------------------------------------------------------------------
let JumpToFa(ks, fa, pnForPositionPage; numargs na) = valof
//----------------------------------------------------------------------------
// returns true if it succeeds
[
let didntMakeIt = true
CleanupDiskStream(ks)
PosPtr(ks)
ks>>KS.pageNumber = fa>>FA.pageNumber
ks>>KS.DAs.last = fillInDA
ks>>KS.DAs.current = fa>>FA.da
ks>>KS.DAs.next = fillInDA
if TransferPages(ks, 0, 0, ActOnDiskPages, true) ne 0 % fa>>FA.da eq -1 then
   [
   test na ls 3 
      ifso pnForPositionPage = fa>>FA.pageNumber
      ifnot fa>>FA.charPos = ks>>KS.charsPerPage
   if pnForPositionPage eq -1 then resultis false
   ResetKsState(ks)
   didntMakeIt = PositionPage(ks, pnForPositionPage, false)
   ]
didntMakeIt = didntMakeIt % PosPtr(ks, fa>>FA.charPos)
GetCurrentFa(ks, fa)
resultis not didntMakeIt
]

//----------------------------------------------------------------------------
and GetCurrentFa(ks, fa) be
//----------------------------------------------------------------------------
[
CleanupDiskStream(ks, true) //Make sure not at end of page
fa>>FA.da = ks>>KS.DAs.current
fa>>FA.pageNumber = ks>>KS.pageNumber
fa>>FA.charPos = CurrentPos(ks)
]

//----------------------------------------------------------------------------
and GetCompleteFa(ks, cfa) be
//----------------------------------------------------------------------------
[
GetCurrentFa(ks, lv cfa>>CFA.fa)
MoveBlock(lv cfa>>CFA.fp, lv ks>>KS.fp, lFP)
]

//----------------------------------------------------------------------------
and PositionPage(ks, destination, extend; numargs na) = valof
//----------------------------------------------------------------------------
// returns true if it wanted to extend the file but was told not to
[
if na ls 3 then extend = true

CleanupDiskStream(ks)
PosPtr(ks)
let d = nil
   [
   d = destination - ks>>KS.pageNumber
   if Usc(destination, ks>>KS.pageNumber) ge 0 break

   // moving backwards.  Unless the distance being moved is 1 or
   // less than 1/8 the distance to the beginning of the file,
   // it is best to do a reset
   unless d eq -1 % Usc(-d, ks>>KS.pageNumber rshift 3) ls 0 do
      [ ResetDiskStream(ks); loop ]
   CleanupDiskStream(ks)
   TransferPages(ks, 0, -1, ActOnDiskPages)
   ] repeat

// Do the following loop twice: once to advance past existing pages,
// and then again (if necessary) to extend the file.
// The TransferFn controls whether we are scanning or extending.
let TransferFn = ActOnDiskPages

   [ // repeat
   while d ne 0 do
      [
      let dBite = Umin(d, biteSize)
      let np = TransferPages(ks, 0, dBite, TransferFn)
      d = d-np
      if np ne dBite break
      ]
   
   if d eq 0 resultis false
   if not extend % ks>>KS.type eq ksTypeReadOnly resultis true
   
   // extend the file. The first TransferPages is to flush
   // and zero the buffer
   TransferPages(ks); d = d-1
   TransferFn = WriteDiskPages
   ] repeat
]

//----------------------------------------------------------------------------
and FilePos(ks, fpos; numargs na) = valof
//----------------------------------------------------------------------------
[
let v = vec 1; if na eq 1 % fpos eq 0 then fpos = v
// Make sure we aren't at the end of a page
CleanupDiskStream(ks, true)
let pn = ks>>KS.pageNumber -1
fpos>>FPOS.msAddr = pn rshift (16 - ks>>KS.lnCharsPerPage)
fpos>>FPOS.lsAddr = (pn lshift ks>>KS.lnCharsPerPage) + CurrentPos(ks)
resultis fpos>>FPOS.lsAddr
]

//----------------------------------------------------------------------------
and SetFilePos(ks, msAddr, lsAddr; numargs na) be
//----------------------------------------------------------------------------
[
let fpos = na gr 2? lv msAddr, msAddr

let lnCpp = ks>>KS.lnCharsPerPage
let pn = (fpos>>FPOS.msAddr lshift (16-lnCpp))+
 (fpos>>FPOS.lsAddr rshift lnCpp)+1
if pn ne ks>>KS.pageNumber then PositionPage(ks, pn)

PositionPtr(ks, (fpos>>FPOS.lsAddr) & (1 lshift lnCpp -1))
]

//----------------------------------------------------------------------------
and FileLength(ks, fpos; numargs na) = valof
//----------------------------------------------------------------------------
[
let fa = vec lFA; MoveBlock(fa, lv ks>>KS.hintLastPageFa, lFA)
unless Endofs(ks) do JumpToFa(ks, fa, maxPageNo)
// fa may not be end of file.  Check.  If not, do it the hard way.
unless Endofs(ks) do [ fa>>FA.da = -1; JumpToFa(ks, fa, maxPageNo) ]
// Endofs(ks) may not be true if a file written charItem is read wordItem.
resultis FilePos(ks, (na gr 1? fpos, 0))
]