DIRECTORY
Process USING [Abort, Detach, EnableAborts, GetCurrent],
RuntimeError USING [Resume, SendMsg],
SharedErrors USING [];

SharedErrorsImpl: CEDAR MONITOR LOCKS context USING context: SharedErrorContext
IMPORTS Process, RuntimeError
EXPORTS SharedErrors
~ BEGIN

PList : TYPE = LIST OF PROC;

SharedErrorContext: TYPE = REF SharedErrorContextObj;
SharedErrorContextObj: TYPE  = MONITORED RECORD[
processes: LIST OF ProcessContext,
parentWakeup: CONDITION,
childWakeup: CONDITION
];

PCList: TYPE = LIST OF ProcessContext;
ProcessContext: TYPE = REF ProcessContextObj;
ProcessContextObj: TYPE = RECORD [
process: PROCESS,
error: SIGNAL ANY RETURNS ANY,
args: POINTER,
results: POINTER,
done: BOOL
];

Fork: PUBLIC PROC [children: LIST OF PROC] ~ {
context: SharedErrorContext м NEW[SharedErrorContextObj];
InternalFork: ENTRY PROC [context: SharedErrorContext] ~ {
ENABLE UNWIND => {
alldone: BOOL м FALSE;
firstTime: BOOL м TRUE;
DO
alldone м TRUE;
FOR tc: PCList м context.processes, tc.rest UNTIL tc = NIL DO
IF ~tc.first.done THEN TRUSTED {
alldone м FALSE; 
IF firstTime THEN Process.Abort[tc.first.process] 
};
ENDLOOP;
IF alldone THEN EXIT;
firstTime м FALSE;
WAIT context.parentWakeup;
ENDLOOP;
};
allDone: BOOL м FALSE;

FOR tp: PList м children, tp.rest UNTIL tp = NIL DO
newProcess: PROCESS;
TRUSTED { UNCHECKED { newProcess м FORK Stopper[context, tp.first] }};
context.processes м CONS[
NEW[ProcessContextObj м [newProcess, NIL, NIL, NIL, FALSE]], 
context.processes]; 
TRUSTED { Process.Detach[newProcess] };
ENDLOOP;

UNTIL allDone DO
WAIT context.parentWakeup;
allDone м TRUE;
FOR tc: PCList м context.processes, tc.rest UNTIL tc = NIL DO
IF tc.first.error # NIL THEN TRUSTED {
RaiseSignal[tc.first.error, tc.first.results, tc.first.args];
tc.first.error м NIL;
BROADCAST context.childWakeup;
};
IF ~tc.first.done THEN allDone м FALSE;
ENDLOOP;
ENDLOOP;
};
TRUSTED {
Process.EnableAborts[@context.childWakeup];
Process.EnableAborts[@context.parentWakeup]
};
InternalFork[context];
};

Stopper: PROC [c: SharedErrorContext, p: PROC] ~ {
FindProcessContext: INTERNAL PROC [p: UNSAFE PROCESS] RETURNS [pc: ProcessContext] ~ {
FOR tc: PCList м c.processes, tc.rest UNTIL tc = NIL DO
IF tc.first.process = p THEN RETURN[tc.first]
ENDLOOP;
};

SetDone: ENTRY PROC [context: SharedErrorContext м c] ~ {
FindProcessContext[Process.GetCurrent[]].done м TRUE;
NOTIFY context.parentWakeup
};

CatchAndWait: ENTRY PROC [context: SharedErrorContext м c] ~ {
ENABLE UNWIND => NULL;
myId: UNSAFE PROCESS м Process.GetCurrent[];
myContext: ProcessContext м FindProcessContext[Process.GetCurrent[]];
TRUSTED  { [args: myContext.args, signal: myContext.error, results: myContext.results] м SIGNAL RuntimeError.SendMsg[] };
NOTIFY context.parentWakeup;
WHILE myContext.error # NIL DO 
WAIT context.childWakeup
ENDLOOP;
};

{
ENABLE {
ABORTED => GOTO out; -- this is how an UNWIND in the parent gets reflected in the child
UNWIND => NULL; -- shouldn't ever see one of these here but definitely don't ever want to catch one in the ANY arm
ANY => TRUSTED {CatchAndWait[]; SIGNAL RuntimeError.Resume}; 
};
p[];
EXITS
out => NULL
};
SetDone[]; -- tell parent that it's over
};

RaiseSignal: PROC [which: SIGNAL ANY RETURNS ANY, rtns: POINTER, args: POINTER] ~ TRUSTED MACHINE CODE {
"XR_RaiseSignal"
};

Init: PROC ~ {
};

Init[];

END.
  ╞  
SharedErrorsImpl.mesa
Copyright ╙ 1990, 1992 by Xerox Corporation.  All rights reserved.
Carl Hauser, October 31, 1987 1:34:59 pm PST
Chauser, January 25, 1991 1:32 pm PST
Willie-s, January 31, 1992 3:26 pm PST

make sure that all the children are finished before letting this frame (and hence its caller) disappear
the algorithm here could be converted to using a counter of completed processes but it seems useful, at least during debugging, to keep a record of the state of each of the children.
beginning of InternalFork
spawn the children and record them in the context
unchecked because the procedures we were given may be internal procs.
collect the children
raise the error;
enable aborts on childWakeup so that the child that suffered the error can be aborted as part of unwinding the parent; and on parentWakeup so the whole shebang can be aborted by aborting the parent.
Each child process has an instance of Stopper at its root.
 
body of Stopper
Э╩┘  Ц(cedarcode) styleХNewlineDelimiter
Щ ЪЬЩJЪЬ
╧eЬ7ЩBIcodeЪЬ,Щ,KЩ%KЩ&JЩ ЧЪ╧k	Ш	KЪЬЮЬ+Ш8KЪЬЮЬШ%KЪЬЮЬШKШ ЧKЪ
╨lnЬЮЬЮЬЮЬ	ЮЬШOKЪЮЬШKЪЮЬШЪЬЮШKШ ЧKЪ	ЬЮЬЮЬЮЬЮЬШKШ KЪЬЮЬЮЬШ5ЪЬЮЬЮ	ЬЮЬШ0KЪЬЮЬЮЬШ"KЪЬЮ	ЬШKЪЬЮ	ШKШKШ ЧKЪЬЮЬЮЬЮЬШ&KЪЬЮЬЮЬШ-ЪЬЮЬЮЬШ"KЪЬ	ЮЬШKЪ	ЬЮЬЮЬЮЬЮЬШKЪЬЮЬШKЪЬ	ЮЬШKЪЬЮШ
KШЧKШ Ъ╧nЬЮЬЮЬЮЬЮЬЮЬШ.KЪЬЮЬШ9ЪаЬЮЬЮЬ"Ш:ЪЮЬЮЬШKЪЬ	ЮЬЮЬШKЪЬЮЬЮЬШKЩgKЩ╢ЪЮШKЪЬ
ЮЬШЪЮЬ)ЮЬЮЬЮШ=ЪЮЬЮЬЮЬШ KЪЬ
ЮЬШKЪЮЬЮЬ!Ш2KШЧKЪЮЬШЧKЪЮЬ	ЮЬЮЬШKЪЬЮЬШKЪЮЬШKЪЮЬШЧKШЧKЪЬЩKЪЬ	ЮЬЮЬШKШ KЩ1ЪЮЬЮЬЮЬЮШ3KЪЬЮЬШKЩEKЪЮЬЮ	ЬЮЬШFKЪЬЮЬЮЬ"ЮЬЮЬЮЬЮЬШlKЪЮЬ Ш'KЪЮЬШЧKШ KЩЪЮЬ	ЮШKЪЮЬШKЪЬ
ЮЬШЪЮЬ)ЮЬЮЬЮШ=ЪЮЬЮЬЮЬЮЬШ&KЪЬЩKШ=KЪЬЮЬШKЪЮ	ЬШKШЧKЪЮЬЮЬЮЬШ'KЪЮЬШЧKЪЮЬШЧKШЧKЪЬ╞Щ╞ЪЮЬШ	KЪЬ+Ш+KЪЬ+Ш+KЪЬШЧKШKШKШ ЧЪаЬЮЬЮЬШ2KЪЬ:Щ:KЪЬЩЪ
аЬЮЬЮЬЮЬЮЬШVЪЮЬ#ЮЬЮЬЮШ7KЪЮЬЮЬЮЬ
Ш-KЪЮЬШЧKШKШ ЧЪаЬЮЬЮЬ&Ш9KЪЬ0ЮЬШ5KЪЮЬШKШKШ ЧЪаЬЮЬЮЬ&Ш>KЪЮЬЮЬЮЬШKЪЬЮЬЮЬШ,KШEKЪЮЬRЮЬЬШyKЪЮЬШЪЮЬЮЬЮЬШKЪЮЬШKЪЮЬШЧKШKШ ЧKЪЬ╧bЩШЪЮЬШKЪЮЬЮЬ╧cBШWKЪЮЬЮЬвbШrKЪЮЬЮЬЮЬШ=KШЧKШЪЮШKЪЬЮШЧKШЧKЪЬвШ(KШKШ ЧЪаЬЮЬ	ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШhKШKЪЬШKШ ЧЪаЬЮЬШKШЧKШ KШKШ KЪЮЬШЧ ЕЧ      е  