C2CAccessImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, October 4, 1990 3:41:19 pm PDT
Christian Jacobi, January 15, 1993 4:46 pm PST
DIRECTORY
Atom,
C2CAccess,
C2CAccessInternal,
C2CBasics,
IntCodeDefs,
IO,
PreDebug,
Rope;
C2CAccessImpl:
CEDAR
MONITOR
Note: only C2CAccess features are monitored, all C2CAccessInternal features are protected
IMPORTS Atom, C2CBasics, IO, PreDebug
EXPORTS C2CAccess, C2CAccessInternal, C2CBasics =
BEGIN
<<c2cVersion: PUBLIC Rope.ROPE; -- Exported by C2CVersionImpl>>
The re-entrance lock, monitored
occupied: BOOL ¬ FALSE; --monitored
Enter:
ENTRY
PROC []
RETURNS [failure:
BOOL] = {
failure ¬ occupied;
occupied ¬ TRUE
};
Leave:
PROC [] = {
occupied ¬ FALSE
};
ExcludeReEntry:
PUBLIC
PROC [inner:
PROC[]] = {
IF Enter[].failure THEN ERROR ImSorryC2CIsNotReEntrant;
inner[ ! UNWIND => Leave[]];
Leave[]
};
Error handling and reporting
Errors in C2CBasics
FatalError: PUBLIC ERROR [what: Rope.ROPE ¬ NIL] = CODE;
CantHappen: PUBLIC SIGNAL = CODE;
CantHappenCedar: PUBLIC SIGNAL = CODE;
CantHappenPreprocessed: PUBLIC SIGNAL = CODE;
CaseMissing: PUBLIC SIGNAL = CODE;
NotYetImpl: PUBLIC SIGNAL = CODE;
NotYetImplPreprocessed: PUBLIC SIGNAL = CODE;
Errors in C2CAcces
ImSorryC2CIsNotReEntrant: PUBLIC ERROR = CODE;
errorStream: IO.STREAM ¬ NIL;
ErrorStream:
PUBLIC
PROC []
RETURNS [stream:
IO.
STREAM] = {
IF ~occupied THEN ERROR;
IF errorStream#NIL THEN RETURN [errorStream];
errorStream ¬ stream ¬ params.getErrorStream[];
IO.PutF1[stream, "C2C of %g\n", IO.rope[C2CBasics.c2cVersion]];
IO.PutF[stream, "%g.errlog -- %g\n\n", IO.rope[params.moduleName], IO.time[]];
};
Report:
PUBLIC
PROC [what: Rope.
ROPE¬NIL] = {
IO.PutRope[params.reportStream, what];
};
Global state of compilation
params: PUBLIC C2CAccess.InputParameters;
labelWithLambda: PUBLIC IntCodeDefs.LabelNode;
rootNode: PUBLIC IntCodeDefs.Node;
CallC2C:
PUBLIC
PROC [parameters: C2CAccess.InputParameters]
RETURNS [ok:
BOOL, synopsis: Rope.
ROPE] = {
IF ~occupied THEN ERROR;
errorStream ¬ NIL;
properties ¬ NIL;
IF parameters.reportStream=NIL THEN parameters.reportStream ¬ IO.noWhereStream;
IF parameters.lineNumberStream=NIL THEN parameters.lineNumberStream ¬ IO.noWhereStream;
params ¬ parameters;
rootNode ¬ parameters.root;
labelWithLambda ¬ NIL;
CallCallBacks[];
realyDoC2C[];
ok ¬ errorStream=NIL;
};
Properties
properties: Atom.PropList ¬ NIL;
GetProp:
PUBLIC
PROC [key:
REF]
RETURNS [val:
REF] = {
RETURN [Atom.GetPropFromList[properties, key]]
};
PutProp:
PUBLIC
PROC [key, val:
REF] = {
properties ¬ Atom.PutPropOnList[properties, key, val]
};
Context nonsence
ctxTop:
PUBLIC
REF C2CBasics.ContextSequence ¬
NIL;
InitializeCtx:
PROC [] = {
ctxDefault: NAT = 50;
IF ctxTop=NIL THEN ctxTop ¬ NEW[C2CBasics.ContextSequence[ctxDefault]];
ctxTop.idx ¬ 0;
ctxTop.seq[0] ¬ [$top, NIL, NIL]; --stops searching
};
PushContext:
PUBLIC
PROC [ctx: C2CBasics.Context] = {
ctxTop.idx ¬ ctxTop.idx+1;
IF ctxTop.idx>ctxTop.max
THEN {
ctx1: REF C2CBasics.ContextSequence ¬ NEW[C2CBasics.ContextSequence[ctxTop.max+50]];
ctx1.idx ¬ ctxTop.idx;
FOR i:
NAT
IN [0..ctxTop.idx)
DO
ctx1.seq[i] ¬ ctxTop.seq[i];
ENDLOOP;
ctxTop ¬ ctx1;
};
ctxTop.seq[ctxTop.idx] ¬ ctx;
};
PopContext:
PUBLIC
PROC [] = {
ctxTop.idx ¬ ctxTop.idx-1
};
Initialization stuff
realyDoC2C: PROC;
callbacks: LIST OF PROC ¬ NIL;
CallbackWhenC2CIsCalled:
PUBLIC
PROC[p:
PROC] = {
callbacks ¬ CONS[p, callbacks];
};
CallCallBacks:
PROC [] = {
FOR pl:
LIST
OF
PROC ¬ callbacks, pl.rest
WHILE pl#
NIL
DO
pl.first[];
ENDLOOP;
};
RegisterThisToBeC2C:
PUBLIC
PROC[p:
PROC] = {
realyDoC2C ¬ p;
};
PreDebug.RegisterErrorExplainer[FatalError, NIL, "C2C error: FatalError"];
PreDebug.RegisterSignalExplainer[CantHappen, NIL, "C2C error: CantHappen"];
PreDebug.RegisterSignalExplainer[CantHappenCedar, NIL, "C2C error: CantHappenCedar"];
PreDebug.RegisterSignalExplainer[CantHappenPreprocessed, NIL, "C2C error: CantHappenPreprocessed"];
PreDebug.RegisterSignalExplainer[CaseMissing, NIL, "C2C error: CaseMissing"];
PreDebug.RegisterSignalExplainer[NotYetImpl, NIL, "C2C error: NotYetImpl"];
PreDebug.RegisterSignalExplainer[NotYetImplPreprocessed, NIL, "C2C error: NotYetImplPreprocessed"];
PreDebug.RegisterErrorExplainer[ImSorryC2CIsNotReEntrant, NIL, "C2C error: C2C is not re-entrant"];
C2CBasics.CallbackWhenC2CIsCalled[InitializeCtx];
END.