Переглянути джерело

* 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 16 роки тому
батько
коміт
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/tw12685.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/tw12756.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
   res,fpustate : word;
 begin
@@ -72,6 +72,14 @@ begin
       begin
         res:=216;
       end;
+    SIGINT:
+      begin
+        res:=217
+      end;
+    SIGQUIT :
+      begin
+        res:=233;
+      end;
   end;
   reenable_signal(sig);
 { 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}
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
   act: SigActionRec;
-
-Procedure InstallSignals;
 begin
   { Initialize the sigaction structure }
   { all flags and information set to zero }
@@ -329,12 +328,32 @@ begin
   { initialize handler                    }
   act.sa_handler := SigActionHandler(@SignalToRunError);
   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;
 
+
 procedure SysInitStdIO;
 begin
   { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
@@ -361,7 +380,7 @@ begin
   if not(IsLibrary) then
     SysInitFPU;
 
-  { Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
 
   SysInitStdIO;
@@ -425,4 +444,7 @@ begin
   initunicodestringmanager;
 {$endif VER2_2}
   setupexecname;
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 end.

+ 2 - 2
rtl/bsd/ossysc.inc

@@ -296,7 +296,7 @@ end;
   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.
@@ -306,7 +306,7 @@ function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec)
 }
 
 begin
-  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
+  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));
 end;
 
 (*=================== 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;
@@ -171,28 +171,43 @@ end;
 
 {$i sighnd.inc}
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
   act: SigActionRec;
-
-Procedure InstallSignals;
-var
-  oldact: SigActionRec;
 begin
   { Initialize the sigaction structure }
   { all flags and information set to zero }
-  FillChar(act, sizeof(SigActionRec),0);
+  FillChar(act,sizeof(SigActionRec),0);
   { initialize handler                    }
-  act.sa_handler :=@SignalToRunError;
-  act.sa_flags:=SA_SIGINFO;
+  act.sa_handler:=@SignalToRunError;
 {$if defined(darwin) and defined(cpu64)}
   act.sa_flags:=SA_SIGINFO or SA_64REGSET;
 {$else}
   act.sa_flags:=SA_SIGINFO;
 {$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;
 
 
@@ -300,7 +315,7 @@ Begin
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
-  { Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
 
   SysResetFPU;
@@ -327,4 +342,7 @@ Begin
 {$else VER2_2}
   initunicodestringmanager;
 {$endif VER2_2}
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 End.

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

@@ -13,7 +13,7 @@
    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
   res : word;
@@ -40,6 +40,10 @@ begin
     SIGILL,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);

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

@@ -13,7 +13,7 @@
    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
   res : word;
@@ -44,6 +44,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);

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

@@ -13,7 +13,7 @@
    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
   p: pbyte;
@@ -65,6 +65,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);

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

@@ -13,7 +13,7 @@
    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
   res : word;
@@ -47,6 +47,10 @@ begin
       res:=214;
     SIGSEGV :
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
    reenable_signal(sig);

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

@@ -13,7 +13,7 @@
    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
   res : word;
@@ -38,6 +38,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   {$ifdef FPC_USE_SIGPROCMASK}
    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
   res,fpustate : word;
 begin
@@ -72,6 +72,14 @@ begin
       begin
         res:=216;
       end;
+    SIGINT:
+      begin
+        res:=217;
+      end;
+    SIGQUIT:
+      begin
+        res:=233;
+      end;
   end;
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }

+ 29 - 10
rtl/haiku/system.pp

@@ -334,23 +334,21 @@ type
   end;
 
 var
-  act: SigActionRec;
   alternate_signal_stack : TAlternateSignalStack;
 
-Procedure InstallSignals;
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
-  oldact: SigActionRec;
   r : integer;
-  st : stack_t;  
+  st : stack_t;
 begin
   FillChar(st, sizeof(st), 0);
 
   st.ss_flags := 0;
   st.ss_sp := alternate_signal_stack.buffer;
   st.ss_size := SizeOf(alternate_signal_stack);
-  
+
   r := sigaltstack(@st, nil);
-  
+
   if (r <> 0) then
   	WriteLn('error sigalstack');
   { Initialize the sigaction structure }
@@ -359,11 +357,29 @@ begin
   { initialize handler                    }
   act.sa_handler := SigActionHandler(@SignalToRunError);
   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;
 
 procedure SysInitStdIO;
@@ -458,4 +474,7 @@ begin
   initunicodestringmanager;
 {$endif VER2_2}
   setupexecname;
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 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
   res,fpustate : word;
@@ -41,6 +41,10 @@ begin
         res:=216;
     SIGBUS:
         res:=214;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
   { 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
   res,fpustate : word;
 begin
@@ -63,6 +63,10 @@ begin
         res:=216;
     SIGSEGV :
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
 { 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
   res,fpustate : word;
 begin
@@ -101,6 +101,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
 
   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
   res : word;
 {  fpustate: longint; }
@@ -39,6 +39,10 @@ begin
     SIGILL,
     SIGSEGV :
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
   { 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
   res : word;
 begin
@@ -38,6 +38,10 @@ begin
     SIGILL,
     SIGSEGV :
       res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
 
   { 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
   res : word;
   addr : pointer;
@@ -52,6 +52,10 @@ begin
           addr := siginfo^._sifields._sigfault._addr;
           res:=216;
         end;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
   { 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}
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
   act: SigActionRec;
-
-Procedure InstallSignals;
 begin
   { Initialize the sigaction structure }
   { all flags and information set to zero }
@@ -247,10 +246,21 @@ begin
   { initialize handler                    }
   act.sa_handler := SigActionHandler(@SignalToRunError);
   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 SysInitStdIO;
@@ -262,6 +272,14 @@ begin
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 end;
 
+Procedure RestoreOldSignalHandlers;
+begin
+  FpSigAction(SIGFPE,@oldsigfpe,nil);
+  FpSigAction(SIGSEGV,@oldsigsegv,nil);
+  FpSigAction(SIGBUS,@oldsigbus,nil);
+  FpSigAction(SIGILL,@oldsigill,nil);
+end;
+
 
 procedure SysInitExecPath;
 var
@@ -318,7 +336,7 @@ begin
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(initialStkLen);
   StackBottom := initialstkptr - StackLength;
-  { Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
 
 {$if defined(cpui386) or defined(cpuarm)}
@@ -342,4 +360,7 @@ begin
 {$else VER2_2}
   initunicodestringmanager;
 {$endif VER2_2}
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 end.

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

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

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

@@ -19,7 +19,7 @@ function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
 begin
   getfpustate:=0;
 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
   res,fpustate : word;
@@ -65,6 +65,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
 { 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;
 end;
 
-procedure SignalToRunerror(signo: cint); cdecl;
+procedure SignalToRunerror(signo: cint); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
 var
   res : word;
 begin
@@ -33,6 +33,14 @@ begin
     if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
       begin
         res := 216;
+      end
+    else if (signo = SIGINT) then
+      begin
+        res:=217;
+      end
+    else if (signo = SIGKILL) then
+      begin
+        res:=233
       end;
   { give runtime error at the position where the signal was raised }
   if res<>0 then

+ 1 - 0
rtl/objpas/sysconst.pp

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

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

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

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

@@ -19,7 +19,7 @@ function getfpustate(const Sigcontext:sigcontextRec):longint; {inline;}
 begin
   getfpustate:=0;
 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
   res,fpustate : word;
@@ -65,6 +65,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
 { 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
   res,fpustate : word;
 begin
@@ -50,6 +50,10 @@ begin
     SIGBUS,
     SIGSEGV :
         res:=216;
+    SIGINT:
+        res:=217;
+    SIGKILL :
+        res:=233;
   end;
 { give runtime error at the position where the signal was raised }
   if res<>0 then

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

@@ -32,7 +32,7 @@ const
   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
   res : word;
   addr : pointer;
@@ -76,6 +76,10 @@ begin
       begin
         res:=214;
       end;
+    SIGINT:
+        res:=217;
+    SIGQUIT:
+        res:=233;
   end;
   reenable_signal(sig);
   { 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}
 
+procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
 var
   act: SigActionRec;
-
-Procedure InstallSignals;
-var
-  oldact: SigActionRec;
 begin
   { Initialize the sigaction structure }
   { all flags and information set to zero }
@@ -134,10 +131,29 @@ begin
   { initialize handler                    }
   act.sa_handler :=@SignalToRunError;
   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;
 
 
@@ -224,7 +240,7 @@ Begin
   IsConsole := TRUE;
   StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
-{ Set up signals handlers }
+  { Set up signals handlers (may be needed by init code to test cpu features) }
   InstallSignals;
 { Setup heap }
   InitHeap;
@@ -242,4 +258,7 @@ Begin
 {$else VER2_2}
   initunicodestringmanager;
 {$endif VER2_2}
+  { restore original signal handlers in case this is a library }
+  if IsLibrary then
+    RestoreOldSignalHandlers;
 End.

+ 162 - 0
rtl/unix/sysutils.pp

@@ -66,23 +66,185 @@ implementation
 Uses
   {$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;
+  var
+    act: SigActionRec;
   begin
+    if not signalinfoinited then
+      initsignalinfo;
+    result:=InternalInquireSignal(RtlSigNum,act,false);
   end;
 
 
 procedure AbandonSignalHandler(RtlSigNum: Integer);
   begin
+    if not signalinfoinited then
+      initsignalinfo;
+    if (RtlSigNum<>RTL_SIGDEFAULT) and
+       (RtlSigNum<RTL_SIGLAST) then
+      siginfo[RtlSigNum].hooked:=false;
   end;
 
 
 procedure HookSignal(RtlSigNum: Integer);
+  var
+    lowsig, highsig, i: Integer;
   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;
 
 
 procedure UnhookSignal(RtlSigNum: Integer; OnlyIfHooked: Boolean = True);
+  var
+    act: SigActionRec;
+    lowsig, highsig, i: Integer;
+    state: TSignalState;
   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;
 
 {$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.