From 879e23f05867aed40198a68fcd3ba8df62ee104c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 22 Jun 2010 19:11:54 +0200 Subject: [multiple changes] 2010-06-22 Doug Rupp * 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 * cstand.adb: Minor reformatting. 2010-06-22 Ed Schonberg * 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 * a-ngcoty.adb ("*"): Rewrite complex multiplication to use proper scaling in case of overflow or NaN results. From-SVN: r161210 --- gcc/ada/a-ngcoty.adb | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) (limited to 'gcc/ada/a-ngcoty.adb') 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; -- cgit v1.1