unit ExcpTest;
{$IFDEF FPC}
{$MODE FPC}
  {$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
  {$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
  {$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}
{$ENDIF}

{$Q-}     {debugovaci informace radeji povypinam}
{$R-}
{$S-}
{$D-}

interface


Procedure Install_Signal_handler_FPU;
Procedure UnInstall_Signal_handler_FPU;
Procedure Install_Signal_handler_GPF;
Procedure UnInstall_Signal_handler_GPF;
Procedure Install_Signal_handler_ILL;
Procedure UnInstall_Signal_handler_ILL;

{--------------------------------------------------------------}
Procedure Install_Signal_handler(i:longint);
Procedure UnInstall_Signal_handler(i:longint);
{--------------------------------------------------------------}


Function Try_to_call_SSE_instruction:boolean;
{true = bez problemu zavolana SSE instrukce
 false = skonfilo ty vyjimkou $UD, takze procesor SSE bud neumi nebo volani
         SSE neni povoleno systemem}

Function Try_to_call_AVX_instruction:boolean;
{dtto}

const
sig_FPU = 289;

var signal_handler_was_excp:boolean;


implementation
uses dpmiexcp;

Function SignalHandler(i:longint):longint;cdecl;
var pexp:PException_State;
    jmp_rec:dpmi_jmp_buf;
    eip:longint;
begin
pexp:=djgpp_exception_state;
eip:=pexp^.__eip;
if {eip=$310f} 1=1 then
   begin
   signal_handler_was_excp:=true;
   Move(pexp^,jmp_rec,sizeof(dpmi_jmp_buf));
   jmp_rec.eip:=pexp^.__eip+2;
   jmp_rec.edx:=0;
   dpmi_LongJmp(jmp_rec,0);
   end;
end;


Procedure Do_Something;
var a:byte;
begin
a:=0;
writeln(2 div a); {I can't write just "2 div 0" because of the FPC sanity check :-)}
end;


Procedure Install_Signal_handler(i:longint);
begin
Signal(i,@SignalHandler);
signal_handler_was_excp:=false;
end;


Procedure UnInstall_Signal_handler(i:longint);
begin
Signal(i,@SIG_DFL)
end;


Procedure Install_Signal_handler_FPU;
begin
Install_Signal_handler(SIGFPE);
end;

Procedure UnInstall_Signal_handler_FPU;
begin
UnInstall_Signal_handler(SIGFPE);
end;

Procedure Install_Signal_handler_GPF;
begin
Install_Signal_handler(SIGSEGV);
end;

Procedure UnInstall_Signal_handler_GPF;
begin
UnInstall_Signal_handler(SIGSEGV);
end;

Procedure Install_Signal_handler_ILL;
begin
Install_Signal_handler(SIGILL);
end;

Procedure UnInstall_Signal_handler_ILL;
begin
UnInstall_Signal_handler(SIGILL);
end;


Function Try_to_call_SSE_instruction:boolean;
{true = bez problemu zavolana SSE instrukce
 false = skonfilo ty vyjimkou $UD, takze procesor SSE bud neumi nebo volani
         SSE neni povoleno systemem}
begin
Install_Signal_handler_ILL;
Install_Signal_handler_GPF;
asm db 0Fh;db 28h; db 0CAh {movaps xmm1,xmm2} end;
UnInstall_Signal_handler_GPF;
UnInstall_Signal_handler_ILL;
end;


Function Try_to_call_AVX_instruction:boolean;
{true = bez problemu zavolana AVX instrukce
 false = skonfilo ty vyjimkou $UD, takze procesor AVX bud neumi nebo volani
         AVX neni povoleno systemem}
begin
Install_Signal_handler_ILL;
Install_Signal_handler_GPF;
asm db 0C5h;db 0FCh;db 77h {vzeroall} end;
Install_Signal_handler_GPF;
UnInstall_Signal_handler_ILL;
end;


end.
