-- FTPPair.mesa, Edit: HGM July 31, 1980  5:23 PM  

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  FTPDefs,
  FTPPrivateDefs,
  String USING [AppendString];

FTPPair: PROGRAM 
  -- import list
    IMPORTS String, FTPDefs, FTPPrivateDefs
  -- export list
    EXPORTS FTPPrivateDefs
  -- share list
    SHARES FTPDefs, FTPPrivateDefs
  = BEGIN OPEN FTPDefs, FTPPrivateDefs; 


ForkTransferPair: PUBLIC PROCEDURE [fileSystem: FileSystem, readFile: PROCEDURE [FileSystem, FileHandle, PROCEDURE [UNSPECIFIED, POINTER, CARDINAL], UNSPECIFIED], srcFileHandle: FileHandle, writeFile: PROCEDURE [FileSystem, FileHandle, PROCEDURE [UNSPECIFIED, POINTER, CARDINAL] RETURNS [CARDINAL], UNSPECIFIED], dstFileHandle: FileHandle] =
  BEGIN
  -- Note:  Does NOT double buffer.
  -- input or output process
    IOProcess: PROCEDURE [input: BOOLEAN] =
      BEGIN
      -- catchphrase
        ENABLE UNWIND =>
          BEGIN
          abort ← TRUE;
          PostEvent[IF input THEN @outputBufferFull ELSE @outputBufferEmpty];
          END;
      -- SendBlock procedure
        SendBlock: PROCEDURE [unused: UNSPECIFIED, source: POINTER,
            byteCount: CARDINAL] =
          BEGIN
          -- fill output buffer
            sBPO ← [source, FALSE, byteCount];
          -- post full output buffer
            PostEvent[@outputBufferFull];
          -- await empty output buffer
            AwaitEvent[@outputBufferEmpty];
            IF abort THEN Abort[unidentifiedError];
          END;
      -- ReceiveBlock procedure
        ReceiveBlock: PROCEDURE [unused: UNSPECIFIED, destination: POINTER,
            maxWordCount: CARDINAL] RETURNS [actualByteCount: CARDINAL] =
          BEGIN
          -- local variables
            dBPO: BytePointerObject ←
              [destination, FALSE, bytesPerWord*maxWordCount];
          -- await full output buffer
            IF ~dataRemains THEN
              BEGIN
              AwaitEvent[@outputBufferFull];
              IF abort THEN Abort[unidentifiedError];
              END;
          -- empty output buffer
            TransferBytes[@sBPO, @dBPO];
            dataRemains ← sBPO.count # 0;
          -- notify empty output buffer
            IF ~dataRemains THEN PostEvent[@outputBufferEmpty];
          -- return actual byte count to caller
            actualByteCount ← bytesPerWord*maxWordCount - dBPO.count;
          END;
      -- read/write file
        IF input THEN readFile[fileSystem, srcFileHandle, SendBlock, NIL]
        ELSE writeFile[fileSystem, dstFileHandle, ReceiveBlock, NIL];
      END;
  -- local variables
    abort, dataRemains: BOOLEAN ← FALSE;
    outputBufferEmpty, outputBufferFull: EventObject;
    sBPO: BytePointerObject;
  -- prepare events
    PrepareEvent[@outputBufferEmpty];
    PrepareEvent[@outputBufferFull];
  -- transfer file
    ForkProcessPair[IOProcess, TRUE, FALSE];
  END;

ForkProcessPair: PUBLIC PROCEDURE [process: PROCEDURE [UNSPECIFIED], parameter1, parameter2: UNSPECIFIED] =
  BEGIN
  -- ProcessRoot procedure
    ProcessRoot: PROCEDURE [parameter: UNSPECIFIED, processMessage: STRING]
        RETURNS [processFtpError: FtpError] =
      BEGIN
      -- initialize outcome
        processFtpError ← ok;
      -- call process procedure
        process[parameter !
          FTPError =>
            BEGIN
            processFtpError ← ftpError;
            IF message # NIL THEN String.AppendString[processMessage, message];
            CONTINUE;
            END;
          ANY =>
            BEGIN
            ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];
            IF ftpsystem↑.catchUnidentifiedErrors THEN
              BEGIN
              processFtpError ← unidentifiedError;
              CONTINUE;
              END;
            END];
      END;
  -- local constants
    message1: STRING = [maxStringLength];
    message2: STRING = [maxStringLength];
  -- local variables
    ftpError1, ftpError2: FtpError;
    pH: PROCESS RETURNS [processFtpError: FtpError];
  -- fork one root procedure and call the other
    pH ← FORK ProcessRoot[parameter1, message1];
    ftpError2 ← ProcessRoot[parameter2, message2];
    ftpError1 ← JOIN pH;
  -- report (first) error if any
    IF ftpError1 # ok THEN AbortWithExplanation[ftpError1, message1];
    IF ftpError2 # ok THEN AbortWithExplanation[ftpError2, message2];
  END;


END.. -- FTPPair