// IfsFtpXfer.bcpl - Block IO routines
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified November 22, 1981  12:22 PM by Taft

get "Pup.decl"
get "IfsFtpProt.decl"
get ecFileSystemFull, ecDiskError from "IfsDirs.decl"
get KDH, freePages, lFA from "AltoFileSys.d"
get DSK, diskKd from "Disks.d"

external
[
// outgoing procedures
DiskToDisk; NetToDisk; DiskToNet
FileType; FlipCursor

// incoming procedures
FTPM
LnPageSize; KsBufferAddress; KsGetDisk; FilePos; SetFilePos
SetDirty; CleanupDiskStream; CurrentPos; GetCurrentFa; JumpToFa
Endofs; Resets; PositionPtr
BSPWriteBlock; BSPReadBlock
DataIsBinary; Min; DoubleAdd; DoubleIncrement; ByteBlt
ReturnFrom; SysErr; MoveBlock

// incoming statics
offsetBSPStr; CtxRunning
]

manifest
[
ecDiskFull = 2413  // copied from Tfs.d, for Trident disks only
ecUnRecovDiskError = 2412
]

//----------------------------------------------------------------------------
let DiskToDisk(dStream, sStream, lvBytes; numargs na) = valof
//----------------------------------------------------------------------------
// Copies data from disk stream sStream to another disk stream dStream.
// lvBytes, if supplied, points to a 32-bit maximum byte count.
// Returns true normally, false if the source stream ran out before
//  the requested number of bytes were tranferred.
// Leaves the byte count equal to the number of bytes left to transfer.
[
let defBytes = vec 1; defBytes!0 = -1
if na ls 3 then lvBytes = defBytes

let dPageBytes = 2 lshift LnPageSize(dStream)
let sPageBytes = 2 lshift LnPageSize(sStream)
let dKsBuffer = KsBufferAddress(dStream)
let sKsBuffer = KsBufferAddress(sStream)

while lvBytes!0 ne 0 % lvBytes!1 ne 0 do
   [
   if Endofs(sStream) resultis false
   let dPos, sPos = CurrentPos(dStream), CurrentPos(sStream)
   let count = Min(dPageBytes-dPos, sPageBytes-sPos)
   if lvBytes!0 eq 0 & lvBytes!1 ge 0 then count = Min(count, lvBytes!1)
   PositionPtr(sStream, sPos+count, false)
   count = CurrentPos(sStream)-sPos
   PositionPtr(dStream, dPos+count)
   ByteBlt(dKsBuffer, dPos, sKsBuffer, sPos, count)
   if dPos+count eq dPageBytes then CleanupDiskStream(dStream)
   if sPos+count eq sPageBytes then CleanupDiskStream(sStream)
   DoubleIncrement(lvBytes, -count)
   ]

resultis true
]

//---------------------------------------------------------------------------
and NetToDisk(diskStream, bspStream, lvExpectedBytes; numargs na) = valof
//---------------------------------------------------------------------------
// Copies data from bspStream to diskStream.
// Returns IFS error code, or zero if OK.
// lvExpectedBytes, if supplied, is a pointer to a 32-bit count of the
// number of bytes expected; this is used as a hint to extend the file
// to the proper length (to speed data transfer) and need not be correct.
[
diskStream>>ST.error = NetToDiskError
let lnCharsPerPage = LnPageSize(diskStream)+1
let charsPerPage = 1 lshift lnCharsPerPage
let ksBuffer = KsBufferAddress(diskStream)

if na ge 3 & lvExpectedBytes ne 0 then
   [
   // extend file to the proper length if the expected amount of data
   // is worth our while and is not so great that we would risk
   // exhausting the file system.
   let expectedPages = lvExpectedBytes!0 lshift (16-lnCharsPerPage) +
    lvExpectedBytes!1 rshift lnCharsPerPage
   if expectedPages uge 3 & expectedPages uls 1000 & expectedPages+250 uls
    KsGetDisk(diskStream)>>DSK.diskKd>>KDH.freePages then
      [
      let filePos = vec 1; FilePos(diskStream, filePos)
      DoubleAdd(filePos, lvExpectedBytes)
      let currentFA = vec lFA; GetCurrentFa(diskStream, currentFA)
      SetFilePos(diskStream, filePos)
      JumpToFa(diskStream, currentFA)
      ]
   ]

   [ // repeat
   let pos = CurrentPos(diskStream)
   let netBytes = BSPReadBlock(bspStream, ksBuffer, pos, charsPerPage-pos)
   FlipCursor()
   if netBytes ne 0 then SetDirty(diskStream, true)
   PositionPtr(diskStream, pos+netBytes)
   if pos+netBytes ne charsPerPage break
   CleanupDiskStream(diskStream)
   ] repeat

diskStream>>ST.error = SysErr
resultis (bspStream-offsetBSPStr)>>BSPSoc.markPending? 0, ecNetToDisk
]

//---------------------------------------------------------------------------
and NetToDiskError(s, ec, par) be
//---------------------------------------------------------------------------
// If disk becomes full then just abort the transfer.
// Note that NetToDisk isn't the only context in which the disk can
//  overflow, but it is by far the most likely one and is therefore worth
//  protecting.  (In other cases, IFS will just go into Swat.)
[
if ec eq ecDiskFull then
   [  // Flush the stream up to the next mark
   let ksBuffer = KsBufferAddress(s)
   let charsPerPage = 2 lshift LnPageSize(s)
   while BSPReadBlock(CtxRunning>>FtpCtx.bspStream, ksBuffer, 0, charsPerPage) loop
   s>>ST.error = SysErr
   SetDirty(s, false)
   ReturnFrom(NetToDisk, ecFileSystemFull)
   ]
SysErr(s, ec, par)
]

//---------------------------------------------------------------------------
and DiskToNet(bspStream, diskStream, lvBytes; numargs na) = valof
//---------------------------------------------------------------------------
// Copies data from diskStream to bspStream.
// Returns IFS error code, or zero if OK.
// lvBytes, if supplied points to a 32-bit maximum byte count.
// Leaves the byte count equal to the number of bytes left to transfer.
[
let defBytes = vec 1; defBytes!0 = -1
if na ls 3 then lvBytes = defBytes
diskStream>>ST.error = DiskToNetError
let charsPerPage = 2 lshift LnPageSize(diskStream)
let ksBuffer = KsBufferAddress(diskStream)

FTPM(markHereIsFile)
while lvBytes!0 ne 0 % lvBytes!1 ne 0 do
   [
   let pos = CurrentPos(diskStream)
   let fileBytes = charsPerPage-pos
   if lvBytes!0 eq 0 & lvBytes!1 ge 0 then
      fileBytes = Min(fileBytes, lvBytes!1)
   PositionPtr(diskStream, pos+fileBytes, false)
   fileBytes = CurrentPos(diskStream)-pos
   if BSPWriteBlock(bspStream, ksBuffer, pos, fileBytes) ne fileBytes then
      resultis ecDiskToNet
   FlipCursor()
   DoubleIncrement(lvBytes, -fileBytes)
   if pos+fileBytes ls charsPerPage break
   CleanupDiskStream(diskStream)
   ]

diskStream>>ST.error = SysErr
resultis 0
]

//---------------------------------------------------------------------------
and DiskToNetError(s, ec, par) be
//---------------------------------------------------------------------------
// If a hard data error occurs then just abort the transfer.
[
if ec eq ecUnRecovDiskError then
   [
   s>>ST.error = SysErr
   ReturnFrom(DiskToNet, ecDiskError)
   ]
SysErr(s, ec, par)
]

//--------------------------------------------------------------------------
and FileType(diskStream) = valof
//--------------------------------------------------------------------------
// true = text; false = binary
[
let text = true
let charsPerPage = 2 lshift LnPageSize(diskStream)
let ksBuffer = KsBufferAddress(diskStream)
Resets(diskStream)

   [
   PositionPtr(diskStream, charsPerPage, false)
   let fileBytes = CurrentPos(diskStream)
   if DataIsBinary(ksBuffer, fileBytes) then [ text = false; break ]
   if fileBytes ls charsPerPage break
   CleanupDiskStream(diskStream)
   ] repeat

Resets(diskStream)
resultis text
]

//---------------------------------------------------------------------------
and FlipCursor() be
//---------------------------------------------------------------------------
[
manifest cursorBitMap = 431b
for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
]