2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): Add code to set attribute
	Finalize_Address of the access type's finalization master.
	(Expand_N_Allocator): Add code to set attribute Finalize_Address of the
	access type's finalization master. Add a guard to prevent
	Associated_Storage_Pool from being set on .NET/JVM.
	* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Add code to set
	attribute Finalize_Address of the access type's finalization master.
	* exp_ch7.adb (Make_Finalize_Address_Call): New routine.
	* exp_ch7.ads (Make_Finalize_Address_Call): New routine.
	* rtsfind.ads: Add RE_Set_Finalize_Address to tables RE_Id and
	RE_Unit_Table.
	* s-finmas.adb: Add with clause for System.Address_Image. Add with and
	use clause for System.IO
	(Detach): Relax the assertion, to be reinstated later.
	(Finalize): Rewrite the iteration loop to avoid pointer comparison.
	Relax the assertion on Finalize_Address, to be reinstated later.
	(Is_Empty_List): New routine.
	(pm): New debug routine.
	(Set_Finalize_Address): New routine.
	* s-finmas.ads (pm): New debug routine.
	(Set_Finalize_Address): New routine.
	* s-stposu.adb (Allocate_Any_Controlled): Code reformatting.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* a-exexpr-gcc.adb (GCC_Exception_Access, GNAT_GCC_Exception_Access):
	Remove convention C.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* s-taprop-vms.adb (Get_Exc_Stack_Addr): Remove.
	(Initialize_TCB): Remove Exc_Stack_Ptr initialization.
	(Finalize_TCB): Remove its finalization.
	(Initialize): Remove assignment of GET_Exc_Stack_Addr
	* s-soflin.adb (NT_Exc_Stack): Remove
	(Get_Exc_Stack_Addr_NT): Likewise.
	(Get_Exc_Stack_Addr_Soft): Likewise.
	* s-soflin.ads (Get_Exc_Stack_Addr_NT): Remove.
	(Get_Exc_Stack_Addr): Likewise.
	(Get_Exc_Stack_Addr_Soft): Likewise
	* s-taspri-vms.ads (Exc_Stack_T): Remove.
	(Exc_Stack_Ptr_T): Likewise.
	(Private_Data): Remove Exc_Stack_Ptr component.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* raise-gcc.c (get_ip_from_context): New function. Factorize code.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* gnat_ugn.texi: Fix aix and x86-solaris info for run-time.

2011-08-29  Geert Bosch  <bosch@adacore.com>

	* s-gearop.ads (Back_Substitute, Diagonal, Forward_Eliminate,
	L2_Norm, Swap_Column): New generic subprograms
	* s-gearop.adb (Back_Substitute, Diagonal, Forward_Eliminate,
	L2_Norm, Swap_Column): Implement new subprograms in order to
	eliminate dependency on BLAS and LAPACK libraries in
	Ada.Numerics.Generic_Real_Arrays and eventually also the complex
	version. Forward_Eliminate/Back_Substitute can be used to put a
	matrix in row echelon or reduced row echelon form using partial
	pivoting.
	* a-ngrear.adb: (Back_Substitute, Diagonal, Forward_Eleminate,
	Swap_Column): Instantiate from System.Generic_Array_Operations.
	("*", "abs"): Implement by instantiation from Generic_Array_Operations.
	(Sqrt): Local function for simple computation of square root without
	adding dependencies on Generic_Elementary_Functions.
	(Swap): New subprogram to exchange floating point numbers.
	(Inverse): Reimplement using Jordan-Gauss elimination.
	(Jacobi): New procedure implementing Jacobi's method for computation
	of eigensystems, based on Rutishauser's implementation.
	(L2_Norm): Implement directly using the inner product.
	(Sort_Eigensystem): Sort eigenvalue/eigenvector pairs in order of
	decreasing eigenvalue as required by the Ada RM.
	(Swap_Column): New helper procedure for Sort_Eigensystem.
	Remove with of System.Generic_Real_BLAS and System.Generic_Real_LAPACK.
	Add with of Ada.Containers.Generic_Anonymous_Array_Sort, for
	Sort_Eigensystems.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* put_scos.adb (Put_SCOs): Do not emit a newline for an empty
	statements line.



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

1 files changed, 235 insertions, 1 deletions

diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index 8f0d9e84dd0..017392ca6ec 100644
--- a/gcc/ada/s-gearop.adb
+++ b/gcc/ada/s-gearop.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 2006-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 2006-2011, 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,27 @@ package body System.Generic_Array_Operations is
       First : Integer) return Integer;
    pragma Inline_Always (Check_Unit_Last);
 
+   --------------
+   -- Diagonal --
+   --------------
+
+   function Diagonal (A : Matrix) return Vector is
+
+      N : constant Natural := Natural'Min (A'Length (1), A'Length (2));
+      R : Vector (A'First (1) .. A'First (1) + N - 1);
+
+   begin
+      for J in 0 .. N - 1 loop
+         R (R'First + J) := A (A'First (1) + J, A'First (2) + J);
+      end loop;
+
+      return R;
+   end Diagonal;
+
+   --------------------------
+   -- Square_Matrix_Length --
+   --------------------------
+
    function Square_Matrix_Length (A : Matrix) return Natural is
    begin
       if A'Length (1) /= A'Length (2) then
@@ -73,6 +94,196 @@ package body System.Generic_Array_Operations is
       return First + (Order - 1);
    end Check_Unit_Last;
 
+   ---------------------
+   -- Back_Substitute --
+   ---------------------
+
+   procedure Back_Substitute (M, N : in out Matrix) is
+      pragma Assert (M'First (1) = N'First (1) and then
+                     M'Last  (1) = N'Last (1));
+      Max_Col : Integer := M'Last (2);
+
+      procedure Sub_Row
+        (M      : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar);
+
+      procedure Sub_Row
+        (M      : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar) is
+      begin
+         for J in M'Range (2) loop
+            M (Target, J) := M (Target, J) - Factor * M (Source, J);
+         end loop;
+      end Sub_Row;
+
+   begin
+      for Row in reverse M'Range (1) loop
+         Find_Non_Zero : for Col in M'First (2) .. Max_Col loop
+            if Is_Non_Zero (M (Row, Col)) then
+               --  Found first non-zero element, so subtract a multiple
+               --  of this row from all higher rows, to reduce all other
+               --  elements in this column to zero.
+
+               for J in M'First (1) .. Row - 1 loop
+                  Sub_Row (N, J, Row, (M (J, Col) / M (Row, Col)));
+                  Sub_Row (M, J, Row, (M (J, Col) / M (Row, Col)));
+               end loop;
+
+               Max_Col := Col - 1;
+               exit Find_Non_Zero;
+            end if;
+         end loop Find_Non_Zero;
+      end loop;
+   end Back_Substitute;
+
+   -----------------------
+   -- Forward_Eliminate --
+   -----------------------
+
+   procedure Forward_Eliminate
+     (M   : in out Matrix;
+      N   : in out Matrix;
+      Det : out Scalar)
+   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);
+
+      procedure Sub_Row
+        (M : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar);
+
+      procedure Divide_Row
+        (M, N  : in out Matrix;
+         Row   : Integer;
+         Scale : Scalar);
+
+      procedure Switch_Row
+        (M, N  : in out Matrix;
+         Row_1 : Integer;
+         Row_2 : Integer);
+
+      -------------
+      -- Sub_Row --
+      -------------
+
+      procedure Sub_Row
+        (M      : in out Matrix;
+         Target : Integer;
+         Source : Integer;
+         Factor : Scalar) is
+      begin
+         for J in M'Range (2) loop
+            M (Target, J) := M (Target, J) - Factor * M (Source, J);
+         end loop;
+      end Sub_Row;
+
+      ----------------
+      -- Divide_Row --
+      ----------------
+
+      procedure Divide_Row
+        (M, N  : in out Matrix;
+         Row   : Integer;
+         Scale : Scalar)
+      is
+      begin
+         Det := Det * Scale;
+
+         for J in M'Range (2) loop
+            M (Row, J) := M (Row, J) / Scale;
+         end loop;
+
+         for J in N'Range (2) loop
+            N (Row - M'First (1) + N'First (1), J)
+               := N (Row - M'First (1) + N'First (1), J) / Scale;
+         end loop;
+      end Divide_Row;
+
+      ----------------
+      -- Switch_Row --
+      ----------------
+
+      procedure Switch_Row
+        (M, N  : in out Matrix;
+         Row_1 : Integer;
+         Row_2 : Integer)
+      is
+         procedure Swap (X, Y : in out Scalar);
+         --  Exchange the values of X and Y
+
+         procedure Swap (X, Y : in out Scalar) is
+            T : constant Scalar := X;
+         begin
+            X := Y;
+            Y := T;
+         end Swap;
+
+      begin
+         if Row_1 /= Row_2 then
+            Det := Zero - Det;
+
+            for J in M'Range (2) loop
+               Swap (M (Row_1, J), M (Row_2, J));
+            end loop;
+
+            for J in N'Range (2) loop
+               Swap (N (Row_1 - M'First (1) + N'First (1), J),
+                     N (Row_2 - M'First (1) + N'First (1), J));
+            end loop;
+         end if;
+      end Switch_Row;
+
+      I   : Integer := M'First (1);
+
+   begin -- Forward_Eliminate
+      Det := One;
+
+      for J in M'Range (2) loop
+         declare
+            Max_I   : Integer := I;
+            Max_Abs : Scalar := Zero;
+         begin
+            --  Find best pivot in column J, starting in row I.
+            for K in I .. M'Last (1) loop
+               declare
+                  New_Abs : constant Scalar := abs M (K, J);
+               begin
+                  if Max_Abs < New_Abs then
+                     Max_Abs := New_Abs;
+                     Max_I := K;
+                  end if;
+               end;
+            end loop;
+
+            if Zero < Max_Abs then
+               Switch_Row (M, N, I, Max_I);
+               Divide_Row (M, N, I, M (I, J));
+
+               for U in I + 1 .. M'Last (1) loop
+                  Sub_Row (N, U, I, M (U, J));
+                  Sub_Row (M, U, I, M (U, J));
+               end loop;
+
+               exit when I >= M'Last (1);
+
+               I := I + 1;
+
+            else
+               Det := Zero; --  Zero, but we don't have literals
+            end if;
+         end;
+      end loop;
+   end Forward_Eliminate;
+
    -------------------
    -- Inner_Product --
    -------------------
@@ -97,6 +308,15 @@ package body System.Generic_Array_Operations is
       return R;
    end Inner_Product;
 
+   -------------
+   -- L2_Norm --
+   -------------
+
+   function L2_Norm (X : Vector) return Scalar is
+   begin
+      return Sqrt (Inner_Product (X, X));
+   end L2_Norm;
+
    ----------------------------------
    -- Matrix_Elementwise_Operation --
    ----------------------------------
@@ -402,6 +622,20 @@ package body System.Generic_Array_Operations is
       return R;
    end Outer_Product;
 
+   -----------------
+   -- Swap_Column --
+   -----------------
+
+   procedure Swap_Column (A : in out Matrix; Left, Right : Integer) is
+      Temp : Scalar;
+   begin
+      for J in A'Range (1) loop
+         Temp := A (J, Left);
+         A (J, Left) := A (J, Right);
+         A (J, Right) := Temp;
+      end loop;
+   end Swap_Column;
+
    ---------------
    -- Transpose --
    ---------------