<<>> <> <> <> <> DIRECTORY Atom, C2CAccess, C2CAccessInternal, C2CBasics, IntCodeDefs, IO, PreDebug, Rope; C2CAccessImpl: CEDAR MONITOR <> IMPORTS Atom, C2CBasics, IO, PreDebug EXPORTS C2CAccess, C2CAccessInternal, C2CBasics = BEGIN <<>> <<<>>> <> 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[] }; <> <> 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; <> 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]; }; <> 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: 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] }; <> 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 }; <> 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.