
<<BackStopImpl.mesa>>
<<Russ Atkinson, October 7, 1983 1:50 pm>>
<<Paul Rovner, October 17, 1983 8:51 am>>

DIRECTORY
AMEvents USING [Debugged, Debugging],
AMTypes USING [Error, ErrorReason],
BackStop USING [],
FS USING [Error],
IO USING [PutFR, card],
Rope USING [Cat, ROPE],
SafeStorage USING [InvalidType, NarrowRefFault],
DebuggerSwap USING [CallDebugger],
RuntimeError USING
[BoundsFault, ControlFault, DivideCheck, PointerFault, SendMsgSignal, StackError, StartFault, UnboundProcedure, ZeroDivisor],
VM USING [AddressFault, CantAllocate, WriteProtectFault],
WorldVM USING [Address, AddressFault, BadWorld];

BackStopImpl: CEDAR PROGRAM
IMPORTS
AMEvents, AMTypes, DebuggerSwap, FS, IO, Rope, RuntimeError, SafeStorage, VM, WorldVM
EXPORTS BackStop
= BEGIN OPEN Rope, AMTypes, WorldVM;

Pair: TYPE = MACHINE DEPENDENT RECORD [lo,hi: CARDINAL];

<<Global Variables>>
SuspendBackStop: PUBLIC SIGNAL = CODE;
ResumeBackStop: PUBLIC SIGNAL = CODE;

alwaysRejectAny: BOOL _ FALSE;  -- for debugging
OZ: BOOL _ FALSE; -- used to enter debugger when a signal/error occurs
lastAnyMsg: UNSPECIFIED _ 0;
lastAnySignal: SIGNAL ANY RETURNS ANY _ NIL;  -- useful for debugging ANY errors
lagMsg: ROPE _ NIL;  -- used to usually avoid GC of error message
lagLagMsg: ROPE _ NIL; -- nothing like being safe...

Call: PUBLIC PROC [inner: PROC] RETURNS [ROPE] = TRUSTED {
msg1, msg2: ROPE _ NIL;
suspensionCount: NAT _ 0;
{{ENABLE {
AMEvents.Debugged, AMEvents.Debugging => REJECT;
ABORTED => REJECT;
UNWIND => REJECT;
FS.Error => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "FS.Error";
msg2 _ error.explanation;
MaybeLeaveKansas[]; 
GO TO oops};
VM.AddressFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ IO.PutFR["AddressFault: %b", IO.card[LOOPHOLE[address, LONG CARDINAL]]];
MaybeLeaveKansas[]; 
GO TO oops};
AMTypes.Error => {
IF suspensionCount >0 THEN REJECT;
msg1 _ SELECT reason FROM
noSymbols => "NoSymbols",
notImplemented => "NotImplemented",
incompatibleTypes => "IncompatibleTypes",
rangeFault => "RangeFault",
notMutable => "NotMutable",
internalTV => "InternalTV",
badName => "BadName",
badIndex => "BadIndex",
typeFault => "TypeFault",
ENDCASE => "Unknown AMTypes.Error";
msg2 _ msg; 
MaybeLeaveKansas[]; 
GO TO oops};
SafeStorage.InvalidType => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "InvalidType"; 
MaybeLeaveKansas[]; 
GO TO oops};
SafeStorage.NarrowRefFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "NarrowRefFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.BoundsFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "BoundsFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.ControlFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "ControlFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.DivideCheck => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "DivideCheck"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.PointerFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "PointerFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.StartFault => { 
IF suspensionCount >0 THEN REJECT;
msg1 _ "StartFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.StackError => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "StackError"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.UnboundProcedure => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "UnboundProcedure"; 
MaybeLeaveKansas[]; 
GO TO oops};
RuntimeError.ZeroDivisor => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "ZeroDivisor"; 
MaybeLeaveKansas[]; 
GO TO oops};
VM.CantAllocate => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "VM.CantAllocate"; 
MaybeLeaveKansas[]; 
GO TO oops};
VM.WriteProtectFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ IO.PutFR["WriteProtectFault: %b", IO.card[LOOPHOLE[address, LONG CARDINAL]]];
MaybeLeaveKansas[]; 
GO TO oops};
WorldVM.AddressFault => {
IF suspensionCount >0 THEN REJECT;
msg1 _ IO.PutFR["WriteProtectFault: %b", IO.card[LOOPHOLE[addr, LONG CARDINAL]]];
MaybeLeaveKansas[]; 
GO TO oops};
WorldVM.BadWorld => {
IF suspensionCount >0 THEN REJECT;
msg1 _ "WorldVM.BadWorld"; 
MaybeLeaveKansas[]; 
GO TO oops};
SuspendBackStop => {suspensionCount _ suspensionCount + 1; RESUME};
ResumeBackStop => {suspensionCount _ suspensionCount - 1; RESUME};
ANY => TRUSTED{
anyMsg: CARDINAL;
anySignal: UNSPECIFIED;
IF suspensionCount >0 THEN REJECT;
IF alwaysRejectAny THEN REJECT;
[anyMsg, anySignal] _ SIGNAL RuntimeError.SendMsgSignal;
lastAnyMsg _ anyMsg;
lastAnySignal _ anySignal;
SELECT LOOPHOLE[anySignal, CARDINAL] FROM
177777B => {
<<the overused unnamed ERROR>>
msg1 _ "unnamed ERROR";
};
ENDCASE => {
msg1 _ IO.PutFR[
"UnknownError[sig: %b, msg: %b]",
IO.card[LOOPHOLE[anySignal, CARDINAL]],
IO.card[anyMsg]
];
};
MaybeLeaveKansas[]; 
GO TO oops}};
inner[];
RETURN [NIL]}
EXITS
oops => {
IF msg2 # NIL THEN msg1 _ msg1.Cat["[", msg2, "]"]; 
lagLagMsg _ lagMsg; 
RETURN[(lagMsg _ msg1)]}}
}; 

MaybeLeaveKansas: PROC = TRUSTED {
IF OZ THEN
DebuggerSwap.CallDebugger["Toto, I don't think that we are in Kansas anymore..."];
};

END.