Explorar o código

* remove the RTL's installed signal handlers at the end of the system
unit's initialization code in case we're in a library
+ implemented InquireSignal(), AbandonSignalHandler(), HookSignal() and
UnhookSignal() in the sysutils unit
* for Kylix compatibility, these routines support operating on
SIGINT and SIGQUIT as well, although they are not hooked by default
by FPC. The run time errors/exception codes for these signals are
resp. 217 and 233 (same as in Kylix; I changed ENoWideStringSupport
to 234).
* changed the BSD syscall version of fpsigaction to use pointer
rather than "var" arguments (compatible with other targets, and
required to be able to pass nil arguments inside the system unit)
-> together fixes mantis #12704

git-svn-id: trunk@13077 -

Jonas Maebe %!s(int64=16) %!d(string=hai) anos
pai
achega
f6d452c2c0

+ 2 - 0
.gitattributes

@@ -8795,6 +8795,8 @@ tests/webtbs/tw12597.pp svneol=native#text/plain
 tests/webtbs/tw12614.pp svneol=native#text/plain
 tests/webtbs/tw12614.pp svneol=native#text/plain
 tests/webtbs/tw12685.pp svneol=native#text/plain
 tests/webtbs/tw12685.pp svneol=native#text/plain
 tests/webtbs/tw1269.pp svneol=native#text/plain
 tests/webtbs/tw1269.pp svneol=native#text/plain
+tests/webtbs/tw12704a.pp svneol=native#text/plain
+tests/webtbs/tw12704b.pp svneol=native#text/plain
 tests/webtbs/tw1275.pp svneol=native#text/plain
 tests/webtbs/tw1275.pp svneol=native#text/plain
 tests/webtbs/tw12756.pp svneol=native#text/plain
 tests/webtbs/tw12756.pp svneol=native#text/plain
 tests/webtbs/tw12788.pp svneol=native#text/plain
 tests/webtbs/tw12788.pp svneol=native#text/plain

+ 9 - 1
rtl/beos/i386/sighnd.inc

@@ -16,7 +16,7 @@
  **********************************************************************}
  **********************************************************************}
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigContext: PSigContextRec; uContext: Pvregs);cdecl;
+procedure SignalToRunerror(sig : longint; SigContext: PSigContextRec; uContext: Pvregs);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res,fpustate : word;
   res,fpustate : word;
 begin
 begin
@@ -72,6 +72,14 @@ begin
       begin
       begin
         res:=216;
         res:=216;
       end;
       end;
+    SIGINT:
+      begin
+        res:=217
+      end;
+    SIGQUIT :
+      begin
+        res:=233;
+      end;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }

+ 29 - 7
rtl/beos/system.pp

@@ -318,10 +318,9 @@ end;
 
 
 {$i sighnd.inc}
 {$i sighnd.inc}
 
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
 var
   act: SigActionRec;
   act: SigActionRec;
-
-Procedure InstallSignals;
 begin
 begin
   { Initialize the sigaction structure }
   { Initialize the sigaction structure }
   { all flags and information set to zero }
   { all flags and information set to zero }
@@ -329,12 +328,32 @@ begin
   { initialize handler                    }
   { initialize handler                    }
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_flags:=SA_SIGINFO;
   act.sa_flags:=SA_SIGINFO;
-  FpSigAction(SIGFPE,@act,nil);
-  FpSigAction(SIGSEGV,@act,nil);
-  FpSigAction(SIGBUS,@act,nil);
-  FpSigAction(SIGILL,@act,nil);
+  FpSigAction(signum,@act,@oldact);
+end;
+
+var
+  oldsigfpe: SigActionRec; public name '_FPC_OLDSIGFPE';
+  oldsigsegv: SigActionRec; public name '_FPC_OLDSIGSEGV';
+  oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
+  oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
+
+Procedure InstallSignals;
+begin
+  InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
+  InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
+  InstallDefaultSignalHandler(SIGBUS,oldsigbus);
+  InstallDefaultSignalHandler(SIGILL,oldsigill);
+end;
+
+Procedure RestoreOldSignalHandlers;
+begin
+  FpSigAction(SIGFPE,@oldsigfpe,nil);
+  FpSigAction(SIGSEGV,@oldsigsegv,nil);
+  FpSigAction(SIGBUS,@oldsigbus,nil);
+  FpSigAction(SIGILL,@oldsigill,nil);
 end;
 end;
 
 
+
 procedure SysInitStdIO;
 procedure SysInitStdIO;
 begin
 begin
   { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
   { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
@@ -361,7 +380,7 @@ begin
   if not(IsLibrary) then
   if not(IsLibrary) then
     SysInitFPU;
     SysInitFPU;
 
 
-  { Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
   InstallSignals;
 
 
   SysInitStdIO;
   SysInitStdIO;
@@ -425,4 +444,7 @@ begin
   initunicodestringmanager;
   initunicodestringmanager;
 {$endif VER2_2}
 {$endif VER2_2}
   setupexecname;
   setupexecname;
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 end.
 end.

+ 2 - 2
rtl/bsd/ossysc.inc

@@ -296,7 +296,7 @@ end;
   If OldAct is non-nil the previous action is saved there.
   If OldAct is non-nil the previous action is saved there.
 }
 }
 
 
-function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
+function Fpsigaction(sig: cint; act, oact: psigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
 
 
 {
 {
   Change action of process upon receipt of a signal.
   Change action of process upon receipt of a signal.
@@ -306,7 +306,7 @@ function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec)
 }
 }
 
 
 begin
 begin
-  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
+  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));
 end;
 end;
 
 
 (*=================== MOVED from sysunix.inc ========================*)
 (*=================== MOVED from sysunix.inc ========================*)

+ 31 - 13
rtl/bsd/system.pp

@@ -146,7 +146,7 @@ End;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
-                         SystemUnit Initialization
+                         System Unit Initialization
 *****************************************************************************}
 *****************************************************************************}
 
 
 function  reenable_signal(sig : longint) : boolean;
 function  reenable_signal(sig : longint) : boolean;
@@ -171,28 +171,43 @@ end;
 
 
 {$i sighnd.inc}
 {$i sighnd.inc}
 
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
 var
   act: SigActionRec;
   act: SigActionRec;
-
-Procedure InstallSignals;
-var
-  oldact: SigActionRec;
 begin
 begin
   { Initialize the sigaction structure }
   { Initialize the sigaction structure }
   { all flags and information set to zero }
   { all flags and information set to zero }
-  FillChar(act, sizeof(SigActionRec),0);
+  FillChar(act,sizeof(SigActionRec),0);
   { initialize handler                    }
   { initialize handler                    }
-  act.sa_handler :=@SignalToRunError;
-  act.sa_flags:=SA_SIGINFO;
+  act.sa_handler:=@SignalToRunError;
 {$if defined(darwin) and defined(cpu64)}
 {$if defined(darwin) and defined(cpu64)}
   act.sa_flags:=SA_SIGINFO or SA_64REGSET;
   act.sa_flags:=SA_SIGINFO or SA_64REGSET;
 {$else}
 {$else}
   act.sa_flags:=SA_SIGINFO;
   act.sa_flags:=SA_SIGINFO;
 {$endif}
 {$endif}
-  FpSigAction(SIGFPE,act,oldact);
-  FpSigAction(SIGSEGV,act,oldact);
-  FpSigAction(SIGBUS,act,oldact);
-  FpSigAction(SIGILL,act,oldact);
+  FpSigAction(signum,@act,@oldact);
+end;
+
+var
+  oldsigfpe: SigActionRec; public name '_FPC_OLDSIGFPE';
+  oldsigsegv: SigActionRec; public name '_FPC_OLDSIGSEGV';
+  oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
+  oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
+
+Procedure InstallSignals;
+begin
+  InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
+  InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
+  InstallDefaultSignalHandler(SIGBUS,oldsigbus);
+  InstallDefaultSignalHandler(SIGILL,oldsigill);
+end;
+
+Procedure RestoreOldSignalHandlers;
+begin
+  FpSigAction(SIGFPE,@oldsigfpe,nil);
+  FpSigAction(SIGSEGV,@oldsigsegv,nil);
+  FpSigAction(SIGBUS,@oldsigbus,nil);
+  FpSigAction(SIGILL,@oldsigill,nil);
 end;
 end;
 
 
 
 
@@ -300,7 +315,7 @@ Begin
   IsConsole := TRUE;
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
   StackBottom := Sptr - StackLength;
-  { Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
   InstallSignals;
 
 
   SysResetFPU;
   SysResetFPU;
@@ -327,4 +342,7 @@ Begin
 {$else VER2_2}
 {$else VER2_2}
   initunicodestringmanager;
   initunicodestringmanager;
 {$endif VER2_2}
 {$endif VER2_2}
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 End.
 End.

+ 5 - 1
rtl/darwin/arm/sighnd.inc

@@ -13,7 +13,7 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 }
 
 
-procedure SignalToRunerror(Sig: cint; info : PSigInfo; SigContext:PSigContext); cdecl;
+procedure SignalToRunerror(Sig: cint; info : PSigInfo; SigContext:PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res : word;
   res : word;
@@ -40,6 +40,10 @@ begin
     SIGILL,
     SIGILL,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);
    reenable_signal(sig);

+ 5 - 1
rtl/darwin/ppcgen/ppchnd.inc

@@ -13,7 +13,7 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 }
 
 
-procedure SignalToRunerror(Sig: cint; info : PSigInfo; SigContext:PSigContext); cdecl;
+procedure SignalToRunerror(Sig: cint; info : PSigInfo; SigContext:PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res : word;
   res : word;
@@ -44,6 +44,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);
    reenable_signal(sig);

+ 5 - 1
rtl/darwin/x86/x86hnd.inc

@@ -13,7 +13,7 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 }
 
 
-procedure SignalToRunerror(Sig: cint; info : psiginfo; SigContext:PSigContext); cdecl;
+procedure SignalToRunerror(Sig: cint; info : psiginfo; SigContext:PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   p: pbyte;
   p: pbyte;
@@ -65,6 +65,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);
    reenable_signal(sig);

+ 5 - 1
rtl/freebsd/i386/sighnd.inc

@@ -13,7 +13,7 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 }
 
 
-procedure SignalToRunerror(Sig: cint; info : psiginfo;  SigContext:PSigContext); cdecl;
+procedure SignalToRunerror(Sig: cint; info : psiginfo;  SigContext:PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res : word;
   res : word;
@@ -47,6 +47,10 @@ begin
       res:=214;
       res:=214;
     SIGSEGV :
     SIGSEGV :
       res:=216;
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);
    reenable_signal(sig);

+ 5 - 1
rtl/freebsd/x86_64/sighnd.inc

@@ -13,7 +13,7 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 }
 
 
-procedure SignalToRunerror(Sig: cint; info : psiginfo;  SigContext:PSigContext); cdecl;
+procedure SignalToRunerror(Sig: cint; info : psiginfo;  SigContext:PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res : word;
   res : word;
@@ -38,6 +38,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);
    reenable_signal(sig);

+ 9 - 1
rtl/haiku/i386/sighnd.inc

@@ -16,7 +16,7 @@
  **********************************************************************}
  **********************************************************************}
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigContext: PSigContextRec; uContext: Pvregs);cdecl;
+procedure SignalToRunerror(sig : longint; SigContext: PSigContextRec; uContext: Pvregs);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res,fpustate : word;
   res,fpustate : word;
 begin
 begin
@@ -72,6 +72,14 @@ begin
       begin
       begin
         res:=216;
         res:=216;
       end;
       end;
+    SIGINT:
+      begin
+        res:=217;
+      end;
+    SIGQUIT:
+      begin
+        res:=233;
+      end;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }

+ 29 - 10
rtl/haiku/system.pp

@@ -334,23 +334,21 @@ type
   end;
   end;
 
 
 var
 var
-  act: SigActionRec;
   alternate_signal_stack : TAlternateSignalStack;
   alternate_signal_stack : TAlternateSignalStack;
 
 
-Procedure InstallSignals;
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
 var
-  oldact: SigActionRec;
   r : integer;
   r : integer;
-  st : stack_t;  
+  st : stack_t;
 begin
 begin
   FillChar(st, sizeof(st), 0);
   FillChar(st, sizeof(st), 0);
 
 
   st.ss_flags := 0;
   st.ss_flags := 0;
   st.ss_sp := alternate_signal_stack.buffer;
   st.ss_sp := alternate_signal_stack.buffer;
   st.ss_size := SizeOf(alternate_signal_stack);
   st.ss_size := SizeOf(alternate_signal_stack);
-  
+
   r := sigaltstack(@st, nil);
   r := sigaltstack(@st, nil);
-  
+
   if (r <> 0) then
   if (r <> 0) then
   	WriteLn('error sigalstack');
   	WriteLn('error sigalstack');
   { Initialize the sigaction structure }
   { Initialize the sigaction structure }
@@ -359,11 +357,29 @@ begin
   { initialize handler                    }
   { initialize handler                    }
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_flags := SA_ONSTACK;
   act.sa_flags := SA_ONSTACK;
+  FpSigAction(signum,@act,@oldact);
+end;
 
 
-  FpSigAction(SIGFPE,@act,@oldact);
-  FpSigAction(SIGSEGV,@act,@oldact);
-  FpSigAction(SIGBUS,@act,@oldact);
-  FpSigAction(SIGILL,@act,@oldact);
+var
+  oldsigfpe: SigActionRec; public name '_FPC_OLDSIGFPE';
+  oldsigsegv: SigActionRec; public name '_FPC_OLDSIGSEGV';
+  oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
+  oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
+
+Procedure InstallSignals;
+begin
+  InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
+  InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
+  InstallDefaultSignalHandler(SIGBUS,oldsigbus);
+  InstallDefaultSignalHandler(SIGILL,oldsigill);
+end;
+
+Procedure RestoreOldSignalHandlers;
+begin
+  FpSigAction(SIGFPE,@oldsigfpe,nil);
+  FpSigAction(SIGSEGV,@oldsigsegv,nil);
+  FpSigAction(SIGBUS,@oldsigbus,nil);
+  FpSigAction(SIGILL,@oldsigill,nil);
 end;
 end;
 
 
 procedure SysInitStdIO;
 procedure SysInitStdIO;
@@ -458,4 +474,7 @@ begin
   initunicodestringmanager;
   initunicodestringmanager;
 {$endif VER2_2}
 {$endif VER2_2}
   setupexecname;
   setupexecname;
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 end.
 end.

+ 5 - 1
rtl/linux/arm/sighnd.inc

@@ -16,7 +16,7 @@
  **********************************************************************}
  **********************************************************************}
 
 
 
 
-procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); cdecl;
+procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res,fpustate : word;
   res,fpustate : word;
@@ -41,6 +41,10 @@ begin
         res:=216;
         res:=216;
     SIGBUS:
     SIGBUS:
         res:=214;
         res:=214;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }

+ 5 - 1
rtl/linux/i386/sighnd.inc

@@ -16,7 +16,7 @@
  **********************************************************************}
  **********************************************************************}
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res,fpustate : word;
   res,fpustate : word;
 begin
 begin
@@ -63,6 +63,10 @@ begin
         res:=216;
         res:=216;
     SIGSEGV :
     SIGSEGV :
       res:=216;
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }

+ 5 - 1
rtl/linux/m68k/sighnd.inc

@@ -64,7 +64,7 @@ end;
 
 
 
 
 
 
-procedure SignalToRunerror(Sig: longint; Info : pointer; var SigContext: TSigContext); cdecl;
+procedure SignalToRunerror(Sig: longint; Info : pointer; var SigContext: TSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 var
 var
   res,fpustate : word;
   res,fpustate : word;
 begin
 begin
@@ -101,6 +101,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
 
 
   reenable_signal(sig);
   reenable_signal(sig);

+ 5 - 1
rtl/linux/powerpc/sighnd.inc

@@ -15,7 +15,7 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext);cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res : word;
   res : word;
 {  fpustate: longint; }
 {  fpustate: longint; }
@@ -39,6 +39,10 @@ begin
     SIGILL,
     SIGILL,
     SIGSEGV :
     SIGSEGV :
       res:=216;
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }

+ 5 - 1
rtl/linux/powerpc64/sighnd.inc

@@ -15,7 +15,7 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext); cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 var
 var
   res : word;
   res : word;
 begin
 begin
@@ -38,6 +38,10 @@ begin
     SIGILL,
     SIGILL,
     SIGSEGV :
     SIGSEGV :
       res:=216;
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
 
 
   { reenable signal }
   { reenable signal }

+ 5 - 1
rtl/linux/sparc/sighnd.inc

@@ -15,7 +15,7 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res : word;
   res : word;
   addr : pointer;
   addr : pointer;
@@ -52,6 +52,10 @@ begin
           addr := siginfo^._sifields._sigfault._addr;
           addr := siginfo^._sifields._sigfault._addr;
           res:=216;
           res:=216;
         end;
         end;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }

+ 28 - 7
rtl/linux/system.pp

@@ -236,10 +236,9 @@ end;
 
 
 {$i sighnd.inc}
 {$i sighnd.inc}
 
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
 var
   act: SigActionRec;
   act: SigActionRec;
-
-Procedure InstallSignals;
 begin
 begin
   { Initialize the sigaction structure }
   { Initialize the sigaction structure }
   { all flags and information set to zero }
   { all flags and information set to zero }
@@ -247,10 +246,21 @@ begin
   { initialize handler                    }
   { initialize handler                    }
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_handler := SigActionHandler(@SignalToRunError);
   act.sa_flags:=SA_SIGINFO;
   act.sa_flags:=SA_SIGINFO;
-  FpSigAction(SIGFPE,@act,nil);
-  FpSigAction(SIGSEGV,@act,nil);
-  FpSigAction(SIGBUS,@act,nil);
-  FpSigAction(SIGILL,@act,nil);
+  FpSigAction(signum,@act,@oldact);
+end;
+
+var
+  oldsigfpe: SigActionRec; public name '_FPC_OLDSIGFPE';
+  oldsigsegv: SigActionRec; public name '_FPC_OLDSIGSEGV';
+  oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
+  oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
+
+Procedure InstallSignals;
+begin
+  InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
+  InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
+  InstallDefaultSignalHandler(SIGBUS,oldsigbus);
+  InstallDefaultSignalHandler(SIGILL,oldsigill);
 end;
 end;
 
 
 procedure SysInitStdIO;
 procedure SysInitStdIO;
@@ -262,6 +272,14 @@ begin
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 end;
 end;
 
 
+Procedure RestoreOldSignalHandlers;
+begin
+  FpSigAction(SIGFPE,@oldsigfpe,nil);
+  FpSigAction(SIGSEGV,@oldsigsegv,nil);
+  FpSigAction(SIGBUS,@oldsigbus,nil);
+  FpSigAction(SIGILL,@oldsigill,nil);
+end;
+
 
 
 procedure SysInitExecPath;
 procedure SysInitExecPath;
 var
 var
@@ -318,7 +336,7 @@ begin
   IsConsole := TRUE;
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(initialStkLen);
   StackLength := CheckInitialStkLen(initialStkLen);
   StackBottom := initialstkptr - StackLength;
   StackBottom := initialstkptr - StackLength;
-  { Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
   InstallSignals;
 
 
 {$if defined(cpui386) or defined(cpuarm)}
 {$if defined(cpui386) or defined(cpuarm)}
@@ -342,4 +360,7 @@ begin
 {$else VER2_2}
 {$else VER2_2}
   initunicodestringmanager;
   initunicodestringmanager;
 {$endif VER2_2}
 {$endif VER2_2}
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 end.
 end.

+ 5 - 1
rtl/linux/x86_64/sighnd.inc

@@ -32,7 +32,7 @@ function GetFPUState(const SigContext : TSigContext) : word;
   end;
   end;
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
   var
   var
     res,fpustate : word;
     res,fpustate : word;
   begin
   begin
@@ -68,6 +68,10 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
       SIGBUS,
       SIGBUS,
       SIGSEGV:
       SIGSEGV:
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
     end;
     end;
     reenable_signal(sig);
     reenable_signal(sig);
     if res<>0 then
     if res<>0 then

+ 5 - 1
rtl/netbsd/i386/sighnd.inc

@@ -19,7 +19,7 @@ function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
 begin
 begin
   getfpustate:=0;
   getfpustate:=0;
 end;
 end;
-procedure SignalToRunerror(Sig: longint;code:longint; var SigContext: SigContextRec); cdecl;
+procedure SignalToRunerror(Sig: longint;code:longint; var SigContext: SigContextRec); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res,fpustate : word;
   res,fpustate : word;
@@ -65,6 +65,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }

+ 9 - 1
rtl/netbsd/powerpc/sighnd.inc

@@ -20,7 +20,7 @@ begin
   getfpustate:=0;
   getfpustate:=0;
 end;
 end;
 
 
-procedure SignalToRunerror(signo: cint); cdecl;
+procedure SignalToRunerror(signo: cint); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 var
 var
   res : word;
   res : word;
 begin
 begin
@@ -33,6 +33,14 @@ begin
     if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
     if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
       begin
       begin
         res := 216;
         res := 216;
+      end
+    else if (signo = SIGINT) then
+      begin
+        res:=217;
+      end
+    else if (signo = SIGKILL) then
+      begin
+        res:=233
       end;
       end;
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }
   if res<>0 then
   if res<>0 then

+ 1 - 0
rtl/objpas/sysconst.pp

@@ -77,6 +77,7 @@ resourcestring
   SNoError               = 'No error.';
   SNoError               = 'No error.';
   SNoThreadSupport       = 'Threads not supported. Recompile program with thread driver.';
   SNoThreadSupport       = 'Threads not supported. Recompile program with thread driver.';
   SMissingWStringManager = 'Widestring manager not available. Recompile program with appropriate manager.';
   SMissingWStringManager = 'Widestring manager not available. Recompile program with appropriate manager.';
+  SSigQuit               = 'SIGQUIT signal received.';
   SOSError               = 'System error, (OS Code %d):'+LineEnding+'%s';
   SOSError               = 'System error, (OS Code %d):'+LineEnding+'%s';
   SOutOfMemory           = 'Out of memory';
   SOutOfMemory           = 'Out of memory';
   SOverflow              = 'Floating point overflow';
   SOverflow              = 'Floating point overflow';

+ 2 - 1
rtl/objpas/sysutils/sysutils.inc

@@ -331,7 +331,8 @@ begin
   229 : E:=ESafecallException.Create(SSafecallException);
   229 : E:=ESafecallException.Create(SSafecallException);
   231 : E:=EConvertError.Create(SiconvError);
   231 : E:=EConvertError.Create(SiconvError);
   232 : E:=ENoThreadSupport.Create(SNoThreadSupport);
   232 : E:=ENoThreadSupport.Create(SNoThreadSupport);
-  233 : E:=ENoWideStringSupport.Create(SMissingWStringManager);
+  233 : E:=ENoWideStringSupport.Create(SSigQuit);
+  234 : E:=ENoWideStringSupport.Create(SMissingWStringManager);
   else
   else
    E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
    E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
   end;
   end;

+ 5 - 1
rtl/openbsd/i386/sighnd.inc

@@ -19,7 +19,7 @@ function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
 begin
 begin
   getfpustate:=0;
   getfpustate:=0;
 end;
 end;
-procedure SignalToRunerror(Sig: longint;code:longint; var SigContext: SigContextRec); cdecl;
+procedure SignalToRunerror(Sig: longint;code:longint; var SigContext: SigContextRec); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 
 
 var
 var
   res,fpustate : word;
   res,fpustate : word;
@@ -65,6 +65,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }

+ 5 - 1
rtl/solaris/i386/sighnd.inc

@@ -16,7 +16,7 @@
  **********************************************************************}
  **********************************************************************}
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res,fpustate : word;
   res,fpustate : word;
 begin
 begin
@@ -50,6 +50,10 @@ begin
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
         res:=216;
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGKILL :
+        res:=233;
   end;
   end;
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }
   if res<>0 then
   if res<>0 then

+ 5 - 1
rtl/solaris/sparc/sighnd.inc

@@ -32,7 +32,7 @@ const
   FPE_FLTSUB = 8;
   FPE_FLTSUB = 8;
 
 
 
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
 var
 var
   res : word;
   res : word;
   addr : pointer;
   addr : pointer;
@@ -76,6 +76,10 @@ begin
       begin
       begin
         res:=214;
         res:=214;
       end;
       end;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   end;
   reenable_signal(sig);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }

+ 28 - 9
rtl/solaris/system.pp

@@ -121,12 +121,9 @@ end;
 
 
 {$i sighnd.inc}
 {$i sighnd.inc}
 
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
 var
   act: SigActionRec;
   act: SigActionRec;
-
-Procedure InstallSignals;
-var
-  oldact: SigActionRec;
 begin
 begin
   { Initialize the sigaction structure }
   { Initialize the sigaction structure }
   { all flags and information set to zero }
   { all flags and information set to zero }
@@ -134,10 +131,29 @@ begin
   { initialize handler                    }
   { initialize handler                    }
   act.sa_handler :=@SignalToRunError;
   act.sa_handler :=@SignalToRunError;
   act.sa_flags:=SA_SIGINFO;
   act.sa_flags:=SA_SIGINFO;
-  FpSigAction(SIGFPE,act,oldact);
-  FpSigAction(SIGSEGV,act,oldact);
-  FpSigAction(SIGBUS,act,oldact);
-  FpSigAction(SIGILL,act,oldact);
+  FpSigAction(signum,act,oldact);
+end;
+
+var
+  oldsigfpe: SigActionRec; public name '_FPC_OLDSIGFPE';
+  oldsigsegv: SigActionRec; public name '_FPC_OLDSIGSEGV';
+  oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
+  oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
+
+Procedure InstallSignals;
+begin
+  InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
+  InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
+  InstallDefaultSignalHandler(SIGBUS,oldsigbus);
+  InstallDefaultSignalHandler(SIGILL,oldsigill);
+end;
+
+Procedure RestoreOldSignalHandlers;
+begin
+  FpSigAction(SIGFPE,@oldsigfpe,nil);
+  FpSigAction(SIGSEGV,@oldsigsegv,nil);
+  FpSigAction(SIGBUS,@oldsigbus,nil);
+  FpSigAction(SIGILL,@oldsigill,nil);
 end;
 end;
 
 
 
 
@@ -224,7 +240,7 @@ Begin
   IsConsole := TRUE;
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
   StackBottom := Sptr - StackLength;
-{ Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
   InstallSignals;
 { Setup heap }
 { Setup heap }
   InitHeap;
   InitHeap;
@@ -242,4 +258,7 @@ Begin
 {$else VER2_2}
 {$else VER2_2}
   initunicodestringmanager;
   initunicodestringmanager;
 {$endif VER2_2}
 {$endif VER2_2}
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 End.
 End.

+ 162 - 0
rtl/unix/sysutils.pp

@@ -66,23 +66,185 @@ implementation
 Uses
 Uses
   {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix, unixutil;
   {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF}, Baseunix, unixutil;
 
 
+type
+  tsiginfo = record
+    oldsiginfo: sigactionrec;
+    hooked: boolean;
+  end;
+
+const
+  rtlsig2ossig: array[RTL_SIGINT..RTL_SIGLAST] of byte =
+    (SIGINT,SIGFPE,SIGSEGV,SIGILL,SIGBUS,SIGQUIT);
+  { to avoid linking in all this stuff in every program,
+    as it's unlikely to be used by anything but libraries
+  }
+  signalinfoinited: boolean = false;
+
+var
+  siginfo: array[RTL_SIGINT..RTL_SIGLAST] of tsiginfo;
+  oldsigfpe: SigActionRec; external name '_FPC_OLDSIGFPE';
+  oldsigsegv: SigActionRec; external name '_FPC_OLDSIGSEGV';
+  oldsigbus: SigActionRec; external name '_FPC_OLDSIGBUS';
+  oldsigill: SigActionRec; external name '_FPC_OLDSIGILL';
+
+
+procedure defaultsighandler; external name '_FPC_DEFAULTSIGHANDLER';
+procedure installdefaultsignalhandler(signum: Integer; out oldact: SigActionRec); external name '_FPC_INSTALLDEFAULTSIGHANDLER';
+
+
+function InternalInquireSignal(RtlSigNum: Integer; out act: SigActionRec; frominit: boolean): TSignalState;
+  begin
+    result:=ssNotHooked;
+    if (RtlSigNum<>RTL_SIGDEFAULT) and
+       (RtlSigNum<RTL_SIGLAST) then
+      begin
+        if (frominit or
+            siginfo[RtlSigNum].hooked) and
+           (fpsigaction(rtlsig2ossig[RtlSigNum],nil,@act)=0) then
+          begin
+            if not frominit then
+              begin
+                { check whether the installed signal handler is still ours }
+                if (pointer(act.sa_handler)=pointer(@defaultsighandler)) then
+                  result:=ssHooked
+                else
+                  result:=ssOverridden;
+              end
+            else if IsLibrary then
+              begin
+                { library -> signals have not been hooked by system init code }
+                exit
+              end
+            else
+              begin
+                { program -> signals have been hooked by system init code }
+                if (byte(RtlSigNum) in [RTL_SIGFPE,RTL_SIGSEGV,RTL_SIGILL,RTL_SIGBUS]) then
+                  begin
+                    if (pointer(act.sa_handler)=pointer(@defaultsighandler)) then
+                      result:=ssHooked
+                    else
+                      result:=ssOverridden;
+                    { return the original handlers as saved by the system unit
+                      (the current call to sigaction simply returned our
+                       system unit's installed handlers)
+                    }
+                    case RtlSigNum of
+                      RTL_SIGFPE:
+                        act:=oldsigfpe;
+                      RTL_SIGSEGV:
+                        act:=oldsigsegv;
+                      RTL_SIGILL:
+                        act:=oldsigill;
+                      RTL_SIGBUS:
+                        act:=oldsigbus;
+                    end;
+                  end
+                else
+                  begin
+                    { these are not hooked in the startup code }
+                    result:=ssNotHooked;
+                  end
+              end
+          end
+      end;
+  end;
+
+
+procedure initsignalinfo;
+  var
+    i: Integer;
+  begin
+    for i:=RTL_SIGINT to RTL_SIGLAST do
+      siginfo[i].hooked:=(InternalInquireSignal(i,siginfo[i].oldsiginfo,true)=ssHooked);
+    signalinfoinited:=true;
+  end;
+
+
 function InquireSignal(RtlSigNum: Integer): TSignalState;
 function InquireSignal(RtlSigNum: Integer): TSignalState;
+  var
+    act: SigActionRec;
   begin
   begin
+    if not signalinfoinited then
+      initsignalinfo;
+    result:=InternalInquireSignal(RtlSigNum,act,false);
   end;
   end;
 
 
 
 
 procedure AbandonSignalHandler(RtlSigNum: Integer);
 procedure AbandonSignalHandler(RtlSigNum: Integer);
   begin
   begin
+    if not signalinfoinited then
+      initsignalinfo;
+    if (RtlSigNum<>RTL_SIGDEFAULT) and
+       (RtlSigNum<RTL_SIGLAST) then
+      siginfo[RtlSigNum].hooked:=false;
   end;
   end;
 
 
 
 
 procedure HookSignal(RtlSigNum: Integer);
 procedure HookSignal(RtlSigNum: Integer);
+  var
+    lowsig, highsig, i: Integer;
   begin
   begin
+    if not signalinfoinited then
+      initsignalinfo;
+    if (RtlSigNum<>RTL_SIGDEFAULT) then
+      begin
+        lowsig:=RtlSigNum;
+        highsig:=RtlSigNum;
+      end
+    else
+      begin
+        { we don't hook SIGINT and SIGQUIT by default }
+        lowsig:=RTL_SIGFPE;
+        highsig:=RTL_SIGBUS;
+      end;
+    { install the default rtl signal handler for the selected signal(s) }
+    for i:=lowsig to highsig do
+      begin
+        installdefaultsignalhandler(rtlsig2ossig[i],siginfo[i].oldsiginfo);
+        siginfo[i].hooked:=true;
+      end;
   end;
   end;
 
 
 
 
 procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
 procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
+  var
+    act: SigActionRec;
+    lowsig, highsig, i: Integer;
+    state: TSignalState;
   begin
   begin
+    if not signalinfoinited then
+      initsignalinfo;
+    if (RtlSigNum<>RTL_SIGDEFAULT) then
+      begin
+        lowsig:=RtlSigNum;
+        highsig:=RtlSigNum;
+      end
+    else
+      begin
+        { we don't hook SIGINT and SIGQUIT by default }
+        lowsig:=RTL_SIGFPE;
+        highsig:=RTL_SIGBUS;
+      end;
+    for i:=lowsig to highsig do
+      begin
+        if not OnlyIfHooked or
+           (InquireSignal(i)=ssHooked) then
+          begin
+            { restore the handler that was present when we hooked the signal,
+              if we hooked it at one time or another. If the user doesn't
+              want this, they have to call AbandonSignalHandler() first
+            }
+            if siginfo[i].hooked then
+              act:=siginfo[i].oldsiginfo
+            else
+              begin
+                fillchar(act,sizeof(act),0);
+                pointer(act.sa_handler):=pointer(SIG_DFL);
+              end;
+            if (fpsigaction(rtlsig2ossig[RtlSigNum],@act,nil)=0) then
+              siginfo[i].hooked:=false;
+          end;
+      end;
   end;
   end;
 
 
 {$Define OS_FILEISREADONLY} // Specific implementation for Unix.
 {$Define OS_FILEISREADONLY} // Specific implementation for Unix.

+ 107 - 0
tests/webtbs/tw12704a.pp

@@ -0,0 +1,107 @@
+{ %norun }
+{ %target=darwin,linux,freebsd,solaris,beos,haiku }
+
+{$mode delphi}
+
+{$ifdef darwin}
+{$PIC+}
+{$endif darwin}
+
+{$ifdef CPUX86_64}
+{$ifndef WINDOWS}
+{$PIC+}
+{$endif WINDOWS}
+{$endif CPUX86_64}
+
+library tw12704a;
+
+uses
+  SysUtils;
+
+procedure initsignals;
+var
+  p: pointer;
+  i: longint;
+begin
+  // check that none of the handlers have been yet by the library's init code
+  for i:=RTL_SIGINT to RTL_SIGLAST do
+    if (InquireSignal(i) <> ssNotHooked) then
+      halt(1);
+
+  // hook standard signals
+  HookSignal(RTL_SIGDEFAULT);
+  for i:=RTL_SIGINT to RTL_SIGLAST do
+    case i of
+      RTL_SIGINT,
+      RTL_SIGQUIT:
+        if (InquireSignal(i) <> ssNotHooked) then
+          halt(2);
+      RTL_SIGFPE,
+      RTL_SIGSEGV,
+      RTL_SIGILL,
+      RTL_SIGBUS:
+        if (InquireSignal(i) <> ssHooked) then
+          halt(3);
+      else
+        halt(4);
+    end;
+
+  // unhook sigill
+  UnHookSignal(RTL_SIGILL);
+  for i:=RTL_SIGINT to RTL_SIGLAST do
+    case i of
+      RTL_SIGINT,
+      RTL_SIGILL,
+      RTL_SIGQUIT:
+        if (InquireSignal(i) <> ssNotHooked) then
+          halt(5);
+      RTL_SIGFPE,
+      RTL_SIGSEGV,
+      RTL_SIGBUS:
+        if (InquireSignal(i) <> ssHooked) then
+          halt(6);
+    end;
+
+  // check whether installed signal handler actually works
+(*
+  try
+    p:=nil;
+    longint(p^):=1;
+  except
+  end;     
+*)
+end;
+
+
+procedure testsignals; cdecl;
+var
+  i: longint;
+begin
+  // called from program -> it has overridden our signal handlers
+  // when this routine is called, it will have unhooked sigbus, so
+  // that one should still belong to us
+  // we previously unhooked sigill, so that one should still be
+  // unhooked as far as we are concerned
+  for i:=RTL_SIGINT to RTL_SIGLAST do
+    case i of
+      RTL_SIGINT,
+      RTL_SIGILL,
+      RTL_SIGQUIT:
+        if (InquireSignal(i) <> ssNothooked) then
+          halt(7);
+      RTL_SIGFPE,
+      RTL_SIGSEGV:
+        if (InquireSignal(i) <> ssOverridden) then
+          halt(8);      
+      RTL_SIGBUS:
+        if (InquireSignal(i) <> ssHooked) then
+          halt(9);
+    end;
+end;
+
+exports
+  testsignals;
+
+begin
+  initsignals;
+end.

+ 49 - 0
tests/webtbs/tw12704b.pp

@@ -0,0 +1,49 @@
+{ %target=darwin,linux,freebsd,solaris,beos,haiku }
+{ %NEEDLIBRARY }
+
+{$mode delphi}
+program MainApp;
+
+uses
+  sysutils;
+
+const
+{$ifdef windows}
+  libname='tw12704a.dll';
+{$else}
+  libname='tw12704a';
+  {$linklib tw12704a}
+{$endif}
+
+procedure testsignals; cdecl; external libname;
+
+procedure initsignals;
+var
+  p: pointer;
+  i: longint;
+begin
+  // check that standard signals are hooked
+  for i:=RTL_SIGINT to RTL_SIGLAST do
+    case i of
+      RTL_SIGINT,
+      RTL_SIGQUIT:
+        if (InquireSignal(i) <> ssNotHooked) then
+          halt(102);
+      RTL_SIGFPE,
+      RTL_SIGSEGV,
+      RTL_SIGILL,
+      RTL_SIGBUS:
+        if (InquireSignal(i) <> ssHooked) then
+          halt(103);
+      else
+        halt(104);
+    end;
+
+  // unhook sigbus
+  UnhookSignal(RTL_SIGBUS);
+end;
+
+begin
+  initsignals;
+  testsignals
+end.