XlPrivateErrorHandlingImpl.mesa
Copyright Ó 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, November 6, 1991 10:11:20 am PST
Christian Jacobi, May 3, 1993 10:35 am PDT
DIRECTORY
PreDebug, Rope, Xl, XlPrivate, XlPrivateErrorHandling, XlTQPrivate;
XlPrivateErrorHandlingImpl:
CEDAR
MONITOR
IMPORTS PreDebug, Rope, Xl, XlPrivate, XlTQPrivate
EXPORTS Xl, XlPrivateErrorHandling ~
BEGIN
XError: PUBLIC <<Xl>> SIGNAL [err: Xl.ErrorNotifyEvent] ~ CODE;
connectionNotCreated: PUBLIC <<Xl>> SIGNAL [why: REF Xl.ConnectionRejectInfo] ~ CODE;
reportProc: Xl.EventProcType ¬ DefaultErrorEventProc;
explainerProc: XlPrivateErrorHandling.ExplainerProc ¬ DefaultExplain;
RegisterErrorReportProc:
PUBLIC
PROC [proc: Xl.EventProcType] = {
IF proc#NIL THEN reportProc ¬ proc
};
RegisterExplainer:
PUBLIC
PROC [proc: XlPrivateErrorHandling.ExplainerProc] = {
IF proc#NIL THEN explainerProc ¬ proc
};
ErrorReportProc:
PUBLIC PROC []
RETURNS [Xl.EventProcType] = {
RETURN [reportProc];
};
Explain:
PUBLIC
PROC [errorEvent: Xl.ErrorNotifyEvent] = {
IF errorEvent.explanation=NIL THEN explainerProc[errorEvent];
};
DefaultErrorEventProc: Xl.EventProcType = {
WITH event
SELECT
FROM
error: Xl.ErrorNotifyEvent => {
Explain[error];
BEGIN
ENABLE
ABORTED => {
XlTQPrivate.RemoveErrorEvents[tq]; GOTO oops
};
SIGNAL Xl.XError[error];
--Proceeding gets to the next queued error,
--Aborting flushes the error queue.
EXITS oops => {};
END;
};
ENDCASE => ERROR;
};
DefaultExplain:
PROC [errorEvent: Xl.ErrorNotifyEvent] = {
};
NewErrorEvent:
PUBLIC
PROC [reply:
REF
ANY, connection: Xl.Connection ¬
NIL, sequenceNumber: Xl.SequenceNo ¬ 0]
RETURNS [err:
REF Xl.EventRep.errorNotify] = {
rep: XlPrivate.Reply ¬ NARROW[reply];
err ¬ NEW[Xl.EventRep.errorNotify];
err.replyText ¬ rep;
err.connection ¬ connection;
err.seq ¬ sequenceNumber;
IF rep=
NIL
THEN err.errorKind ¬ clientError
ELSE {
err.serverGenerated ¬ TRUE;
err.originalCodeByte ¬ XlPrivate.Get8[rep, 0];
IF err.originalCodeByte<=
ORD[Xl.ErrorKind[implementation]]
THEN err.errorKind ¬ VAL[err.originalCodeByte]
ELSE err.errorKind ¬ otherServer;
};
};
errorEventRaiser: PROC [errorEvent: Xl.ErrorNotifyEvent] ¬ DefaultRaiseErrorEvent;
RaiseErrorEvent:
PUBLIC
PROC [errorEvent: Xl.ErrorNotifyEvent] = {
IF errorEvent#
NIL
THEN {
c: Xl.Connection ¬ errorEvent.connection;
Explain[errorEvent];
IF c#NIL THEN c.lastError ¬ errorEvent;
errorEventRaiser[errorEvent];
}
};
DefaultRaiseErrorEvent:
PROC [errorEvent: Xl.ErrorNotifyEvent] = {
ERROR Xl.XError[errorEvent];
};
RegisterRaiseErrorEvent:
PUBLIC
PROC [p:
PROC [errorEvent: Xl.ErrorNotifyEvent]] = {
IF p=NIL THEN p ¬ DefaultRaiseErrorEvent;
errorEventRaiser ¬ p
};
RegisterErrorMatch:
PUBLIC
PROC [c: Xl.Connection, errorMatch: Xl.Match] = {
IF errorMatch=
NIL
THEN errorMatch ¬ NEW[Xl.MatchRep]
ELSE {m: Xl.Match ¬ NEW[Xl.MatchRep ¬ errorMatch]; errorMatch ¬ m};
IF errorMatch.tq=NIL THEN errorMatch.tq ¬ Xl.CreateTQ[];
IF errorMatch.proc=NIL THEN errorMatch.proc ¬ ErrorReportProc[];
IF errorMatch.handles=NIL THEN errorMatch.handles ¬ NEW[Xl.EventFilterRec];
c.errorMatch ¬ errorMatch;
};
ExplainXError: PreDebug.Explainer = {
msg ¬ "Xl.XError";
IF args=NIL THEN RETURN;
PreDebug.Raise[signalOrError, args ! XError => {
IF err.explanation=NIL THEN Explain[err];
IF ~Rope.IsEmpty[err.explanation] THEN msg ¬ Rope.Cat[msg, " ", err.explanation];
CONTINUE
}];
};
ExplainConnectionNotCreated: PreDebug.Explainer = {
msg ¬ "Xl.connectionNotCreated";
IF args=NIL THEN RETURN;
PreDebug.Raise[signalOrError, args ! connectionNotCreated => {
IF ~Rope.IsEmpty[why.reason] THEN msg ¬ Rope.Cat[msg, " ", why.reason];
CONTINUE
}];
};
RaiseClientError:
PUBLIC PROC [c: Xl.Connection, what:
REF ¬
NIL] = {
err: REF Xl.EventRep.errorNotify ~ NewErrorEvent[reply: NIL, connection: c];
err.serverGenerated ¬ FALSE;
err.internal ¬ what;
err.errorKind ¬ clientError;
RaiseErrorEvent[err];
ERROR;
};
RaiseServerError:
PUBLIC
PROC [c: Xl.Connection, what:
REF ¬
NIL, reply:
REF
ANY ¬
NIL] = {
err: REF Xl.EventRep.errorNotify ~ NewErrorEvent[reply: reply, connection: c];
err.serverGenerated ¬ FALSE;
err.internal ¬ what;
err.errorKind ¬ VAL[241]; --overwrites field set using reply
RaiseErrorEvent[err];
ERROR;
};
PreDebug.RegisterSignalExplainer[connectionNotCreated, ExplainConnectionNotCreated];
PreDebug.RegisterSignalExplainer[XError, ExplainXError];
END.