freebsd-ports/lang/modula-3-lib/files/patch-bp

This patch uses the sigaction interface to gain access to the PC value
so that it can be printed out when a fatal signal occurs.

Index: m3/m3core/src/runtime/FreeBSD2/RTSignal.m3
--- RTSignal.m3.orig	Mon Nov 21 10:31:19 1994
+++ RTSignal.m3	Thu Jul 10 14:24:59 1997
@@ -7,18 +7,21 @@
 
 UNSAFE MODULE RTSignal;
 
-IMPORT RTMisc, RTProcess, Csignal, Usignal, Uprocess;
+IMPORT RTMisc, RTProcess, Usignal, Uprocess;
 FROM Ctypes IMPORT int;
 
+TYPE
+  SigInfo = UNTRACED REF Usignal.struct_sigcontext;
+
 VAR
-  DefaultHandler   : Csignal.Handler;
-  IgnoreSignal     : Csignal.Handler;
-  initial_handlers : ARRAY [0..5] OF Csignal.Handler;
+  DefaultHandler   : Usignal.SignalHandler;
+  IgnoreSignal     : Usignal.SignalHandler;
+  initial_handlers : ARRAY [0..5] OF Usignal.struct_sigaction;
 
 PROCEDURE InstallHandlers () =
   BEGIN
-    DefaultHandler := LOOPHOLE (0, Csignal.Handler);
-    IgnoreSignal   := LOOPHOLE (1, Csignal.Handler);
+    DefaultHandler := LOOPHOLE (0, Usignal.SignalHandler);
+    IgnoreSignal   := LOOPHOLE (1, Usignal.SignalHandler);
 
     SetHandler (0, Usignal.SIGHUP,  Shutdown);
     SetHandler (1, Usignal.SIGINT,  Interrupt);
@@ -28,13 +31,18 @@
     SetHandler (5, Usignal.SIGTERM, Shutdown);
   END InstallHandlers;
 
-PROCEDURE SetHandler (id: INTEGER;  sig: int;  handler: Csignal.Handler) =
-  VAR old := Csignal.signal (sig, handler);
-  BEGIN
-    initial_handlers[id] := old;
-    IF (old # DefaultHandler) THEN
+PROCEDURE SetHandler (id: INTEGER; sig: int;  handler: Usignal.SignalHandler) =
+  (* Note: we use the LOOPHOLE to prevent the runtime check for
+     nested procedure.  The runtime check crashes when
+     handler = IgnoreSignal = 1. *)
+  VAR new: Usignal.struct_sigaction;
+  BEGIN
+    new.sa_handler := LOOPHOLE (handler, Usignal.SignalHandler);
+    new.sa_flags   := 0;
+    EVAL Usignal.sigaction (sig, ADR(new), ADR(initial_handlers[id]));
+    IF (initial_handlers[id].sa_handler # DefaultHandler) THEN
       (* don't override inherited, non-default handlers *)
-      EVAL Csignal.signal (sig, old);
+      EVAL Usignal.sigaction (sig, ADR(initial_handlers[id]), ADR(new));
     END;
   END SetHandler;
 
@@ -50,36 +58,43 @@
 
 PROCEDURE RestoreHandler (id: INTEGER;  sig: int) =
   BEGIN
-    EVAL Csignal.signal (sig, initial_handlers[id]);
+    EVAL Usignal.sigaction (sig, ADR(initial_handlers[id]), NIL);
   END RestoreHandler;
 
-PROCEDURE Shutdown (sig: int) =
+PROCEDURE Shutdown (sig: int; <*UNUSED*> code: int; <*UNUSED*> scp: SigInfo) =
+  VAR new, old: Usignal.struct_sigaction;
   BEGIN
+    new.sa_handler := DefaultHandler;
+    new.sa_flags   := 0;
     RTProcess.InvokeExitors ();                   (* flush stdio... *)
-    EVAL Csignal.signal (sig, DefaultHandler);    (* restore default handler *)
+    EVAL Usignal.sigaction (sig, ADR(new), ADR(old));       (* restore default handler *)
     EVAL Usignal.kill (Uprocess.getpid (), sig);  (* and resend the signal *)
   END Shutdown;
 
-PROCEDURE Interrupt (sig: int) =
+PROCEDURE Interrupt (sig: int;  code: int;  scp: SigInfo) =
   VAR h := RTProcess.OnInterrupt (NIL);
   BEGIN
     IF (h = NIL) THEN
-      Shutdown (sig);
+      Shutdown (sig, code, scp);
     ELSE
       EVAL RTProcess.OnInterrupt (h); (* reinstall the handler *)
       h ();
     END;
   END Interrupt;
 
-PROCEDURE Quit (<*UNUSED*> sig: int) =
+PROCEDURE Quit (<*UNUSED*> sig, code: int; scp: SigInfo) =
+  VAR pc := 0;
   BEGIN
-    RTMisc.FatalErrorI ("aborted", 0);
+    IF (scp # NIL) THEN pc := scp.sc_eip END;
+    RTMisc.FatalErrorPC (pc, "aborted");
   END Quit;
 
-PROCEDURE SegV (<*UNUSED*> sig: int) =
+PROCEDURE SegV (<*UNUSED*> sig, code: int; scp: SigInfo) =
+  VAR pc := 0;
   BEGIN
-    RTMisc.FatalErrorI (
-      "Segmentation violation - possible attempt to dereference NIL", 0);
+    IF (scp # NIL) THEN pc := scp.sc_eip END;
+    RTMisc.FatalErrorPC (pc,
+      "Segmentation violation - possible attempt to dereference NIL");
   END SegV;
 
 BEGIN