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