2011-10-13 Geert Bosch <bosch@adacore.com>

	* s-gearop.ads (Forward_Eliminate): Add "abs" formal function
	returning a Real.
	* s-gearop.adb (Forward_Eliminate): Remove local "abs" function
	and use formal.
	* a-ngrear.adb (Forward_Eliminate): Adjust instantiation for
	new profile.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179910 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 24fd582..cd443af 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,14 @@
 2011-10-13  Geert Bosch  <bosch@adacore.com>
 
+       * s-gearop.ads (Forward_Eliminate): Add "abs" formal function
+       returning a Real.
+       * s-gearop.adb (Forward_Eliminate): Remove local "abs" function
+       and use formal.
+       * a-ngrear.adb (Forward_Eliminate): Adjust instantiation for
+       new profile.
+
+2011-10-13  Geert Bosch  <bosch@adacore.com>
+
        * a-ngrear.adb, s-gearop.adb, s-gearop.ads (Sqrt): Make generic and
        move to System.Generic_Array_Operations.
 

diff --git a/gcc/ada/a-ngrear.adb b/gcc/ada/a-ngrear.adb
index 85c949e..c5ed66a 100644 (file)
--- a/gcc/ada/a-ngrear.adb
+++ b/gcc/ada/a-ngrear.adb
@@ -33,7 +33,7 @@
 --  reason for this is new Ada 2012 requirements that prohibit algorithms such
 --  as Strassen's algorithm, which may be used by some BLAS implementations. In
 --  addition, some platforms lacked suitable compilers to compile the reference
---  BLAS/LAPACK implementation. Finally, on many platforms there may be more
+--  BLAS/LAPACK implementation. Finally, on some platforms there are be more
 --  floating point types than supported by BLAS/LAPACK.
 
 with Ada.Containers.Generic_Anonymous_Array_Sort; use Ada.Containers;
@@ -59,6 +59,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
 
    procedure Forward_Eliminate is new Ops.Forward_Eliminate
     (Scalar        => Real'Base,
+     Real          => Real'Base,
      Matrix        => Real_Matrix,
      Zero          => 0.0,
      One           => 1.0);

diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index 1380cd4..3aba5b9 100644 (file)
--- a/gcc/ada/s-gearop.adb
+++ b/gcc/ada/s-gearop.adb
@@ -161,9 +161,6 @@ package body System.Generic_Array_Operations is
       pragma Assert (M'First (1) = N'First (1) and then
                      M'Last  (1) = N'Last (1));
 
-      function "abs" (X : Scalar) return Scalar is
-        (if X < Zero then Zero - X else X);
-
       --  The following are variations of the elementary matrix row operations:
       --  row switching, row multiplication and row addition. Because in this
       --  algorithm the addition factor is always a negated value, we chose to
@@ -274,14 +271,14 @@ package body System.Generic_Array_Operations is
       for J in M'Range (2) loop
          declare
             Max_Row : Integer := Row;
-            Max_Abs : Scalar := Zero;
+            Max_Abs : Real'Base := 0.0;
 
          begin
             --  Find best pivot in column J, starting in row Row
 
             for K in Row .. M'Last (1) loop
                declare
-                  New_Abs : constant Scalar := abs M (K, J);
+                  New_Abs : constant Real'Base := abs M (K, J);
                begin
                   if Max_Abs < New_Abs then
                      Max_Abs := New_Abs;
@@ -290,7 +287,7 @@ package body System.Generic_Array_Operations is
                end;
             end loop;
 
-            if Zero < Max_Abs then
+            if Max_Abs > 0.0 then
                Switch_Row (M, N, Row, Max_Row);
                Divide_Row (M, N, Row, M (Row, J));
 

diff --git a/gcc/ada/s-gearop.ads b/gcc/ada/s-gearop.ads
index c8eea4f..9e9973c 100644 (file)
--- a/gcc/ada/s-gearop.ads
+++ b/gcc/ada/s-gearop.ads
@@ -65,12 +65,14 @@ pragma Pure (Generic_Array_Operations);
 
    generic
       type Scalar is private;
+      type Real is digits <>;
       type Matrix is array (Integer range <>, Integer range <>) of Scalar;
+      with function "abs" (Right : Scalar) return Real'Base is <>;
       with function "-" (Left, Right : Scalar) return Scalar is <>;
       with function "*" (Left, Right : Scalar) return Scalar is <>;
       with function "/" (Left, Right : Scalar) return Scalar is <>;
-      with function "<" (Left, Right : Scalar) return Boolean is <>;
-      Zero, One : Scalar;
+      Zero : Scalar;
+      One  : Scalar;
    procedure Forward_Eliminate
      (M   : in out Matrix;
       N   : in out Matrix;