paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 01:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Zusammenführung

Browse Source 
-- Zusammenführen von r45995 in ».«:
U    rtl/linux/i386/sighnd.inc
U    rtl/linux/x86_64/sighnd.inc
A    tests/webtbs/tw37468.pp
-- Aufzeichnung der Informationen für Zusammenführung von r45995 in ».«:
 U   .
-- Zusammenführen von r46207 in ».«:
U    rtl/linux/i386/sighndh.inc
-- Aufzeichnung der Informationen für Zusammenführung von r46207 in ».«:
 G   .
-- Zusammenführen von r46208 in ».«:
G    rtl/linux/i386/sighnd.inc
-- Aufzeichnung der Informationen für Zusammenführung von r46208 in ».«:
 G   .
-- Zusammenführen von r46210 in ».«:
U    rtl/aix/sighnd.inc
U    rtl/beos/i386/sighnd.inc
U    rtl/go32v2/dpmiexcp.pp
U    rtl/haiku/i386/sighnd.inc
U    rtl/haiku/x86_64/sighnd.inc
U    rtl/i8086/math.inc
U    rtl/inc/genmath.inc
U    rtl/linux/m68k/sighnd.inc
U    rtl/linux/powerpc/sighnd.inc
U    rtl/linux/powerpc64/sighnd.inc
U    rtl/linux/sparc/sighnd.inc
U    rtl/linux/sparc64/sighnd.inc
G    rtl/linux/x86_64/sighnd.inc
U    rtl/netbsd/arm/sighnd.inc
U    rtl/netbsd/m68k/sighnd.inc
U    rtl/netbsd/powerpc/sighnd.inc
U    rtl/netbsd/x86_64/sighnd.inc
U    rtl/openbsd/i386/sighnd.inc
U    rtl/openbsd/x86_64/sighnd.inc
U    rtl/os2/system.pas
U    rtl/solaris/i386/sighnd.inc
U    rtl/solaris/sparc/sighnd.inc
U    rtl/solaris/x86_64/sighnd.inc
U    rtl/win32/system.pp
U    rtl/win64/system.pp
U    tests/webtbs/tw37468.pp
U    rtl/wince/system.pp
-- Aufzeichnung der Informationen für Zusammenführung von r46210 in ».«:
 G   .
-- Zusammenführen von r46992 in ».«:
G    rtl/linux/x86_64/sighnd.inc
A    tests/webtbs/tw37468b.pp
-- Aufzeichnung der Informationen für Zusammenführung von r46992 in ».«:
 G   .
-- Zusammenführen von r47114 in ».«:
G    rtl/linux/x86_64/sighnd.inc
G    rtl/linux/i386/sighnd.inc
A    tests/webtbs/tw37926.pp
-- Aufzeichnung der Informationen für Zusammenführung von r47114 in ».«:
 G   .
-- Zusammenführen von r47117 in ».«:
G    rtl/linux/i386/sighnd.inc
G    rtl/linux/x86_64/sighnd.inc
G    rtl/linux/m68k/sighnd.inc
-- Aufzeichnung der Informationen für Zusammenführung von r47117 in ».«:
 G   .

git-svn-id: branches/fixes_3_2@47906 -
This commit is contained in:
florian 2020-12-30 14:07:17 +00:00
parent 91382b5deb
commit 4995677b0f
32 changed files with 212 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -17794,6 +17794,8 @@ tests/webtbs/tw37393.pp svneol=native#text/pascal
tests/webtbs/tw37397.pp svneol=native#text/plain
tests/webtbs/tw37415.pp svneol=native#text/plain
tests/webtbs/tw3742.pp svneol=native#text/plain
tests/webtbs/tw37468.pp svneol=native#text/pascal
tests/webtbs/tw37468b.pp svneol=native#text/pascal
tests/webtbs/tw3751.pp svneol=native#text/plain
tests/webtbs/tw3758.pp svneol=native#text/plain
tests/webtbs/tw3764.pp svneol=native#text/plain
@ -17806,6 +17808,7 @@ tests/webtbs/tw3780.pp svneol=native#text/plain
tests/webtbs/tw37806.pp svneol=native#text/pascal
tests/webtbs/tw3782.pp svneol=native#text/plain
tests/webtbs/tw37844.pp svneol=native#text/pascal
tests/webtbs/tw37926.pp svneol=native#text/pascal
tests/webtbs/tw37949.pp svneol=native#text/pascal
tests/webtbs/tw3796.pp svneol=native#text/plain
tests/webtbs/tw38012.pp svneol=native#text/pascal

2
rtl/aix/sighnd.inc
View File

@ -25,7 +25,7 @@ begin
SIGFPE :
begin
Case Info^.si_code Of
FPE_FLTDIV,
FPE_FLTDIV : Res:=208; { floating point divide by zero }
FPE_INTDIV : Res:=200; { floating point divide by zero }
FPE_FLTOVF : Res:=205; { floating point overflow }
FPE_FLTUND : Res:=206; { floating point underflow }

2
rtl/beos/i386/sighnd.inc
View File

@ -35,7 +35,7 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
res:=207
else if (FpuState and FPU_Overflow)<>0 then

2
rtl/go32v2/dpmiexcp.pp
View File

@ -1600,7 +1600,7 @@ begin
else if (FpuStatus and FPU_Denormal)<>0 then
ErrorOfSig:=216
else if (FpuStatus and FPU_DivisionByZero)<>0 then
ErrorOfSig:=200
ErrorOfSig:=208
else if (FpuStatus and FPU_Overflow)<>0 then
ErrorOfSig:=205
else if (FpuStatus and FPU_Underflow)<>0 then

2
rtl/haiku/i386/sighnd.inc
View File

@ -35,7 +35,7 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
res:=207
else if (FpuState and FPU_Overflow)<>0 then

2
rtl/haiku/x86_64/sighnd.inc
View File

@ -35,7 +35,7 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
res:=207
else if (FpuState and FPU_Overflow)<>0 then

2
rtl/i8086/math.inc
View File

@ -64,7 +64,7 @@
else if (FpuStatus and FPU_Denormal)<>0 then
OutError:=216
else if (FpuStatus and FPU_DivisionByZero)<>0 then
OutError:=200
OutError:=208
else if (FpuStatus and FPU_Overflow)<>0 then
OutError:=205
else if (FpuStatus and FPU_Underflow)<>0 then

2
rtl/inc/genmath.inc
View File

@ -138,7 +138,7 @@ Begin
HandleError(207)
else
if (float_flag_divbyzero in unmasked_flags) then
HandleError(200)
HandleError(208)
else
if (float_flag_overflow in unmasked_flags) then
HandleError(205)

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

@ -34,6 +34,15 @@ begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
res:=200;
{$ifdef SYSTEM_DEBUG}
if assigned(ucontext^.uc_mcontext.fpstate) then
begin
writeln('magic: $',hexstr(ucontext^.uc_mcontext.fpstate^.magic,4));
writeln('magic1: $',hexstr(ucontext^.uc_mcontext.fpstate^.sw_reserved.magic1,8));
end
else
writeln('fpstate=nil');
{$endif SYSTEM_DEBUG}
if SigInfo^.si_code<>FPE_INTDIV then
begin
if assigned(ucontext^.uc_mcontext.fpstate) then
@ -51,42 +60,47 @@ begin
else if (FpuState and FPU_Underflow)<>0 then
res:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
res:=206
else
res:=207; {'Coprocessor Error'}
end;
{ SSE data? }
if ucontext^.uc_mcontext.fpstate^.magic<>$ffff then
end
else
begin
MMState:=ucontext^.uc_mcontext.fpstate^.mxcsr;
if (MMState and MM_ExceptionMask)<>0 then
{ SSE data? }
if ucontext^.uc_mcontext.fpstate^.magic=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'}
MMState:=ucontext^.uc_mcontext.fpstate^.mxcsr;
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:=206
else
res:=207; {'Coprocessor Error'}
end;
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;
if assigned(ucontext^.uc_mcontext.fpstate) then
with ucontext^.uc_mcontext.fpstate^ do
begin
{ Reset Status word }
sw:=sw and not(FPU_ExceptionMask);
if magic=0 then
mxcsr:=mxcsr and not(MM_ExceptionMask);
cw:=Default8087CW;
{ Reset Tag word to $ffff for all empty }
tag:=$ffff;
end;
end;
SIGBUS:
res:=214;
@ -107,13 +121,14 @@ begin
res:=233;
end;
reenable_signal(sig);
{ give runtime error at the position where the signal was raised }
{ give runtime error at the position where the signal was raised }
if res<>0 then
begin
ucontext^.uc_mcontext.eax := res;
ucontext^.uc_mcontext.edx := ucontext^.uc_mcontext.eip;
ucontext^.uc_mcontext.ecx := ucontext^.uc_mcontext.ebp;
ucontext^.uc_mcontext.eip := ptruint(@SignalToHandleErrorAddrFrame);
end;
begin
ucontext^.uc_mcontext.eax := res;
ucontext^.uc_mcontext.edx := ucontext^.uc_mcontext.eip;
ucontext^.uc_mcontext.ecx := ucontext^.uc_mcontext.ebp;
ucontext^.uc_mcontext.eip := ptruint(@SignalToHandleErrorAddrFrame);
end;
end;

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

@ -32,6 +32,14 @@ type
element : array[0..3] of dword;
end;
tfpx_sw_bytes = record
magic1 : dword;
extended_size : dword;
xfeatures : qword;
xstate_size : dword;
padding : array[0..6] of dword;
end;
pfpstate = ^tfpstate;
tfpstate = record
@ -43,7 +51,13 @@ type
reserved : dword;
fxsr_st : array[0..7] of tfpxreg;
xmmreg : array[0..7] of txmmreg;
padding : array[0..55] of dword;
case byte of
1: (padding : array[0..43] of dword;
case byte of
1: (padding2 : array[0..11] of dword);
2: (sw_reserved : tfpx_sw_bytes);
);
2: (padding1 : array[0..43] of dword);
end;
PSigContext = ^TSigContext;

4
rtl/linux/m68k/sighnd.inc
View File

@ -83,13 +83,13 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then
res:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
res:=206
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
res:=207
else if (FpuState and FPU_Invalid)<>0 then

2
rtl/linux/powerpc/sighnd.inc
View File

@ -28,7 +28,7 @@ begin
case sig of
SIGFPE :
case (SigInfo^.si_code) of
FPE_FLTDIV : res := 200;
FPE_FLTDIV : res := 208;
FPE_FLTOVF : res := 205;
FPE_FLTUND : res := 206;
else

2
rtl/linux/powerpc64/sighnd.inc
View File

@ -27,7 +27,7 @@ begin
SIGFPE :
{ distuingish between different FPU exceptions }
case (SigInfo^.si_code) of
FPE_FLTDIV : res := 200;
FPE_FLTDIV : res := 208;
FPE_FLTOVF : res := 205;
FPE_FLTUND : res := 206;
else

2
rtl/linux/sparc/sighnd.inc
View File

@ -35,7 +35,7 @@ begin
FPE_INTOVF:
res:=215;
FPE_FLTDIV:
res:=200;
res:=208;
FPE_FLTOVF:
res:=205;
FPE_FLTUND:

2
rtl/linux/sparc64/sighnd.inc
View File

@ -35,7 +35,7 @@ begin
FPE_INTOVF:
res:=215;
FPE_FLTDIV:
res:=200;
res:=208;
FPE_FLTOVF:
res:=205;
FPE_FLTUND:

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

@ -15,6 +15,7 @@
**********************************************************************}
{ $define SYSTEM_DEBUG}
{ use a trampoline which pushes the return address for proper unwinding }
Procedure SignalToHandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
@ -33,9 +34,8 @@ function GetFPUState(const SigContext : TSigContext) : word;
else
GetFPUState:=0;
{$ifdef SYSTEM_DEBUG}
writeln('xx:',sigcontext.twd,' ',sigcontext.cwd);
{$endif SYSTEM_DEBUG}
{$ifdef SYSTEM_DEBUG}
if assigned(SigContext.fpstate) then
writeln('Tag: ',sigcontext.fpstate^.twd,' Cw: ',sigcontext.fpstate^.cwd);
Writeln(stderr,'FpuState = ',result);
{$endif SYSTEM_DEBUG}
end;
@ -70,37 +70,56 @@ procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigCon
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then
res:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
res:=206
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
res:=207
else
res:=207; {'Coprocessor Error'}
end
else
begin
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:=206
else
res:=207; {'Coprocessor Error'}
end;
end;
MMState:=getMMState(SigContext^);
if (MMState and MM_ExceptionMask)<>0 then
if assigned(SigContext^.fpstate) then
with SigContext^.fpstate^ do
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'}
{$ifdef SYSTEM_DEBUG}
Writeln(stderr,'fpstate^.swd = ',swd);
{$endif SYSTEM_DEBUG}
{ actually, I am not sure if we should really touch the controll word }
cwd:=Default8087CW;
{ found by trial and error that setting to 0 means empty }
twd:=$0;
{ clear top }
swd:=swd and not($3700);
{ exceptions are handled, clear all flags
as we return from SignalToRunerrer, we have to clear the exception flags in the context }
mxcsr:=mxcsr and not(MM_ExceptionMask);
swd:=swd and not($37ff);
end;
end;
SysResetFPU;
end;
SIGILL,
SIGBUS,

2
rtl/netbsd/arm/sighnd.inc
View File

@ -33,7 +33,7 @@ begin
res:=0;
if signo = SIGFPE then
begin
res := 200;
res := 208;
end
else
if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then

2
rtl/netbsd/m68k/sighnd.inc
View File

@ -26,7 +26,7 @@ begin
res:=0;
if signo = SIGFPE then
begin
res := 200;
res := 208;
end
else
if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then

2
rtl/netbsd/powerpc/sighnd.inc
View File

@ -27,7 +27,7 @@ begin
res:=0;
if signo = SIGFPE then
begin
res := 200;
res := 208;
end
else
if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then

2
rtl/netbsd/x86_64/sighnd.inc
View File

@ -73,7 +73,7 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then

2
rtl/openbsd/i386/sighnd.inc
View File

@ -68,7 +68,7 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then

2
rtl/openbsd/x86_64/sighnd.inc
View File

@ -62,7 +62,7 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
res:=208
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then

2
rtl/os2/system.pas
View File

@ -492,7 +492,7 @@ begin
case Report^.Exception_Num of
Xcpt_Integer_Divide_By_Zero,
Xcpt_Float_Divide_By_Zero:
Err := 200;
Err := 208;
Xcpt_Array_Bounds_Exceeded:
begin
Err := 201;

2
rtl/solaris/i386/sighnd.inc
View File

@ -52,7 +52,7 @@ begin
FPE_INTOVF:
res:=205;
FPE_FLTDIV:
res:=200;
res:=208;
FPE_FLTOVF:
res:=205;
FPE_FLTUND:

2
rtl/solaris/sparc/sighnd.inc
View File

@ -58,7 +58,7 @@ begin
FPE_INTOVF:
res:=205;
FPE_FLTDIV:
res:=200;
res:=208;
FPE_FLTOVF:
res:=205;
FPE_FLTUND:

2
rtl/solaris/x86_64/sighnd.inc
View File

@ -52,7 +52,7 @@ begin
FPE_INTOVF:
res:=205;
FPE_FLTDIV:
res:=200;
res:=208;
FPE_FLTOVF:
res:=205;
FPE_FLTUND:

5
rtl/win32/system.pp
View File

@ -375,9 +375,10 @@ function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;s
hexstr(excep^.ExceptionRecord^.ExceptionCode, 8));
{$endif SYSTEMEXCEPTIONDEBUG}
case excep^.ExceptionRecord^.ExceptionCode of
STATUS_INTEGER_DIVIDE_BY_ZERO,
STATUS_FLOAT_DIVIDE_BY_ZERO :
STATUS_INTEGER_DIVIDE_BY_ZERO :
err := 200;
STATUS_FLOAT_DIVIDE_BY_ZERO :
err := 208;
STATUS_ARRAY_BOUNDS_EXCEEDED :
begin
err := 201;

2
rtl/win64/system.pp
View File

@ -346,7 +346,7 @@ function syswin64_x86_64_exception_handler(excep : PExceptionPointers) : Longint
case cardinal(excep^.ExceptionRecord^.ExceptionCode) of
STATUS_INTEGER_DIVIDE_BY_ZERO,
STATUS_FLOAT_DIVIDE_BY_ZERO :
err := 200;
err := 208;
STATUS_ARRAY_BOUNDS_EXCEEDED :
begin
err := 201;

2
rtl/wince/system.pp
View File

@ -1170,7 +1170,7 @@ begin
case cardinal(ExceptionRecord^.ExceptionCode) of
STATUS_INTEGER_DIVIDE_BY_ZERO,
STATUS_FLOAT_DIVIDE_BY_ZERO :
res := 200;
res := 208;
STATUS_ARRAY_BOUNDS_EXCEEDED :
begin
res := 201;

24
tests/webtbs/tw37468.pp Normal file
View File

@ -0,0 +1,24 @@
program Project1;
{$mode objfpc}{$H+}
uses
math, sysutils;
var
a,b: double;
begin
a := 0;
b := -3;
try
try
writeln(power(a,b));
except
on e: EZeroDivide do begin
writeln(Infinity);
end;
end;
except
halt(1);
end;
writeln('ok');
end.

28
tests/webtbs/tw37468b.pp Normal file
View File

@ -0,0 +1,28 @@
program Project1;
{$mode objfpc}{$H+}
uses math, sysutils
{ you can add units after this };
begin
try
writeln(power(0, -4));
except
on e: Exception do ClearExceptions(false);
end;
try
writeln(power(0, -3));
except
on e: Exception do ClearExceptions(false);
end;
try
writeln(power(0, -4));
except
on e: Exception do ClearExceptions(false);
end;
writeln('caught');
writeln(power(16, 0.5));
writeln('done');
end.

24
tests/webtbs/tw37926.pp Normal file
View File

@ -0,0 +1,24 @@
{$mode objfpc}
uses
sysutils,math;
procedure test(const s: single);
var
tempcode: integer;
sr: single;
begin
Val('8.077936E-28', sr, tempcode);
if sr <> s then
end;
var s, sr: single;
i, j, tempcode: Integer;
begin
for i := 1 to 5000 do begin
s := 0;
try
for j := 0 to Random(5) do s := s + Random(2) * power(2, Random(256) - 127);
except
on e: EMathError do s := 0; //continue;
end;
end;
end.