-- FILE: CoForkImpl.mesa Last Editor: Sturgis August 10, 1981 11:38 AM
-- Last Editor: Sturgis 26-Mar-82 14:30:18
-- Last Editor: Swinehart 7-Dec-81 13:09:57

DIRECTORY
RTOS USING[RegisterFrameChains, UnregisterFrameChains],
CoFork USING[],
PrincOps USING[ControlLink, FrameHandle, NullFrame, Port, StateVector],
Frame USING[GetReturnFrame, MyLocalFrame, SetReturnFrame];



CoForkImpl: PROGRAM IMPORTS RTOS, Frame EXPORTS CoFork =

BEGIN OPEN PrincOps, Frame;

nCoForks: LONG CARDINAL ← 0;
recentCoForkMeFrame: FrameHandle ← LOOPHOLE[0];
recentCallerFrame: FrameHandle ← LOOPHOLE[0];
recentConsumerFrame: FrameHandle ← LOOPHOLE[0];

CoForkMe: PUBLIC PROCEDURE RETURNS[--put--POINTER] =
BEGIN
NFramePointers: CARDINAL = 3;
FrameList: ARRAY [0..NFramePointers) OF UNSPECIFIED ← [@portA, @portB, @consumersFrame];
portA: PORT; -- this port is called by producer (sink) (put)
portB: PORT; -- this port is called by consumer (source) (get)

stopper: PROCEDURE = -- this procedure is called by the consumer to stop the producer
BEGIN
ehSatterthwaiteMemorialLocal0: INTEGER;
xNullRequest: StateVector;
IF FALSE THEN ehSatterthwaiteMemorialLocal0←3183;
xNullRequest ← STATE;
nullRequest ← xNullRequest;
consumerHasRequestedTermination ← TRUE;
consumersFrame ← GetReturnFrame[];
SetReturnFrame[forkMeFrame]; -- now return to forkMe
END;

forkMeFrame: FrameHandle ← MyLocalFrame[];
caller: FrameHandle ← GetReturnFrame[];
callersCaller: ControlLink ← caller.returnlink;

nullItem: StateVector;
nullRequest: StateVector;
throwAway: StateVector;

consumerHasRequestedTermination: BOOLEAN ← FALSE;
consumersFrame: FrameHandle ← LOOPHOLE[0];

fakedNoParameterReturnState: StateVector;

-- some debug info;
nCoForks ← nCoForks + 1;
recentCoForkMeFrame ← forkMeFrame;
recentCallerFrame ← caller;
recentConsumerFrame ← LOOPHOLE[callersCaller];

-- cross link the ports, and set first words to 0
LOOPHOLE[portA, Port].dest ← LOOPHOLE[@portB];
LOOPHOLE[portA, Port].frame ← LOOPHOLE[0];
LOOPHOLE[portB, Port].dest ← LOOPHOLE[@portA];
LOOPHOLE[portB, Port].frame ← LOOPHOLE[0];

-- register our frame holding cells
RTOS.RegisterFrameChains[DESCRIPTOR[LOOPHOLE[@FrameList, POINTER TO ARRAY OF POINTER TO FrameHandle], NFramePointers]];

-- rig caller to return to our frame (for final termination of producer), and put a NullFrame in our return link so that signals will work correctly. NOTE: when converting to Cedar, must be sure that 1) never a loop in the return pointers, and 2) all frames are always pointed to. This may require hanging the caller off a port for a short period.
SetReturnFrame[NullFrame]; -- caller’s frame is pointed to by "caller". set to nullFrame so that next line does not form a loop
caller.returnlink ← LOOPHOLE[forkMeFrame]; -- caller’s caller is pointed to by "callersCaller".


-- now return to the caller through the source port and deliver the sink port
LOOPHOLE[portB, Port].frame ← LOOPHOLE[0, FrameHandle];
LOOPHOLE[portA, Port].frame ← caller;
LOOPHOLE[@portB, POINTER TO PORT[POINTER TO PORT]][@portA];
nullItem ← STATE; -- caller calls us back (through the sink port) with the value of a null item

-- now fake a return to the caller of the caller (consumer), with the port and procedure that the consumer is expecting from the caller
LOOPHOLE[callersCaller, PROCEDURE[POINTER TO PORT, PROCEDURE]][@portB, stopper];
throwAway ← STATE; -- if a producer returned, then we just received garbage return parameters

-- there are two ways to get here: the producer returned (and the consumer has not called the stopper), or the consumer called the stopper
IF consumerHasRequestedTermination THEN
BEGIN -- the consumer called the stopper, so we want to feed the final consumer item to the producer until the producer returns
-- rig the caller to return through the port
caller.returnlink ← LOOPHOLE[@portB]; -- preceeding value of caller.returnLink was forkMeFrame, which is now known by the process since we are running
WHILE LOOPHOLE[portA, Port].frame # LOOPHOLE[0, FrameHandle] DO
nullRequest.source.frame ← NullFrame;
nullRequest.dest.frame ← MyLocalFrame[];
TRANSFER WITH nullRequest; -- puts null request on stack
(@portB)[];
throwAway ← STATE;
ENDLOOP;
-- now the producer has returned to us, so make final return to consumer with no return arguments
fakedNoParameterReturnState.instbyte ← 0;
fakedNoParameterReturnState.stkptr ← 0;
fakedNoParameterReturnState.dest.frame ← consumersFrame;
fakedNoParameterReturnState.source.frame ← NullFrame;
END
ELSE
BEGIN -- the producer returned, so we want to feed the null item to the consumer until he calls the stopper
WHILE NOT consumerHasRequestedTermination DO
nullItem.source.frame ← NullFrame;
nullItem.dest.frame ← MyLocalFrame[];
TRANSFER WITH nullItem; -- puts null item on stack
LOOPHOLE[@portB, PROCEDURE][]; -- so that the return from stopper will not runinto a PortI
throwAway ← STATE;
ENDLOOP;
-- now the consumer has called termination, so return to consumer with no result params
IF LOOPHOLE[forkMeFrame, POINTER TO CARDINAL]↑ = 0 THEN ERROR;
fakedNoParameterReturnState.instbyte ← 0;
fakedNoParameterReturnState.stkptr ← 0;
fakedNoParameterReturnState.dest.frame ← consumersFrame;
fakedNoParameterReturnState.source.frame ← NullFrame;
END;

-- Deregister our frame holding cells
SetReturnFrame[consumersFrame]; -- so that when the cells are deregisterd, the consumer is still accessable
RTOS.UnregisterFrameChains[DESCRIPTOR[LOOPHOLE[@FrameList, POINTER TO ARRAY OF POINTER TO FrameHandle], NFramePointers]];
RETURN WITH fakedNoParameterReturnState;
END;


END.


--MODULE HISTORY

--Initial by: Sturgis, July 20, 1981 5:25 PM
-- remark: July 22, 1981 4:01 PM: first version of ForkMe works, in environment of tokenizer, and charSource. Tried it with chars running out first, and with requests for tokens stopping first. Had lots of trouble trying to fake Port calls using "Transfer With". Never got them to work, so I invented SetState, which I call to load the evaluation stack just before calling a port. Now I am going to modify the interface so that MakeTokenizer (for example) defines both a nullItem and a nullRequest.
-- July 22, 1981 4:49 PM: well, that didn’t work, so modify back to old scheme. The problem is that ForkMe did not know how to define a null item, or any item, to return to the producer so that the producer could make a call defining said item.... Have to think about it a while.
-- July 23, 1981 1:57 PM: implementation code is edited into the file CoForkImpl.mesa
-- July 28, 1981 1:05 PM: add some debug info
-- RTE: July 28, 1981 4:11 PM: basic problem: CoForkMe called out through a port, and someone returned to him via an ordinary procedure return. Result is that the waiting PortI zeroed the first word of CoForkMes frame. Repaired this by arranging to fake a procedure call through the appropriate ports when needed.