

{$ifdef windows}
//Copy-pasted from the System unit (FPC 2.2.4)--------------------------------\
  const
    EXCEPTION_EXECUTE_HANDLER    =  1;
    EXCEPTION_CONTINUE_EXECUTION = -1;
    EXCEPTION_CONTINUE_SEARCH    =  0;
    EXCEPTION_MAXIMUM_PARAMETERS = 15;
    MAXIMUM_SUPPORTED_EXTENSION  = 512;

  type
    PFloatingSaveArea = ^TFloatingSaveArea;
    TFloatingSaveArea = packed record
            ControlWord : Cardinal;
            StatusWord : Cardinal;
            TagWord : Cardinal;
            ErrorOffset : Cardinal;
            ErrorSelector : Cardinal;
            DataOffset : Cardinal;
            DataSelector : Cardinal;
            RegisterArea : array[0..79] of Byte;
            Cr0NpxState : Cardinal;
    end;

    PContext = ^TContext;
    TContext = packed record
        //
        // The flags values within this flag control the contents of
        // a CONTEXT record.
        //
            ContextFlags : Cardinal;

        //
        // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
        // set in ContextFlags.  Note that CONTEXT_DEBUG_REGISTERS is NOT
        // included in CONTEXT_FULL.
        //
            Dr0, Dr1, Dr2,
            Dr3, Dr6, Dr7 : Cardinal;

        //
        // This section is specified/returned if the
        // ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
        //
            FloatSave : TFloatingSaveArea;

        //
        // This section is specified/returned if the
        // ContextFlags word contains the flag CONTEXT_SEGMENTS.
        //
            SegGs, SegFs,
            SegEs, SegDs : Cardinal;

        //
        // This section is specified/returned if the
        // ContextFlags word contains the flag CONTEXT_INTEGER.
        //
            Edi, Esi, Ebx,
            Edx, Ecx, Eax : Cardinal;

        //
        // This section is specified/returned if the
        // ContextFlags word contains the flag CONTEXT_CONTROL.
        //
            Ebp : Cardinal;
            Eip : Cardinal;
            SegCs : Cardinal;
            EFlags, Esp, SegSs : Cardinal;

        //
        // This section is specified/returned if the ContextFlags word
        // contains the flag CONTEXT_EXTENDED_REGISTERS.
        // The format and contexts are processor specific
        //
            ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
    end;

  type
    PExceptionRecord = ^TExceptionRecord;
    TExceptionRecord = packed record
            ExceptionCode   : cardinal;
            ExceptionFlags  : Longint;
            ExceptionRecord : PExceptionRecord;
            ExceptionAddress : Pointer;
            NumberParameters : Longint;
            ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
    end;

    PExceptionPointers = ^TExceptionPointers;
    TExceptionPointers = packed record
            ExceptionRecord   : PExceptionRecord;
            ContextRecord     : PContext;
    end;

  { type of functions that should be used for exception handling }
    TTopLevelExceptionFilter
         = function (excep : PExceptionPointers) : Longint;stdcall;

  function SetUnhandledExceptionFilter( lpTopLevelExceptionFilter:
                            TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
        stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
//end copy-paste --------------------------------------------------------------/



{$else}
(*{$packrecords C}
const
  SI_PAD_SIZE   = ((128/sizeof(longint)) - 3);

{
 * The sequence of the fields/registers in struct sigcontext should match
 * those in mcontext_t.
 }

type sigset_t = array[0..3] of cardinal;

    PSigContextRec = ^SigContextRec;
    SigContextRec = record
       sc_mask      : sigset_t;          { signal mask to restore }
       sc_onstack   : longint;              { sigstack state to restore }

       sc_gs        : longint;              { machine state (struct trapframe): }
       sc_fs        : longint;
       sc_es        : longint;
       sc_ds        : longint;
       sc_edi       : longint;
       sc_esi       : longint;
       sc_ebp       : longint;
       sc_isp       : longint;
       sc_ebx       : longint;
       sc_edx       : longint;
       sc_ecx       : longint;
       sc_eax       : longint;
       sc_trapno    : longint;
       sc_err       : longint;
       sc_eip       : longint;
       sc_cs        : longint;
       sc_efl       : longint;
       sc_esp       : longint;
       sc_ss        : longint;
        {
         * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
         * needed here), or that + 16 * 4 bytes for emulators (probably all
         * needed here).  The "spare" bytes are mostly not spare.
         }
       en_cw        : cardinal;     { control word (16bits used) }
       en_sw        : cardinal;     { status word (16bits) }
       en_tw        : cardinal;     { tag word (16bits) }
       en_fip       : cardinal;     { floating point instruction pointer }
       en_fcs       : word;         { floating code segment selector }
       en_opcode    : word;         { opcode last executed (11 bits ) }
       en_foo       : cardinal;     { floating operand offset }
       en_fos       : cardinal;     { floating operand segment selector }
       fpr_acc      : array[0..79] of char;
       fpr_ex_sw    : cardinal;
       fpr_pad      : array[0..63] of char;
       end;

  SignalHandler   = Procedure(Sig : Longint);cdecl;
  PSignalHandler  = ^SignalHandler;
  SignalRestorer  = Procedure;cdecl;
  PSignalRestorer = ^SignalRestorer;


type
  tfpreg = record
          significand: array[0..3] of word;
          exponent: word;
  end;

  pfpstate = ^tfpstate;
  tfpstate = record
           cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
           st: array[0..7] of tfpreg;
           status: cardinal;
  end;

  PSigContext = ^TSigContext;
  TSigContext = record
    gs, __gsh: word;
    fs, __fsh: word;
    es, __esh: word;
    ds, __dsh: word;
    edi: cardinal;
    esi: cardinal;
    ebp: cardinal;
    esp: cardinal;
    ebx: cardinal;
    edx: cardinal;
    ecx: cardinal;
    eax: cardinal;
    trapno: cardinal;
    err: cardinal;
    eip: cardinal;
    cs, __csh: word;
    eflags: cardinal;
    esp_at_signal: cardinal;
    ss, __ssh: word;
    fpstate: pfpstate;
    oldmask: cardinal;
    cr2: cardinal;
  end;

  tsigaltstack=record
        ss_sp : pointer;
        ss_flags : longint;
        ss_size : longint;
  end;


  Sigset=sigset_t;
  TSigset=sigset_t;
  PSigSet = ^SigSet;

  Pucontext=^Tucontext;
  TUcontext=record
    uc_flags : cardinal;
    uc_link  : Pucontext;
    uc_stack : tsigaltstack;
    uc_mcontext : tsigcontext;
    uc_sigmask : tsigset;
  end;

  SigActionHandler  = procedure(sig : longint; SigInfo: PSigInfo; UContext: Pucontext); cdecl;

  SigActionRec = packed record
//    Handler  : record
    sa_handler : SigActionHandler;
//      case byte of
//        0: (Sh: SignalHandler);
//        1: (Sa: TSigAction);
//      end;
    Sa_Flags    : Longint;
    Sa_Mask     : SigSet;
  end;

  PSigActionRec = ^SigActionRec;
 *)
const
  { Internal constants for use in system unit }
  FPU_Invalid = 1;
  FPU_Denormal = 2;
  FPU_DivisionByZero = 4;
  FPU_Overflow = 8;
  FPU_Underflow = $10;
  FPU_StackUnderflow = $20;
  FPU_StackOverflow = $40;
  FPU_ExceptionMask = $ff;

  fpucw : word = $1300 or FPU_StackUnderflow or FPU_Underflow or FPU_Denormal;

 var
   CgeSignalHandler,
   OldSigFpeHandler,
   OldSigSegvHandler,
   OldSigBusHandler,
   OldSigIllHandler: SigActionRec;
   MyExeHandle: pointer = nil;
{$endif}

  procedure JumpToRaiseFunction;
  var w: WideString;
  begin
    {$ifdef windows}
     SysResetFPU;
    {$else}
    {$endif}
    w:= RuEn('Системное исключение: ','System exception: ')
      + SehNameByCode(MotherState^.sehh_ExceptionCode)
      + #10#13'  ' + SehHackTellExceptionAddress(MotherState^.sehh_ExceptionAddress);

    MotherState^.sehh_ExceptionCode:= 0;
    MotherState^.sehh_ExceptionAddress:= 0;

    ThreadManager.PassDying(w);//raises a Pascal exception
  end;


 {$ifdef windows}
  function MyExceptionFilter(excep : PExceptionPointers) : Longint; stdcall;
  begin
    MotherState^.sehh_ExceptionCode:= excep^.ExceptionRecord^.ExceptionCode;
    MotherState^.sehh_ExceptionAddress:= excep^.ContextRecord^.Eip;
    excep^.ContextRecord^.Eip := Longint(@JumpToRaiseFunction);
    excep^.ExceptionRecord^.ExceptionCode := 0;
    Result := EXCEPTION_CONTINUE_EXECUTION;
  end;
{$else}
{  ------------------ NOT USED in LINUX!! --------------------- }
(*
function  reenable_signal(sig : longint) : boolean; {copied from the System unit}
  var
    e : TSigSet;
    i,j : byte;
  begin
    fillchar(e,sizeof(e),#0);
    { set is 1 based PM }
    dec(sig);
    i:=sig mod (sizeof(cuLong) * 8);
    j:=sig div (sizeof(cuLong) * 8);
    e[j]:=1 shl i;
    fpsigprocmask(SIG_UNBLOCK,@e,nil);
   // reenable_signal:=geterrno=0;
  end;

  function GetModuleByAddr(addr: pointer): pointer;
  var
    dlinfo: dl_info;
  begin
    FillChar(dlinfo, sizeof(dlinfo), 0);
    dladdr(addr, @dlinfo);
    Result:= dlinfo.dli_fbase;
  end;

  procedure MySignalDispatcher(sig : longint; SigInfo: PSigInfo; UContext: PUContext);cdecl;
  var
    err_code, fpustate : word;
    h: pointer;
  begin
    h:= GetModuleByAddr(pointer(ucontext^.uc_mcontext.eip));
    if Assigned(Module) and Assigned(@Module.PassUnhandledException) //DLL is loaded
       and (CurrentOwner <> NOT_A_MODULE) //we are really in the process of calling one of the the DLL functions
       and ((Module.DllHandle = h) or (Assigned(h) and (h <> MyExeHandle)))
    then begin
      MotherState.sehh_ExceptionAddress:= ucontext^.uc_mcontext.eip;
      ucontext^.uc_mcontext.eip := dword(@JumpToDllRaiseFunction);
      case sig of
        SIGFPE: begin
         //Note: I copy-pasted this from the System unit without fully understanding it:
          MotherState.sehh_ExceptionCode:= 1;
          if assigned(ucontext^.uc_mcontext.fpstate) then
            begin
              FpuState:=ucontext^.uc_mcontext.fpstate^.sw;
              if (FpuState and FPU_ExceptionMask) <> 0 then
                begin
                  if (FpuState and FPU_DivisionByZero)<>0 then
                    MotherState.sehh_ExceptionCode:= 2
                  else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
                    MotherState.sehh_ExceptionCode:= 3
                  else if (FpuState and FPU_Overflow)<>0 then
                    MotherState.sehh_ExceptionCode:= 4
                  else if (FpuState and FPU_Underflow)<>0 then
                    MotherState.sehh_ExceptionCode:= 5
                  else if (FpuState and FPU_Denormal)<>0 then
                    MotherState.sehh_ExceptionCode:= 6
                  else
                    MotherState.sehh_ExceptionCode:= 7;  {'Coprocessor Error'}
                end;
              with ucontext^.uc_mcontext.fpstate^ do
                sw:=sw and not FPU_ExceptionMask;
            end;
        end;
        SIGBUS: MotherState.sehh_ExceptionCode:= 8;
        SIGILL: MotherState.sehh_ExceptionCode:= 9;
        SIGSEGV: MotherState.sehh_ExceptionCode:= 10;
      end;
      reenable_signal(sig);
    end
    else
      case sig of
        SIGFPE:  SigActionHandler(@OldSigFpeHandler)(sig, SigInfo, PSigContext(UContext));
        SIGBUS:  SigActionHandler(@OldSigBusHandler)(sig, SigInfo, PSigContext(UContext));
        SIGILL:  SigActionHandler(@OldSigIllHandler)(sig, SigInfo, PSigContext(UContext));
        SIGSEGV: SigActionHandler(@OldSigSegvHandler)(sig, SigInfo, PSigContext(UContext));
      end;
  end;
*)

{$endif}

