paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 22:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* manually merged parts of r42260 to enable further merges

Browse Source 
git-svn-id: branches/fixes_3_2@47905 -
This commit is contained in:
florian 2020-12-30 13:53:10 +00:00
parent 7f5361f301
commit 91382b5deb
5 changed files with 159 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
rtl/i386/i386.inc
View File

@ -1299,6 +1299,14 @@ const
FPU_StackOverflow = $40; FPU_StackOverflow = $40;
FPU_ExceptionMask = $ff; FPU_ExceptionMask = $ff;
MM_Invalid = 1;
MM_Denormal = 2;
MM_DivisionByZero = 4;
MM_Overflow = 8;
MM_Underflow = $10;
MM_Precicion = $20;
MM_ExceptionMask = $3f;
MM_MaskInvalidOp = %0000000010000000; MM_MaskInvalidOp = %0000000010000000;
MM_MaskDenorm = %0000000100000000; MM_MaskDenorm = %0000000100000000;
MM_MaskDivZero = %0000001000000000; MM_MaskDivZero = %0000001000000000;

89
rtl/linux/i386/sighnd.inc
View File

@ -16,9 +16,16 @@
**********************************************************************} **********************************************************************}
{ use a trampoline which pushes the return address for proper unwinding }
Procedure SignalToHandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
asm
pushl addr
jmp HandleErrorAddrFrame
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);public name '_FPC_DEFAULTSIGHANDLER';cdecl; procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var var
res,fpustate : word; res,fpustate,MMState : word;
begin begin
res:=0; res:=0;
case sig of case sig of
@ -27,35 +34,59 @@ begin
{ this is not allways necessary but I don't know yet { this is not allways necessary but I don't know yet
how to tell if it is or not PM } how to tell if it is or not PM }
res:=200; res:=200;
if assigned(ucontext^.uc_mcontext.fpstate) then if SigInfo^.si_code<>FPE_INTDIV then
begin begin
FpuState:=ucontext^.uc_mcontext.fpstate^.sw; if assigned(ucontext^.uc_mcontext.fpstate) then
if (FpuState and FPU_ExceptionMask) <> 0 then
begin begin
{ first check the more precise options } FpuState:=ucontext^.uc_mcontext.fpstate^.sw;
if (FpuState and FPU_DivisionByZero)<>0 then if (FpuState and FPU_ExceptionMask) <> 0 then
res:=200 begin
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then { first check the more precise options }
res:=207 if (FpuState and FPU_DivisionByZero)<>0 then
else if (FpuState and FPU_Overflow)<>0 then res:=208
res:=205 else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
else if (FpuState and FPU_Underflow)<>0 then res:=207
res:=206 else if (FpuState and FPU_Overflow)<>0 then
else if (FpuState and FPU_Denormal)<>0 then res:=205
res:=216 else if (FpuState and FPU_Underflow)<>0 then
else res:=206
res:=207; {'Coprocessor Error'} else if (FpuState and FPU_Denormal)<>0 then
end; res:=216
with ucontext^.uc_mcontext.fpstate^ do else
begin res:=207; {'Coprocessor Error'}
{ Reset Status word } end;
sw:=sw and not FPU_ExceptionMask; { SSE data? }
{ Restoree default control word } if ucontext^.uc_mcontext.fpstate^.magic<>$ffff then
cw:=Default8087CW; begin
{ Reset Tag word to $ffff for all empty } MMState:=ucontext^.uc_mcontext.fpstate^.mxcsr;
tag:=$ffff; if (MMState and MM_ExceptionMask)<>0 then
end; begin
end; { first check the more precise options }
if (MMState and MM_DivisionByZero)<>0 then
res:=208
else if (MMState and MM_Invalid)<>0 Then
res:=207
else if (MMState and MM_Overflow)<>0 then
res:=205
else if (MMState and MM_Underflow)<>0 then
res:=206
else if (MMState and MM_Denormal)<>0 then
res:=216
else
res:=207; {'Coprocessor Error'}
end;
end;
with ucontext^.uc_mcontext.fpstate^ do
begin
{ Reset Status word }
sw:=sw and not FPU_ExceptionMask;
{ Restoree default control word }
cw:=Default8087CW;
{ Reset Tag word to $ffff for all empty }
tag:=$ffff;
end;
end;
end;
end; end;
SIGBUS: SIGBUS:
res:=214; res:=214;
@ -82,7 +113,7 @@ begin
ucontext^.uc_mcontext.eax := res; ucontext^.uc_mcontext.eax := res;
ucontext^.uc_mcontext.edx := ucontext^.uc_mcontext.eip; ucontext^.uc_mcontext.edx := ucontext^.uc_mcontext.eip;
ucontext^.uc_mcontext.ecx := ucontext^.uc_mcontext.ebp; ucontext^.uc_mcontext.ecx := ucontext^.uc_mcontext.ebp;
ucontext^.uc_mcontext.eip := ptruint(@HandleErrorAddrFrame); ucontext^.uc_mcontext.eip := ptruint(@SignalToHandleErrorAddrFrame);
end; end;
end; end;

27
rtl/linux/i386/sighndh.inc
View File

@ -18,15 +18,32 @@
type type
tfpreg = record tfpreg = record
significand: array[0..3] of word; significand: array[0..3] of word;
exponent: word; exponent: word;
end; end;
tfpxreg = record
significand: array[0..3] of word;
exponent: word;
padding : array[0..2] of word;
end;
txmmreg = record
element : array[0..3] of dword;
end;
pfpstate = ^tfpstate; pfpstate = ^tfpstate;
tfpstate = record tfpstate = record
cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal; cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
st: array[0..7] of tfpreg; st: array[0..7] of tfpreg;
status: cardinal; status, magic: word;
fxsr_env : array[0..5] of dword;
mxcsr : dword;
reserved : dword;
fxsr_st : array[0..7] of tfpxreg;
xmmreg : array[0..7] of txmmreg;
padding : array[0..55] of dword;
end; end;
PSigContext = ^TSigContext; PSigContext = ^TSigContext;

79
rtl/linux/x86_64/sighnd.inc
View File

@ -16,6 +16,13 @@
**********************************************************************} **********************************************************************}
{ use a trampoline which pushes the return address for proper unwinding }
Procedure SignalToHandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
asm
pushq addr
jmp HandleErrorAddrFrame
end;
const const
FPU_All = $7f; FPU_All = $7f;
@ -33,10 +40,21 @@ function GetFPUState(const SigContext : TSigContext) : word;
{$endif SYSTEM_DEBUG} {$endif SYSTEM_DEBUG}
end; end;
function GetMMState(const SigContext : TSigContext) : dword;
begin
if assigned(SigContext.fpstate) then
Result:=SigContext.fpstate^.mxcsr
else
Result:=0;
{$ifdef SYSTEM_DEBUG}
Writeln(stderr,'MMState = ',result);
{$endif SYSTEM_DEBUG}
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl; procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var var
res,fpustate : word; res,fpustate,MMState : word;
begin begin
res:=0; res:=0;
case sig of case sig of
@ -45,24 +63,44 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
{ this is not allways necessary but I don't know yet { this is not allways necessary but I don't know yet
how to tell if it is or not PM } how to tell if it is or not PM }
res:=200; res:=200;
fpustate:=GetFPUState(SigContext^); if SigInfo^.si_code<>FPE_INTDIV then
if (FpuState and FPU_All) <> 0 then
begin begin
{ first check the more precise options } fpustate:=GetFPUState(SigContext^);
if (FpuState and FPU_DivisionByZero)<>0 then if (FpuState and FPU_All) <> 0 then
res:=200 begin
else if (FpuState and FPU_Overflow)<>0 then { first check the more precise options }
res:=205 if (FpuState and FPU_DivisionByZero)<>0 then
else if (FpuState and FPU_Underflow)<>0 then res:=200
res:=206 else if (FpuState and FPU_Overflow)<>0 then
else if (FpuState and FPU_Denormal)<>0 then res:=205
res:=216 else if (FpuState and FPU_Underflow)<>0 then
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then res:=206
res:=207 else if (FpuState and FPU_Denormal)<>0 then
else res:=216
res:=207; {'Coprocessor Error'} else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
res:=207
else
res:=207; {'Coprocessor Error'}
end;
MMState:=getMMState(SigContext^);
if (MMState and MM_ExceptionMask)<>0 then
begin
{ first check the more precise options }
if (MMState and MM_DivisionByZero)<>0 then
res:=208
else if (MMState and MM_Invalid)<>0 Then
res:=207
else if (MMState and MM_Overflow)<>0 then
res:=205
else if (MMState and MM_Underflow)<>0 then
res:=206
else if (MMState and MM_Denormal)<>0 then
res:=216
else
res:=207; {'Coprocessor Error'}
end;
end; end;
SysResetFPU; SysResetFPU;
end; end;
SIGILL, SIGILL,
SIGBUS, SIGBUS,
@ -75,7 +113,12 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
end; end;
reenable_signal(sig); reenable_signal(sig);
if res<>0 then if res<>0 then
HandleErrorAddrFrame(res,pointer(SigContext^.rip),pointer(SigContext^.rbp)); begin
SigContext^.rdi := res;
SigContext^.rsi := SigContext^.rip;
SigContext^.rdx := SigContext^.rbp;
SigContext^.rip := ptruint(@SignalToHandleErrorAddrFrame);
end;
end; end;

9
rtl/x86_64/x86_64.inc
View File

@ -933,6 +933,14 @@ const
FPU_StackOverflow = $40; FPU_StackOverflow = $40;
FPU_ExceptionMask = $ff; FPU_ExceptionMask = $ff;
MM_Invalid = 1;
MM_Denormal = 2;
MM_DivisionByZero = 4;
MM_Overflow = 8;
MM_Underflow = $10;
MM_Precicion = $20;
MM_ExceptionMask = $3f;
MM_MaskInvalidOp = %0000000010000000; MM_MaskInvalidOp = %0000000010000000;
MM_MaskDenorm = %0000000100000000; MM_MaskDenorm = %0000000100000000;
MM_MaskDivZero = %0000001000000000; MM_MaskDivZero = %0000001000000000;
@ -940,7 +948,6 @@ const
MM_MaskUnderflow = %0000100000000000; MM_MaskUnderflow = %0000100000000000;
MM_MaskPrecision = %0001000000000000; MM_MaskPrecision = %0001000000000000;
procedure fpc_cpuinit; procedure fpc_cpuinit;
begin begin
{ don't let libraries influence the FPU cw set by the host program } { don't let libraries influence the FPU cw set by the host program }