Explorar el Código

* fixes for signal handling.

marco hace 22 años
padre
commit
aebc04656f
Se han modificado 4 ficheros con 117 adiciones y 13 borrados
  1. 48 3
      rtl/bsd/osmain.inc
  2. 49 4
      rtl/freebsd/signal.inc
  3. 7 5
      rtl/freebsd/tthread.inc
  4. 13 1
      rtl/unix/bunxovl.inc

+ 48 - 3
rtl/bsd/osmain.inc

@@ -508,11 +508,52 @@ begin
   reenable_signal:=geterrno=0;
 end;
 
+procedure SignalToRunerror(Sig: cint; var info : tsiginfo_t;Var SigContext:SigContextRec); cdecl;
+
+var
+  res : word;
+
+begin
+  res:=0;
+  case sig of
+    SIGFPE :
+          begin
+	    Case Info.si_code Of
+		FPE_INTDIV : Res:=200;  {integer divide fault. Div0?}
+		FPE_FLTOVF : Res:=205;  {Overflow trap}
+		FPE_FLTUND : Res:=206;  {Stack over/underflow}
+		FPE_FLTRES : Res:=216;  {Device not available}
+		FPE_FLTINV : Res:=216;  {Invalid floating point operation}
+	       Else
+  	        Res:=208; {coprocessor error}
+		End;
+	     sysResetFPU;
+	  End;
+    SIGILL,
+    SIGBUS,
+    SIGSEGV :
+        res:=216;
+  end;
+  {$ifdef FPC_USE_SIGPROCMASK}
+   reenable_signal(sig);
+  {$endif }
+{ give runtime error at the position where the signal was raised }
+  if res<>0 then
+   begin
+{$ifdef I386}
+  HandleErrorAddrFrame(res,Pointer(SigContext.sc_eip),pointer(SigContext.sc_ebp));
+{$else}
+     HandleError(res);
+{$endif}
+   end;
+end;
+{
 procedure SignalToRunerror(signo: cint); cdecl;
 var
   res : word;
 begin
     res:=0;
+
     if signo = SIGFPE then
      begin
         res := 200;
@@ -528,7 +569,7 @@ begin
      HandleError(res);
    end;
 end;
-
+}
 
 var
   act: SigActionRec;
@@ -541,7 +582,8 @@ begin
   { all flags and information set to zero }
   FillChar(act, sizeof(SigActionRec),0);
   { initialize handler                    }
-  act.sa_handler := @SignalToRunError;
+  act.sa_handler :=@SignalToRunError;
+  act.sa_flags:=SA_SIGINFO;
   FpSigAction(SIGFPE,act,oldact);
   FpSigAction(SIGSEGV,act,oldact);
   FpSigAction(SIGBUS,act,oldact);
@@ -628,7 +670,10 @@ End.
 
 {
    $Log$
-   Revision 1.4  2003-10-26 17:01:04  marco
+   Revision 1.5  2003-10-27 17:12:45  marco
+    * fixes for signal handling.
+
+   Revision 1.4  2003/10/26 17:01:04  marco
     * moved sigprocmask to system
 
    Revision 1.3  2003/09/27 13:04:58  peter

+ 49 - 4
rtl/freebsd/signal.inc

@@ -121,23 +121,55 @@ type sigset_t = array[0..3] of Longint;
        fpr_pad      : array[0..63] of char;
        end;
 
+
+
+  Sigval = Record
+            Case Boolean OF
+        { Members as suggested by Annex C of POSIX 1003.1b. }
+                false : (sigval_int : Longint);
+                True  : (sigval_ptr : Pointer);
+            End;
+
+
+  TSigInfo_t = record
+                si_signo,                       { signal number }
+                si_errno,                       { errno association }
+        {
+         * Cause of signal, one of the SI_ macros or signal-specific
+         * values, i.e. one of the FPE_... values for SIGFPE. This
+         * value is equivalent to the second argument to an old-style
+         * FreeBSD signal handler.
+         }
+                si_code,                        { signal code }
+                si_pid          : Longint;      { sending process }
+                si_uid          : Cardinal;     { sender's ruid }
+                si_status       : Longint;      { exit value }
+                si_addr         : Pointer;      { faulting instruction }
+                si_value        : SigVal;       { signal value }
+                si_band         : Cardinal;     { band event for SIGPOLL }
+                __spare         : array[0..6] of Longint; { gimme some slack
+}
+                end;
+
+
+
   SignalHandler   = Procedure(Sig : Longint);cdecl;
   PSignalHandler  = ^SignalHandler;
   SignalRestorer  = Procedure;cdecl;
   PSignalRestorer = ^SignalRestorer;
-  TSigAction = procedure(Sig: Longint; SigContext: SigContextRec;someptr:pointer);cdecl;
+  TSigAction = procedure(Sig: Longint; var sininfo:tsiginfo_t;var SigContext: SigContextRec);cdecl;
 
   TSigset=sigset_t;
   sigset=tsigset;
   PSigSet = ^TSigSet;
 
   SigActionRec = packed record
-{    Handler  : record
+{     Handler  : record
       case byte of
         0: (Sh: SignalHandler);
         1: (Sa: TSigAction);
       end;}
-    sa_handler  : signalhandler;
+    sa_handler  : tsigAction;
     Sa_Flags    : Longint;
     Sa_Mask     : TSigSet;
   end;
@@ -149,11 +181,24 @@ type sigset_t = array[0..3] of Longint;
   If Act is non-nil, it is used to specify the new action.
   If OldAct is non-nil the previous action is saved there.
 }
+const
+       FPE_INTOVF      =1;     { integer overflow }
+        FPE_INTDIV      =2;     { integer divide by zero }
+        FPE_FLTDIV      =3;     { floating point divide by zero }
+        FPE_FLTOVF      =4;     { floating point overflow }
+        FPE_FLTUND      =5;     { floating point underflow }
+        FPE_FLTRES      =6;     { floating point inexact result }
+        FPE_FLTINV      =7;     { invalid floating point operation }
+        FPE_FLTSUB      =8;     { subscript out of range }
+
 
 
 {
   $Log$
-  Revision 1.7  2003-01-05 19:02:29  marco
+  Revision 1.8  2003-10-27 17:12:45  marco
+   * fixes for signal handling.
+
+  Revision 1.7  2003/01/05 19:02:29  marco
    * Should now work with baseunx. (gmake all works)
 
   Revision 1.6  2002/10/26 18:27:52  marco

+ 7 - 5
rtl/freebsd/tthread.inc

@@ -65,8 +65,6 @@ begin
   ThreadRoot:=nil;
   ThreadsInited:=true;
 
-
-
 // This will install SIGCHLD signal handler
 // signal() installs "one-shot" handler,
 // so it is better to install and set up handler with sigaction()
@@ -74,8 +72,9 @@ begin
   GetMem(Act, SizeOf(SigActionRec));
   GetMem(OldAct, SizeOf(SigActionRec));
 
-    Act^.sa_handler := @SIGCHLDHandler;
-    fillchar(Act^.sa_mask,sizeof(sigset_t),#0);
+  signalhandler(Act^.sa_handler) := @SIGCHLDHandler;
+
+  fillchar(Act^.sa_mask,sizeof(sigset_t),#0);
   Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
 			//Do not block all signals ??. Don't need if SA_NOMASK in flags
 
@@ -297,7 +296,10 @@ end;
 
 {
   $Log$
-  Revision 1.2  2003-10-09 10:55:20  marco
+  Revision 1.3  2003-10-27 17:12:45  marco
+   * fixes for signal handling.
+
+  Revision 1.2  2003/10/09 10:55:20  marco
    * fix for moving classes to rtl while cycling with 1.0 start
 
   Revision 1.1  2003/10/06 21:01:06  peter

+ 13 - 1
rtl/unix/bunxovl.inc

@@ -115,11 +115,16 @@ begin
 end;
 
 Function FpSignal(signum:longint;Handler:signalhandler):signalhandler;
+// should be moved out of generic files. Too specific.
 
 var sa,osa : sigactionrec;
 
 begin
+     {$Ifdef BSD}
+     sa.sa_handler:=tsigaction(handler);
+     {$else}
      sa.sa_handler:=handler;
+     {$endif}
      FillChar(sa.sa_mask,sizeof(sigset),#0);
      sa.sa_flags := 0;
 {     if (sigintr and signum) =0 then
@@ -130,7 +135,11 @@ begin
      if getErrNo<>0 then
        fpsignal:=NIL
      else
+      {$ifdef BSD}
+       fpsignal:=signalhandler(osa.sa_handler);
+      {$else}
        fpsignal:=osa.sa_handler;
+      {$endif}
 end;
 
 function xFpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_READ';
@@ -310,7 +319,10 @@ end;
 
 {
  $Log$
- Revision 1.6  2003-10-13 11:37:57  marco
+ Revision 1.7  2003-10-27 17:12:45  marco
+  * fixes for signal handling.
+
+ Revision 1.6  2003/10/13 11:37:57  marco
   * more small fixes
 
  Revision 1.5  2003/10/12 14:37:10  marco