// FtpUtilDmpLd.bcpl - Dump and Load procedures
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 13, 1982  1:25 PM by Boggs

get "FtpProt.decl"

external
[
// outgoing procedures
DumpToNet; LoadFromNet

// incoming procedures
MoveBlock; Zero
DoubleDifference; DoubleIncrement
FlipCursor; FreePointer; ExtractSubstring
Resets; Endofs; Gets; Puts; Wss; PutTemplate
BSPReadBlock; BSPWriteBlock; ReadLeaderPage
ReadBlock; WriteBlock; CurrentPos; FilePos; FileLength

// incoming statics
CtxRunning
]

static leftOver		// used by LoadFromNet

structure Byte↑1,1 byte

structure String [ length byte; char↑1,1 byte ]

manifest
[
nameBlock = 377b
dataBlock = 376b
errorBlock = 375b
endBlock = 374b
dateBlock = 373b
]

//-----------------------------------------------------------------------------------------
let DumpToNet(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let bspStream = CtxRunning>>FtpCtx.bspStream
if remotePL eq 0 resultis Puts(bspStream, endBlock)
let diskStream = CtxRunning>>FtpCtx.diskStream
let buffer = CtxRunning>>FtpCtx.buffer

Puts(bspStream, nameBlock)
Puts(bspStream, 0)  //attributes (not implemented)
Puts(bspStream, 0)  //attributes (not implemented)
BSPWriteBlock(bspStream, localPL>>PL.NAMB, 1, localPL>>PL.NAMB>>String.length)
Puts(bspStream, 0)  //name end (asciz)
Puts(bspStream, dateBlock)
BSPWriteBlock(bspStream, lv localPL>>PL.CDAT, 0, 6)

let bytes = vec 1; Zero(bytes, 2)
let fileLength = vec 1; FileLength(diskStream, fileLength)
let filePos = vec 1
Resets(diskStream)

let res = valof
   [
   FilePos(diskStream, filePos)
   // To get around a Nova Dos bug, do not allow the last
   //  data block to contain one byte.
   let bl = DoubleDifference(fileLength, filePos) eq 257? 127, 128
   let fileBytes = ReadBlock(diskStream, buffer+2, bl) lshift 1
   test fileBytes gr 0
      ifso
         [
         FlipCursor()
         if (CurrentPos(diskStream) & 1) eq 1 then
            fileBytes = fileBytes-1
         DoubleIncrement(bytes, fileBytes)
         Puts(bspStream, dataBlock)
         buffer!0 = fileBytes
         buffer!1 = fileBytes
         for i = 1 to fileBytes rshift 1 do
            buffer!1 = buffer!1 + buffer!(i+1)
         unless BSPWriteBlock(bspStream, buffer, 0, fileBytes+4) eq (fileBytes+4) resultis false
         if Endofs(diskStream) resultis true
         ]
      ifnot resultis true
   ] repeat

PutTemplate(CtxRunning>>FtpCtx.lst, "...$EUD bytes", bytes)
resultis res
]

//-----------------------------------------------------------------------------------------
and LoadFromNet(remotePL, localPL) = valof
//-----------------------------------------------------------------------------------------
[
let bspStream = CtxRunning>>FtpCtx.bspStream
let diskStream = CtxRunning>>FtpCtx.diskStream
let buffer = CtxRunning>>FtpCtx.buffer
let bytes = vec 1; Zero(bytes, 2)
let sawDataBlock = false

let res = valof
   [
   let type = leftOver; leftOver = 0
   if type eq 0 then type = Gets(bspStream)
   switchon type into
      [
      case dateBlock:
         [ BSPReadBlock(bspStream, buffer, 0, 6); loop ]
      case endBlock: resultis false
      case nameBlock:
         [  //discard attributes
         Gets(bspStream); Gets(bspStream)
         let count = 0
            [
            let char = Gets(bspStream)
            if char eq 0 break
            count = count+1
            buffer>>String.char↑count = char
            ] repeat
         buffer>>String.length = count
         FreePointer(lv remotePL>>PL.NAMB)
         remotePL>>PL.NAMB = ExtractSubstring(buffer)
         leftOver = Gets(bspStream)
         if leftOver eq dateBlock then
            [
            leftOver = 0
            BSPReadBlock(bspStream, buffer, 0, 6)
            MoveBlock(lv remotePL>>PL.CDAT, buffer, 2)
            ] 
         resultis true
         ]
      case dataBlock: [ sawDataBlock = true; endcase ]
      default:
         [
         Wss(CtxRunning>>FtpCtx.lst, "*NUnknown block type - Load aborted")
         resultis false
         ]
      ]

   // LoadFromNet (cont'd)

   let fileBytes = Gets(bspStream)
   fileBytes = fileBytes lshift 8 + Gets(bspStream)
   let checksum = Gets(bspStream)
   checksum = checksum lshift 8 + Gets(bspStream)
   unless BSPReadBlock(bspStream, buffer, 0, fileBytes) eq fileBytes resultis false
   let myChecksum = fileBytes
   if fileBytes gr 1 then
      for i = 0 to (fileBytes rshift 1)-1 do
         myChecksum = myChecksum + buffer!i
   if myChecksum ne checksum then
      Wss(CtxRunning>>FtpCtx.lst, "*NDump/Load checksum error...continuing")
   FlipCursor()
   if diskStream ne 0 then
      [
      WriteBlock(diskStream, buffer, fileBytes rshift 1)
      if (fileBytes & 1) eq 1 then
         Puts(diskStream, buffer>>Byte↑fileBytes)
      ]
   DoubleIncrement(bytes, fileBytes)
   ] repeat

if sawDataBlock test diskStream ne 0
   ifso PutTemplate(CtxRunning>>FtpCtx.lst, "...$EUD bytes", bytes)
   ifnot Wss(CtxRunning>>FtpCtx.lst, "...skipped")
resultis res
]