-- 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