// FtpUtilXfer.bcpl - Block Transfer routines for disk streams
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified July 21, 1982  5:41 PM by Boggs

get "Pup.decl"
get "FtpProt.decl"
get "AltoFileSys.d"
get "Disks.d"

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

// incoming procedures
Zero; MoveBlock; FTPM; DataIsBinary
DoubleIncrement; DoubleDifference; DoubleAdd
MulPlus32x16; Divide32x16
Resets; Endofs; Gets; Puts; Wss; PutTemplate; ReadCalendar
ReadBlock; WriteBlock; FilePos; SetFilePos; CurrentPos
FileLength; LnPageSize; GetCurrentFa; JumpToFa
BSPReadBlock; BSPWriteBlock; BSPPutMark; BSPGetMark; BSPForceOutput

// incoming statics
CtxRunning; ftpDisk
]

structure Byte↑1,1 byte

//-----------------------------------------------------------------------------------------
let PrintBegin(pl) be
//-----------------------------------------------------------------------------------------
[
test pl>>PL.TYPE eq Text
   ifso
      [
      Wss(CtxRunning>>FtpCtx.lst, "Type Text")
      if pl>>PL.EOLC eq Transparent then Wss(CtxRunning>>FtpCtx.lst, ", EOL Transparent")
      ]
   ifnot PutTemplate(CtxRunning>>FtpCtx.lst, "Type Binary, ByteSize $D", pl>>PL.BYTE)
Wss(CtxRunning>>FtpCtx.lst, "...")
]

//-----------------------------------------------------------------------------------------
and DiskToNet(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
PrintBegin(localPL)
let bspStream = CtxRunning>>FtpCtx.bspStream
let diskStream = CtxRunning>>FtpCtx.diskStream
let buffer = CtxRunning>>FtpCtx.buffer
let bytes = vec 1; Zero(bytes, 2)

FTPM(markHereIsFile)
let start = vec 1; ReadCalendar(start)
let itWentOK = valof
   [
   let fileBytes = ReadBlock(diskStream, buffer,
    CtxRunning>>FtpCtx.bufferLength) lshift 1
   FlipCursor()
   test fileBytes eq 0
      ifso resultis true
      ifnot
         [
         if (CurrentPos(diskStream) & 1) eq 1 then fileBytes = fileBytes -1
         DoubleIncrement(bytes, fileBytes)
         unless BSPWriteBlock(bspStream, buffer, 0, fileBytes) eq fileBytes resultis false
         if Endofs(diskStream) resultis true
         ]
   ] repeat

BSPForceOutput(CtxRunning>>FtpCtx.bspSoc)
let stop = vec 1; ReadCalendar(stop)
let bps = vec 1; MoveBlock(bps, bytes, 2)
MulPlus32x16(0, 8, bps)
Divide32x16(bps, DoubleDifference(stop, start))
PutTemplate(CtxRunning>>FtpCtx.lst, "$EUD bytes, $EUD bits/sec", bytes, bps)
resultis itWentOK
]

//-----------------------------------------------------------------------------------------
and NetToDisk(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
PrintBegin(remotePL)
let bspStream = CtxRunning>>FtpCtx.bspStream
let diskStream = CtxRunning>>FtpCtx.diskStream
let buffer = CtxRunning>>FtpCtx.buffer
let bytes = vec 1; Zero(bytes, 2)
let lnCharsPerPage = LnPageSize(diskStream)+1
let charsPerBuff = CtxRunning>>FtpCtx.bufferLength lshift 1

let lvExpectedBytes = lv remotePL>>PL.SIZE
if lvExpectedBytes!0 ne 0 % lvExpectedBytes!1 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+25 uls ftpDisk>>DSK.diskKd>>KDH.freePages &
    expectedPages uge 10 then
      [
      let filePos = vec 1; FilePos(diskStream, filePos)
      DoubleAdd(filePos, lvExpectedBytes)
      let currentFA = vec lFA; GetCurrentFa(diskStream, currentFA)
      FileLength(diskStream)  //jump to end
      SetFilePos(diskStream, filePos)
      JumpToFa(diskStream, currentFA)
      ]
   ]

let start = vec 1; ReadCalendar(start)
let itWentOK = valof
   [
   let fileBytes = BSPReadBlock(bspStream, buffer, 0, charsPerBuff)
   DoubleIncrement(bytes, fileBytes)
   FlipCursor()
   test fileBytes eq charsPerBuff
      ifso WriteBlock(diskStream, buffer, fileBytes rshift 1)
      ifnot
         [
         if fileBytes rshift 1 ne 0 then
            WriteBlock(diskStream, buffer, fileBytes rshift 1)
         if (fileBytes & 1) eq 1 then
            Puts(diskStream, buffer>>Byte↑fileBytes)
         resultis CtxRunning>>FtpCtx.bspSoc>>BSPSoc.markPending ne 0
         ]
   ] repeat

let stop = vec 1; ReadCalendar(stop)
let bps = vec 1; MoveBlock(bps, bytes, 2)
MulPlus32x16(0, 8, bps)
Divide32x16(bps, DoubleDifference(stop, start))
PutTemplate(CtxRunning>>FtpCtx.lst, "$EUD bytes, $EUD bits/sec", bytes, bps)
resultis itWentOK
]

//----------------------------------------------------------------------------------------
and FileType() = valof
//----------------------------------------------------------------------------------------
[
let filetype = Text
let diskStream = CtxRunning>>FtpCtx.diskStream
let buffer = CtxRunning>>FtpCtx.buffer
Resets(diskStream)
   [
   let filebytes = ReadBlock(diskStream, buffer,
    CtxRunning>>FtpCtx.bufferLength) lshift 1
   if (CurrentPos(diskStream) & 1) eq 1 then filebytes = filebytes-1
   if DataIsBinary(buffer, filebytes) then [ filetype = Binary; break ]
   if Endofs(diskStream) break
   ] repeat
Resets(diskStream)
resultis filetype
]

//-----------------------------------------------------------------------------------------
and FlipCursor() be
//-----------------------------------------------------------------------------------------
[
compileif alto then
   [
   manifest cursorBitMap = 431b
   for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
   ]
Puts(CtxRunning>>FtpCtx.dls, $!)
]