
<<BBSafetyImpl.mesa>>
<<Russ Atkinson, June 22, 1983 6:14 pm>>

DIRECTORY
AMEvents USING [Booted, Debugged, Debugging],
AMTypes USING [Error, ErrorReason],
AMViewerOps USING [SourceError],
BBSafety USING [],
CIFS USING [Error],
Convert USING [ValueToRope],
PageFault USING [AddressFault],
Rope USING [Cat, Concat, ROPE],
RTQuanta USING [QuantumSize],
RTTypesBasic USING [InvalidType],
RTTypesRemotePrivate USING [ValidateRemoteRef],
RTZones USING [MapQZf, mzVacant],
Runtime USING
[BoundsFault, CallDebugger, ControlFault, DivideCheck, PointerFault, StartFault, StackError, UnboundProcedure, ZeroDivisor],
RuntimeInternal USING [SendMsgSignal],
Space USING [InsufficientSpace], 
WorldVM USING
[Address, AddressFault, BadWorld, CurrentIncarnation, LocalWorld, Read, World],
WriteFault USING [WriteProtectFault];

BBSafetyImpl: CEDAR MONITOR
IMPORTS
AMEvents, AMTypes, AMViewerOps, CIFS, Convert, PageFault, Rope, RTTypesBasic, RTTypesRemotePrivate, RTZones, Runtime, 
RuntimeInternal, Space, WorldVM, WriteFault
EXPORTS BBSafety
= BEGIN OPEN Rope, AMTypes, WorldVM;

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

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

IsValidRef: PUBLIC PROC [world: World, ref: Address] RETURNS [BOOL] = TRUSTED {
<<returns TRUE iff the address is valid AND the zone map has an entry for the address>>
[] _ WorldVM.Read[world, ref ! ABORTED => GO TO abort; ANY => GO TO bad];
IF world = WorldVM.LocalWorld[]
THEN {
zi: LONG CARDINAL _ ref / RTQuanta.QuantumSize;
IF zi >= RTZones.MapQZf.length THEN RETURN [FALSE];
RETURN [RTZones.MapQZf[LOOPHOLE[zi, Pair].lo] # RTZones.mzVacant];
}
ELSE {
RTTypesRemotePrivate.ValidateRemoteRef
[[world, WorldVM.CurrentIncarnation[world], ref]
! ABORTED => GO TO abort; ANY => GO TO bad]};
RETURN [TRUE];
EXITS
bad => RETURN [FALSE];
abort => ERROR ABORTED; 
};  

IsValidAddr: PUBLIC PROC [world: World, addr: Address] RETURNS [BOOL] = TRUSTED {
<<returns TRUE iff the page map has an entry for the address>>
[] _ WorldVM.Read[world, addr ! ABORTED => GO TO abort; ANY => GO TO bad];
RETURN [TRUE];
EXITS
bad => RETURN [FALSE];
abort => ERROR ABORTED; 
};  

Mother: PUBLIC PROC [inner: PROC] RETURNS [ROPE] = TRUSTED {
<<Mother handles various signals & turns them into messages during the execution of the protected inner proc.>>
msg1, msg2: ROPE _ NIL;
kind: AMTypes.ErrorReason;
useKind: BOOL _ FALSE;
{{ENABLE {
AMViewerOps.SourceError => {
msg1 _ "SourceError";
msg2 _ reason;
MaybeLeaveKansas[]; 
GO TO oops};
CIFS.Error => {
msg1 _ "CIFS.Error";
msg2 _ error;
MaybeLeaveKansas[]; 
GO TO oops};
PageFault.AddressFault => {
msg1 _ "AddressFault"; 
msg2 _ Convert.ValueToRope
[[unsigned[LOOPHOLE[address, LONG CARDINAL], 8]]];
msg2 _ msg2.Concat["B"];
MaybeLeaveKansas[]; 
GO TO oops};
AMTypes.Error => {
kind _ reason;
useKind _ TRUE;
msg2 _ msg; 
MaybeLeaveKansas[]; 
GO TO oops};
AMEvents.Booted => {
msg1 _ "Client booted"; 
GO TO oops};
AMEvents.Debugged, AMEvents.Debugging => 
REJECT;
RTTypesBasic.InvalidType => {
msg1 _ "InvalidType"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.BoundsFault => {
msg1 _ "BoundsFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.ControlFault => {
msg1 _ "ControlFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.DivideCheck => {
msg1 _ "DivideCheck"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.PointerFault => {
msg1 _ "PointerFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.StartFault => { 
msg1 _ "StartFault"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.StackError => {
msg1 _ "StackError"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.UnboundProcedure => {
msg1 _ "UnboundProcedure"; 
MaybeLeaveKansas[]; 
GO TO oops};
Runtime.ZeroDivisor => {
msg1 _ "ZeroDivisor"; 
MaybeLeaveKansas[]; 
GO TO oops};
Space.InsufficientSpace => {
msg1 _ "Space.InsufficientSpace"; 
MaybeLeaveKansas[]; 
GO TO oops};
WriteFault.WriteProtectFault => {
msg1 _ "WriteProtectFault"; 
msg2 _ Convert.ValueToRope
[[unsigned[LOOPHOLE[address, LONG CARDINAL], 8]]];
msg2 _ msg2.Concat["B"];
MaybeLeaveKansas[]; 
GO TO oops};
WorldVM.AddressFault => {
msg1 _ "AddressFault"; 
msg2 _ Convert.ValueToRope
[[unsigned[LOOPHOLE[addr, LONG CARDINAL], 8]]];
msg2 _ msg2.Concat["B"];
MaybeLeaveKansas[]; 
GO TO oops};
WorldVM.BadWorld => {
msg1 _ "WorldVM.BadWorld"; 
MaybeLeaveKansas[]; 
GO TO oops};
ABORTED => GO TO aborted;
UNWIND => NULL;
ANY => {
anyMsg, anySignal: CARDINAL;
IF alwaysRejectAny THEN REJECT;
[anyMsg, anySignal] _ SIGNAL RuntimeInternal.SendMsgSignal;
lastAnyMsg _ anyMsg;
lastAnySignal _ anySignal;
SELECT anySignal FROM
177777B => {
<<the overused unnamed ERROR>>
msg1 _ "unnamed ERROR";
};
ENDCASE => {
msg1 _ Rope.Cat[
"UnknownError[sig: ",
Convert.ValueToRope[[unsigned[anySignal, 8]]],
"B, msg: ",
Convert.ValueToRope[[unsigned[anyMsg, 8]]],
"B]"];
};
MaybeLeaveKansas[]; 
GO TO oops}};
inner[];
RETURN [NIL]}
EXITS
aborted =>
ERROR ABORTED;
oops => {
msg: ROPE _ msg1;
IF useKind THEN
msg _ SELECT kind FROM
noSymbols => "NoSymbols",
notImplemented => "NotImplemented",
incompatibleTypes => "IncompatibleTypes",
rangeFault => "RangeFault",
notMutable => "NotMutable",
internalTV => "InternalTV",
badName => "BadName",
badIndex => "BadIndex",
typeFault => "TypeFault",
ENDCASE => "??";
IF msg2 # NIL THEN 
msg _ msg.Cat["[", msg2, "]"]; 
lagLagMsg _ lagMsg; 
RETURN[(lagMsg _ msg)]}}
}; 

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

END.