
    <<BackStopImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson, March 7, 1985 3:52:49 am PST>>
        <<Paul Rovner, October 17, 1983 8:51 am>>
        <<Russ Atkinson (RRA) May 29, 1985 1:57:04 am PDT>>

    DIRECTORY
        AMEvents USING [Debugged, Debugging],
        AMTypes USING [Error, ErrorReason],
        BackStop USING [],
        FS USING [Error],
        IO USING [PutFR, PutRope, RopeFromROS, ROS, STREAM],
        Real USING [Exception, ExceptionFlags, NoExceptions, RealError, RealException],
        Rope USING [ROPE],
        SafeStorage USING [CantEstablishFinalization, InvalidType, NarrowRefFault, UnsafeProcAssignment],
        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, Real, RuntimeError, SafeStorage, VM, WorldVM
        EXPORTS BackStop
        = BEGIN OPEN AMTypes, Rope, WorldVM;

        ROPE: TYPE = Rope.ROPE;
        STREAM: TYPE = IO.STREAM;

    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: UNSAFE SIGNAL ANY RETURNS ANY _ NIL;
            <<useful for debugging ANY errors>>
        lagMsg: ROPE _ NIL;
            <<used to usually avoid GC of error message>>

    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: %bB", [cardinal[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.CantEstablishFinalization => {
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ "SafeStorage.CantEstablishFinalization"; 
                MaybeLeaveKansas[]; 
                GO TO oops};
            SafeStorage.InvalidType => {
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ "SafeStorage.InvalidType"; 
                MaybeLeaveKansas[]; 
                GO TO oops};
            SafeStorage.NarrowRefFault => {
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ "NarrowRefFault"; 
                MaybeLeaveKansas[]; 
                GO TO oops};
            SafeStorage.UnsafeProcAssignment => {
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ "SafeStorage.UnsafeProcAssignment"; 
                MaybeLeaveKansas[]; 
                GO TO oops};
            Real.RealError => {
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ "Real.RealError"; 
                MaybeLeaveKansas[]; 
                GO TO oops};
            Real.RealException => TRUSTED {
                RealFlagsNames: ARRAY Real.Exception OF ROPE = [
                    "fixOverflow", "inexactResult", "invalidOperation",
                    "divisionByZero", "overflow", "underflow"
                    ];
                ros: STREAM _ IO.ROS[];
                temp: Real.ExceptionFlags _ flags;
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ "Real.RealException";
            IO.PutRope[ros, "{"];
                IF temp # Real.NoExceptions THEN
                    FOR flag: Real.Exception IN Real.Exception DO
                        IF temp[flag] THEN {
                            temp[flag] _ FALSE;
                            IO.PutRope[ros, RealFlagsNames[flag]];
                            IF temp = Real.NoExceptions THEN EXIT;
                            IO.PutRope[ros, ", "];
                            };
                        ENDLOOP;
            IO.PutRope[ros, "}"];
            msg2 _ IO.RopeFromROS[ros];
                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: %bB", [cardinal[LOOPHOLE[address, LONG CARDINAL]]]];
                MaybeLeaveKansas[]; 
                GO TO oops};
            WorldVM.AddressFault => {
                IF suspensionCount > 0 THEN REJECT;
                msg1 _ IO.PutFR["WriteProtectFault: %bB", [cardinal[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 => {
                IF suspensionCount > 0 THEN suspensionCount _ suspensionCount - 1;
                RESUME};
            ANY => TRUSTED {
                anyMsg: CARDINAL;
                anySignal: UNSAFE SIGNAL ANY RETURNS ANY;
                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: %bB, msg: %bB]",
                            [cardinal[LOOPHOLE[anySignal, CARDINAL]]],
                            [cardinal[anyMsg]]
                            ];
                        };
                MaybeLeaveKansas[]; 
                GO TO oops}};
            inner[];
            RETURN [NIL]}
            EXITS
                oops => {
                    IF msg2 # NIL THEN msg1 _ IO.PutFR["%g[%g]", [rope[msg1]], [rope[msg2]]];
                    RETURN[(lagMsg _ msg1)]}}
        }; 

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

    END.