diff options
| author | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-22 19:11:54 +0200 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-22 19:11:54 +0200 |
| commit | 879e23f05867aed40198a68fcd3ba8df62ee104c (patch) | |
| tree | 141d2277fcef0319ec39cd5f3d34a697ef848949 /gcc/ada/a-ngcoty.adb | |
| parent | 153b6955c8f5cc3bd4253aa9f656d1a90a21b5d1 (diff) | |
| download | gcc-879e23f05867aed40198a68fcd3ba8df62ee104c.zip gcc-879e23f05867aed40198a68fcd3ba8df62ee104c.tar.gz gcc-879e23f05867aed40198a68fcd3ba8df62ee104c.tar.bz2 | |
[multiple changes]
2010-06-22 Doug Rupp <rupp@adacore.com>
* system-vms.ads, system-vms-zcx.ads: Remove old unused VMS system
packages.
* system-vms_64.ads, system-vms-ia64.ads: Minor reformatting.
(pragma Ident): Add a default ident string in the private part.
2010-06-22 Robert Dewar <dewar@adacore.com>
* cstand.adb: Minor reformatting.
2010-06-22 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Build_And_Analyze_Renamed_Body): For expansion purposes,
recognize the Shift and Rotation intrinsics that are known to the
compiler but have no interface name.
2010-06-22 Geert Bosch <bosch@adacore.com>
* a-ngcoty.adb ("*"): Rewrite complex multiplication to use proper
scaling in case of overflow or NaN results.
From-SVN: r161210
Diffstat (limited to 'gcc/ada/a-ngcoty.adb')
| -rw-r--r-- | gcc/ada/a-ngcoty.adb | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/gcc/ada/a-ngcoty.adb b/gcc/ada/a-ngcoty.adb index 81cc68a..d45dcd2 100644 --- a/gcc/ada/a-ngcoty.adb +++ b/gcc/ada/a-ngcoty.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -43,6 +43,12 @@ package body Ada.Numerics.Generic_Complex_Types is --------- function "*" (Left, Right : Complex) return Complex is + + Scale : constant R := R (R'Machine_Radix) ** ((R'Machine_Emax - 1) / 2); + -- In case of overflow, scale the operands by the largest power of the + -- radix (to avoid rounding error), so that the square of the scale does + -- not overflow itself. + X : R; Y : R; @@ -53,14 +59,19 @@ package body Ada.Numerics.Generic_Complex_Types is -- If either component overflows, try to scale (skip in fast math mode) if not Standard'Fast_Math then - if abs (X) > R'Last then - X := R'(4.0) * (R'(Left.Re / 2.0) * R'(Right.Re / 2.0) - - R'(Left.Im / 2.0) * R'(Right.Im / 2.0)); + + -- ??? the test below is weird, it needs a comment, otherwise I or + -- someone else will change it back to R'Last > abs (X) ??? + + if not (abs (X) <= R'Last) then + X := Scale**2 * ((Left.Re / Scale) * (Right.Re / Scale) - + (Left.Im / Scale) * (Right.Im / Scale)); end if; - if abs (Y) > R'Last then - Y := R'(4.0) * (R'(Left.Re / 2.0) * R'(Right.Im / 2.0) - - R'(Left.Im / 2.0) * R'(Right.Re / 2.0)); + -- ??? same weird test ??? + if not (abs (Y) <= R'Last) then + Y := Scale**2 * ((Left.Re / Scale) * (Right.Im / Scale) + + (Left.Im / Scale) * (Right.Re / Scale)); end if; end if; @@ -569,7 +580,8 @@ package body Ada.Numerics.Generic_Complex_Types is -- in order to prevent inaccuracies on machines where not all -- immediate expressions are rounded, such as PowerPC. - if Re2 > R'Last then + -- ??? same weird test, why not Re2 > R'Last ??? + if not (Re2 <= R'Last) then raise Constraint_Error; end if; @@ -582,7 +594,8 @@ package body Ada.Numerics.Generic_Complex_Types is begin Im2 := X.Im ** 2; - if Im2 > R'Last then + -- ??? same weird test + if not (Im2 <= R'Last) then raise Constraint_Error; end if; |