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
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;
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.
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;
};
beginning of InternalFork
allDone: BOOL ¬ FALSE;
spawn the children and record them in the context
FOR tp: PList ¬ children, tp.rest UNTIL tp = NIL DO
newProcess: PROCESS;
unchecked because the procedures we were given may be internal procs.
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;
collect the children
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 {
raise the error;
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;
};
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.
TRUSTED {
Process.EnableAborts[@context.childWakeup];
Process.EnableAborts[@context.parentWakeup]
};
InternalFork[context];
};
Stopper: PROC [c: SharedErrorContext, p: PROC] ~ {
Each child process has an instance of Stopper at its root.
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;
};
body of Stopper
{
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.