<> <> <> <> DIRECTORY Basics, DragonRuntimeSupport, DragonStack, RuntimeError; SignalsImpl: CEDAR MONITOR IMPORTS DRS: DragonRuntimeSupport, Process EXPORTS RuntimeError SHARES Process ~ BEGIN <> <<>> PTR: TYPE ~ DRS.PTR; <> <<>> ucsHandler: RuntimeError.UCSProc _ NIL; <<>> <> <<>> ExceptAny: TYPE ~ SIGNAL ANY RETURNS ANY; SendMsgSignal: PUBLIC SIGNAL RETURNS [signal: ExceptAny, args: PTR] ~ CODE; ResumeError: PUBLIC SIGNAL ~ CODE; UnwindError: PUBLIC ERROR ~ CODE; UNCAUGHT: PUBLIC ERROR [signal: ExceptAny, args: PTR] ~ CODE; <<>> InformationalSignal: PUBLIC SAFE PROC [signal: ExceptAny, args: PTR] = TRUSTED { <> SignalHandler[NIL, signal, args, NIL, TRUE]; }; RegisterUncaughtSignalHandler: PUBLIC ENTRY PROC [proc: RuntimeError.UCSProc] RETURNS [old: RuntimeError.UCSProc] = { old _ ucsHandler; ucsHandler _ proc; }; <> <<>> CatchProc: TYPE ~ DRS.HandlerType; HandlerAction: TYPE = DRS.HandlerAction; BytePC: TYPE = DRS.BytePC; RaiseError: PUBLIC PROC [signal: ExceptAny, args: PTR] = { SignalHandler[NIL, signal, args, NIL]; ERROR ResumeError }; RaiseSignal: PUBLIC PROC [signal: ExceptAny, rtns: PTR, args: PTR] = { SignalHandler[NIL, signal, args, rtns]; }; <<>> <> <<>> <> <<>> SignalHandlerState: TYPE ~ RECORD [ start: Frame _ NIL, signal: ExceptAny _ NIL, frame, nextFrame: Frame _ NIL, target, nextTarget: Frame _ NIL, unwinding: BOOL _ FALSE, previousHandler: SigState _ NIL ]; SigState: TYPE = POINTER TO SignalHandlerState; <> SignalHandler: PROC [self: SigState, sig: ExceptAny, arg: PTR, rtns: PTR, informational: BOOL _ FALSE] ~ { action: HandlerAction; catchPhrase: BOOL; catchFSIndex: BYTE; catchProc: CatchProc; self _ NewSignalHandlerState[signal: sig]; MarkSignalHandlerFrame[]; { OPEN self; unwinding _ FALSE; <> start _ ExternalizeStack[]; <> <> nextFrame _ start; UNTIL (nextFrame = target) OR unwinding DO <> frame _ nextFrame; IF IsSignalHandlerFrame[frame] THEN { <> OPEN thisSignaller: FindSigState[frame]^; IF thisSignaller.unwinding THEN nextFrame _ thisSignaller.nextTarget <> ELSE nextFrame _ SELECT TRUE FROM signal ~= thisSignaller.signal => Parent[frame], <> signal = thisSignaller.signal => thisSignaller.nextFrame, <> ENDCASE => ERROR; } ELSE <> nextFrame _ Parent[frame]; <> catchProc _ CheckCatch[frame]; IF catchProc # NIL THEN { <> [action, exitPC, levels] _ catchProc[regsPtr: GetRegs[frame], except: signal, rtnPtr: rtns, argPtr: arg ! SendMsgSignal => RESUME[sig, arg] -- SendMsgSignal is SIGNALled by an ANY-catcher to request the details of the signal it is processing -- ]; SELECT action FROM reject => NULL; resume => { <> RETURN }; exit => IF ~informational THEN { target _ frame; unwinding _ TRUE; arg _ 0; }; <> <> ENDCASE; }; ENDLOOP; <> SELECT TRUE FROM unwinding => NULL; informational OR signal = LOOPHOLE[UNCAUGHT] => NULL; -- does an implicit RESUME <> ENDCASE => { <> Uncaught: TYPE = SIGNAL [SIGNAL ANY RETURNS ANY, WORD]; LOOPHOLE[UNCAUGHT, Uncaught][signal, message]; ucsHandler[message, signal, frame]; }; <> IF unwinding THEN DO -- unless a GOTO is done out of an UNWIND catch phrase, this loop is traversed at most once. <> nextTarget _ Parent[target]; nextFrame _ start; UNTIL nextFrame = target DO <> frame _ nextFrame; IF IsSignalHandlerFrame[frame] THEN { <> OPEN thisSignaller: FindSigState[frame]^; IF thisSignaller.unwinding THEN { SetParent[frame, thisSignaller.nextFrame]; FreeFrame[thisSignaller.frame]; -- free the frame he is examining (i.e. has passed UNWIND to; it should not see another UNWIND). }; }; nextFrame _ Parent[frame]; <> catchProc _ CheckCatch[frame]; IF catchProc # NIL THEN { <> action _ catchProc[regsPtr: GetRegs[frame], except: signal, rtnPtr: NIL, argPtr: NIL ! SendMsgSignal => RESUME[sig, arg] -- SendMsgSignal is SIGNALled an ANY-catcher to request the details of the signal and message it is processing -- ]; SELECT action FROM reject => NULL; resume => ERROR ResumeError; exit => ERROR UnwindError; ENDCASE; }; <> IF frame = start THEN start _ nextFrame; <> IF frame = LOOPHOLE[self.link] THEN self.link _ nextFrame; FreeFrame[frame]; REPEAT FINISHED -- The inner loop -- => EXIT -- the outer loop -- ENDLOOP; ENDLOOP; }; }; <> Frame: TYPE = DragonStack.Nacho; CheckCatch: PROC [frame: Frame] RETURNS [catchProc: CatchProc] ~ { <> <> <> NYI[]; RETURN[NIL]; }; MarkStack: PROC [] RETURNS [] ~ { <> <> NYI[]; }; IsSignalHandlerFrame: PROC [frame: Frame] RETURNS [BOOL _ FALSE] ~ INLINE { <> RETURN [frame.status.signalHandler]; }; FindSigState: PROC [frame: Frame] RETURNS [sigState: SigState] ~ INLINE { <> RETURN[LOOPHOLE[frame.regs[0]]]; }; Parent: PROC [frame: Frame] RETURNS [parent: Frame] ~ INLINE { <> RETURN[frame.link]; }; SetParent: PROC [frame: Frame, newParent: Frame] ~ INLINE { frame.link _ newParent; }; GetRegs: PROC [frame: Frame] RETURNS [RegArrayPtr] ~ INLINE { <> RETURN[LOOPHOLE[@frame.regs]]; }; <> Initialize: PROC = { NYI[]; }; Initialize[]; END.