From 4995677b0f6560dde3cc11e37bcd87d1661b76eb Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 30 Dec 2020 14:07:17 +0000 Subject: [PATCH] =?UTF-8?q?---=20Zusammenf=C3=BChrung=20--=20Zusammenf?= =?UTF-8?q?=C3=BChren=20von=20r45995=20in=20=C2=BB.=C2=AB:=20U=20=20=20=20?= =?UTF-8?q?rtl/linux/i386/sighnd.inc=20U=20=20=20=20rtl/linux/x86=5F64/sig?= =?UTF-8?q?hnd.inc=20A=20=20=20=20tests/webtbs/tw37468.pp=20--=20Aufzeichn?= =?UTF-8?q?ung=20der=20Informationen=20f=C3=BCr=20Zusammenf=C3=BChrung=20v?= =?UTF-8?q?on=20r45995=20in=20=C2=BB.=C2=AB:=20=20U=20=20=20.=20--=20Zusam?= =?UTF-8?q?menf=C3=BChren=20von=20r46207=20in=20=C2=BB.=C2=AB:=20U=20=20?= =?UTF-8?q?=20=20rtl/linux/i386/sighndh.inc=20--=20Aufzeichnung=20der=20In?= =?UTF-8?q?formationen=20f=C3=BCr=20Zusammenf=C3=BChrung=20von=20r46207=20?= =?UTF-8?q?in=20=C2=BB.=C2=AB:=20=20G=20=20=20.=20--=20Zusammenf=C3=BChren?= =?UTF-8?q?=20von=20r46208=20in=20=C2=BB.=C2=AB:=20G=20=20=20=20rtl/linux/?= =?UTF-8?q?i386/sighnd.inc=20--=20Aufzeichnung=20der=20Informationen=20f?= =?UTF-8?q?=C3=BCr=20Zusammenf=C3=BChrung=20von=20r46208=20in=20=C2=BB.?= =?UTF-8?q?=C2=AB:=20=20G=20=20=20.=20--=20Zusammenf=C3=BChren=20von=20r46?= =?UTF-8?q?210=20in=20=C2=BB.=C2=AB:=20U=20=20=20=20rtl/aix/sighnd.inc=20U?= =?UTF-8?q?=20=20=20=20rtl/beos/i386/sighnd.inc=20U=20=20=20=20rtl/go32v2/?= =?UTF-8?q?dpmiexcp.pp=20U=20=20=20=20rtl/haiku/i386/sighnd.inc=20U=20=20?= =?UTF-8?q?=20=20rtl/haiku/x86=5F64/sighnd.inc=20U=20=20=20=20rtl/i8086/ma?= =?UTF-8?q?th.inc=20U=20=20=20=20rtl/inc/genmath.inc=20U=20=20=20=20rtl/li?= =?UTF-8?q?nux/m68k/sighnd.inc=20U=20=20=20=20rtl/linux/powerpc/sighnd.inc?= =?UTF-8?q?=20U=20=20=20=20rtl/linux/powerpc64/sighnd.inc=20U=20=20=20=20r?= =?UTF-8?q?tl/linux/sparc/sighnd.inc=20U=20=20=20=20rtl/linux/sparc64/sigh?= =?UTF-8?q?nd.inc=20G=20=20=20=20rtl/linux/x86=5F64/sighnd.inc=20U=20=20?= =?UTF-8?q?=20=20rtl/netbsd/arm/sighnd.inc=20U=20=20=20=20rtl/netbsd/m68k/?= =?UTF-8?q?sighnd.inc=20U=20=20=20=20rtl/netbsd/powerpc/sighnd.inc=20U=20?= =?UTF-8?q?=20=20=20rtl/netbsd/x86=5F64/sighnd.inc=20U=20=20=20=20rtl/open?= =?UTF-8?q?bsd/i386/sighnd.inc=20U=20=20=20=20rtl/openbsd/x86=5F64/sighnd.?= =?UTF-8?q?inc=20U=20=20=20=20rtl/os2/system.pas=20U=20=20=20=20rtl/solari?= =?UTF-8?q?s/i386/sighnd.inc=20U=20=20=20=20rtl/solaris/sparc/sighnd.inc?= =?UTF-8?q?=20U=20=20=20=20rtl/solaris/x86=5F64/sighnd.inc=20U=20=20=20=20?= =?UTF-8?q?rtl/win32/system.pp=20U=20=20=20=20rtl/win64/system.pp=20U=20?= =?UTF-8?q?=20=20=20tests/webtbs/tw37468.pp=20U=20=20=20=20rtl/wince/syste?= =?UTF-8?q?m.pp=20--=20Aufzeichnung=20der=20Informationen=20f=C3=BCr=20Zus?= =?UTF-8?q?ammenf=C3=BChrung=20von=20r46210=20in=20=C2=BB.=C2=AB:=20=20G?= =?UTF-8?q?=20=20=20.=20--=20Zusammenf=C3=BChren=20von=20r46992=20in=20?= =?UTF-8?q?=C2=BB.=C2=AB:=20G=20=20=20=20rtl/linux/x86=5F64/sighnd.inc=20A?= =?UTF-8?q?=20=20=20=20tests/webtbs/tw37468b.pp=20--=20Aufzeichnung=20der?= =?UTF-8?q?=20Informationen=20f=C3=BCr=20Zusammenf=C3=BChrung=20von=20r469?= =?UTF-8?q?92=20in=20=C2=BB.=C2=AB:=20=20G=20=20=20.=20--=20Zusammenf?= =?UTF-8?q?=C3=BChren=20von=20r47114=20in=20=C2=BB.=C2=AB:=20G=20=20=20=20?= =?UTF-8?q?rtl/linux/x86=5F64/sighnd.inc=20G=20=20=20=20rtl/linux/i386/sig?= =?UTF-8?q?hnd.inc=20A=20=20=20=20tests/webtbs/tw37926.pp=20--=20Aufzeichn?= =?UTF-8?q?ung=20der=20Informationen=20f=C3=BCr=20Zusammenf=C3=BChrung=20v?= =?UTF-8?q?on=20r47114=20in=20=C2=BB.=C2=AB:=20=20G=20=20=20.=20--=20Zusam?= =?UTF-8?q?menf=C3=BChren=20von=20r47117=20in=20=C2=BB.=C2=AB:=20G=20=20?= =?UTF-8?q?=20=20rtl/linux/i386/sighnd.inc=20G=20=20=20=20rtl/linux/x86=5F?= =?UTF-8?q?64/sighnd.inc=20G=20=20=20=20rtl/linux/m68k/sighnd.inc=20--=20A?= =?UTF-8?q?ufzeichnung=20der=20Informationen=20f=C3=BCr=20Zusammenf=C3=BCh?= =?UTF-8?q?rung=20von=20r47117=20in=20=C2=BB.=C2=AB:=20=20G=20=20=20.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit git-svn-id: branches/fixes_3_2@47906 - --- .gitattributes | 3 ++ rtl/aix/sighnd.inc | 2 +- rtl/beos/i386/sighnd.inc | 2 +- rtl/go32v2/dpmiexcp.pp | 2 +- rtl/haiku/i386/sighnd.inc | 2 +- rtl/haiku/x86_64/sighnd.inc | 2 +- rtl/i8086/math.inc | 2 +- rtl/inc/genmath.inc | 2 +- rtl/linux/i386/sighnd.inc | 85 ++++++++++++++++++++-------------- rtl/linux/i386/sighndh.inc | 16 ++++++- rtl/linux/m68k/sighnd.inc | 4 +- rtl/linux/powerpc/sighnd.inc | 2 +- rtl/linux/powerpc64/sighnd.inc | 2 +- rtl/linux/sparc/sighnd.inc | 2 +- rtl/linux/sparc64/sighnd.inc | 2 +- rtl/linux/x86_64/sighnd.inc | 61 +++++++++++++++--------- rtl/netbsd/arm/sighnd.inc | 2 +- rtl/netbsd/m68k/sighnd.inc | 2 +- rtl/netbsd/powerpc/sighnd.inc | 2 +- rtl/netbsd/x86_64/sighnd.inc | 2 +- rtl/openbsd/i386/sighnd.inc | 2 +- rtl/openbsd/x86_64/sighnd.inc | 2 +- rtl/os2/system.pas | 2 +- rtl/solaris/i386/sighnd.inc | 2 +- rtl/solaris/sparc/sighnd.inc | 2 +- rtl/solaris/x86_64/sighnd.inc | 2 +- rtl/win32/system.pp | 5 +- rtl/win64/system.pp | 2 +- rtl/wince/system.pp | 2 +- tests/webtbs/tw37468.pp | 24 ++++++++++ tests/webtbs/tw37468b.pp | 28 +++++++++++ tests/webtbs/tw37926.pp | 24 ++++++++++ 32 files changed, 212 insertions(+), 84 deletions(-) create mode 100644 tests/webtbs/tw37468.pp create mode 100644 tests/webtbs/tw37468b.pp create mode 100644 tests/webtbs/tw37926.pp diff --git a/.gitattributes b/.gitattributes index 08c8907b24..b348c8b2c6 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/rtl/aix/sighnd.inc b/rtl/aix/sighnd.inc index 0c71479fbb..b482c4384a 100644 --- a/rtl/aix/sighnd.inc +++ b/rtl/aix/sighnd.inc @@ -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 } diff --git a/rtl/beos/i386/sighnd.inc b/rtl/beos/i386/sighnd.inc index cde20b8f50..8adbaad279 100644 --- a/rtl/beos/i386/sighnd.inc +++ b/rtl/beos/i386/sighnd.inc @@ -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 diff --git a/rtl/go32v2/dpmiexcp.pp b/rtl/go32v2/dpmiexcp.pp index f8c8447957..9957683f47 100644 --- a/rtl/go32v2/dpmiexcp.pp +++ b/rtl/go32v2/dpmiexcp.pp @@ -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 diff --git a/rtl/haiku/i386/sighnd.inc b/rtl/haiku/i386/sighnd.inc index d27f7ee9c6..edab9c1558 100644 --- a/rtl/haiku/i386/sighnd.inc +++ b/rtl/haiku/i386/sighnd.inc @@ -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 diff --git a/rtl/haiku/x86_64/sighnd.inc b/rtl/haiku/x86_64/sighnd.inc index 56a53d5abf..5b198db305 100644 --- a/rtl/haiku/x86_64/sighnd.inc +++ b/rtl/haiku/x86_64/sighnd.inc @@ -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 diff --git a/rtl/i8086/math.inc b/rtl/i8086/math.inc index 2757e52010..a18c8f0b4a 100644 --- a/rtl/i8086/math.inc +++ b/rtl/i8086/math.inc @@ -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 diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc index e99b8a28ff..88fa7da2bc 100644 --- a/rtl/inc/genmath.inc +++ b/rtl/inc/genmath.inc @@ -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) diff --git a/rtl/linux/i386/sighnd.inc b/rtl/linux/i386/sighnd.inc index 4a7a0dd3f3..04c1946572 100644 --- a/rtl/linux/i386/sighnd.inc +++ b/rtl/linux/i386/sighnd.inc @@ -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; diff --git a/rtl/linux/i386/sighndh.inc b/rtl/linux/i386/sighndh.inc index 999eeeac84..c1a5b89a5d 100644 --- a/rtl/linux/i386/sighndh.inc +++ b/rtl/linux/i386/sighndh.inc @@ -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; diff --git a/rtl/linux/m68k/sighnd.inc b/rtl/linux/m68k/sighnd.inc index b1229d66d1..ec122a9382 100644 --- a/rtl/linux/m68k/sighnd.inc +++ b/rtl/linux/m68k/sighnd.inc @@ -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 diff --git a/rtl/linux/powerpc/sighnd.inc b/rtl/linux/powerpc/sighnd.inc index b69ab8018c..596125ffeb 100644 --- a/rtl/linux/powerpc/sighnd.inc +++ b/rtl/linux/powerpc/sighnd.inc @@ -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 diff --git a/rtl/linux/powerpc64/sighnd.inc b/rtl/linux/powerpc64/sighnd.inc index c654e97f45..8e32201741 100644 --- a/rtl/linux/powerpc64/sighnd.inc +++ b/rtl/linux/powerpc64/sighnd.inc @@ -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 diff --git a/rtl/linux/sparc/sighnd.inc b/rtl/linux/sparc/sighnd.inc index 85696ebe28..2c8e125352 100644 --- a/rtl/linux/sparc/sighnd.inc +++ b/rtl/linux/sparc/sighnd.inc @@ -35,7 +35,7 @@ begin FPE_INTOVF: res:=215; FPE_FLTDIV: - res:=200; + res:=208; FPE_FLTOVF: res:=205; FPE_FLTUND: diff --git a/rtl/linux/sparc64/sighnd.inc b/rtl/linux/sparc64/sighnd.inc index 85696ebe28..2c8e125352 100644 --- a/rtl/linux/sparc64/sighnd.inc +++ b/rtl/linux/sparc64/sighnd.inc @@ -35,7 +35,7 @@ begin FPE_INTOVF: res:=215; FPE_FLTDIV: - res:=200; + res:=208; FPE_FLTOVF: res:=205; FPE_FLTUND: diff --git a/rtl/linux/x86_64/sighnd.inc b/rtl/linux/x86_64/sighnd.inc index da570a90d5..4a9d9a7eba 100644 --- a/rtl/linux/x86_64/sighnd.inc +++ b/rtl/linux/x86_64/sighnd.inc @@ -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, diff --git a/rtl/netbsd/arm/sighnd.inc b/rtl/netbsd/arm/sighnd.inc index 6546f18b97..5fa37e00c8 100644 --- a/rtl/netbsd/arm/sighnd.inc +++ b/rtl/netbsd/arm/sighnd.inc @@ -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 diff --git a/rtl/netbsd/m68k/sighnd.inc b/rtl/netbsd/m68k/sighnd.inc index c2f61066e6..df510bb5ec 100644 --- a/rtl/netbsd/m68k/sighnd.inc +++ b/rtl/netbsd/m68k/sighnd.inc @@ -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 diff --git a/rtl/netbsd/powerpc/sighnd.inc b/rtl/netbsd/powerpc/sighnd.inc index d34cf9a2be..639d2c57df 100644 --- a/rtl/netbsd/powerpc/sighnd.inc +++ b/rtl/netbsd/powerpc/sighnd.inc @@ -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 diff --git a/rtl/netbsd/x86_64/sighnd.inc b/rtl/netbsd/x86_64/sighnd.inc index 2d6676ec94..5cbe084c6c 100644 --- a/rtl/netbsd/x86_64/sighnd.inc +++ b/rtl/netbsd/x86_64/sighnd.inc @@ -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 diff --git a/rtl/openbsd/i386/sighnd.inc b/rtl/openbsd/i386/sighnd.inc index 2979c765b3..b4c8ca06a6 100644 --- a/rtl/openbsd/i386/sighnd.inc +++ b/rtl/openbsd/i386/sighnd.inc @@ -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 diff --git a/rtl/openbsd/x86_64/sighnd.inc b/rtl/openbsd/x86_64/sighnd.inc index fa3d125b77..231b637e42 100644 --- a/rtl/openbsd/x86_64/sighnd.inc +++ b/rtl/openbsd/x86_64/sighnd.inc @@ -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 diff --git a/rtl/os2/system.pas b/rtl/os2/system.pas index 65b9b19b76..b78a4b1dc5 100644 --- a/rtl/os2/system.pas +++ b/rtl/os2/system.pas @@ -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; diff --git a/rtl/solaris/i386/sighnd.inc b/rtl/solaris/i386/sighnd.inc index a6ce2546c3..864cbf63b3 100644 --- a/rtl/solaris/i386/sighnd.inc +++ b/rtl/solaris/i386/sighnd.inc @@ -52,7 +52,7 @@ begin FPE_INTOVF: res:=205; FPE_FLTDIV: - res:=200; + res:=208; FPE_FLTOVF: res:=205; FPE_FLTUND: diff --git a/rtl/solaris/sparc/sighnd.inc b/rtl/solaris/sparc/sighnd.inc index 6061cf884e..1bd1a11c85 100644 --- a/rtl/solaris/sparc/sighnd.inc +++ b/rtl/solaris/sparc/sighnd.inc @@ -58,7 +58,7 @@ begin FPE_INTOVF: res:=205; FPE_FLTDIV: - res:=200; + res:=208; FPE_FLTOVF: res:=205; FPE_FLTUND: diff --git a/rtl/solaris/x86_64/sighnd.inc b/rtl/solaris/x86_64/sighnd.inc index d5d513d6cb..558f9549d4 100644 --- a/rtl/solaris/x86_64/sighnd.inc +++ b/rtl/solaris/x86_64/sighnd.inc @@ -52,7 +52,7 @@ begin FPE_INTOVF: res:=205; FPE_FLTDIV: - res:=200; + res:=208; FPE_FLTOVF: res:=205; FPE_FLTUND: diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index af20d9a679..b1c3df9db4 100644 --- a/rtl/win32/system.pp +++ b/rtl/win32/system.pp @@ -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; diff --git a/rtl/win64/system.pp b/rtl/win64/system.pp index ae3d51f4ff..7bbaa6d619 100644 --- a/rtl/win64/system.pp +++ b/rtl/win64/system.pp @@ -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; diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp index 84a06be6c5..c86bed4be3 100644 --- a/rtl/wince/system.pp +++ b/rtl/wince/system.pp @@ -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; diff --git a/tests/webtbs/tw37468.pp b/tests/webtbs/tw37468.pp new file mode 100644 index 0000000000..a3895014b9 --- /dev/null +++ b/tests/webtbs/tw37468.pp @@ -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. diff --git a/tests/webtbs/tw37468b.pp b/tests/webtbs/tw37468b.pp new file mode 100644 index 0000000000..8b64b76b7f --- /dev/null +++ b/tests/webtbs/tw37468b.pp @@ -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. diff --git a/tests/webtbs/tw37926.pp b/tests/webtbs/tw37926.pp new file mode 100644 index 0000000000..715d496fe7 --- /dev/null +++ b/tests/webtbs/tw37926.pp @@ -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.