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