Skip to content

R
riscv-gcc-1
Commit 815f44d0 by Geert Bosch Committed by Arnaud Charlet
Options

i-fortra.ads: Add Double_Complex type. 

2007-04-06  Geert Bosch  <bosch@adacore.com>
	    Robert Dewar  <dewar@adacore.com>

	* i-fortra.ads: Add Double_Complex type.

	* impunit.adb: (Is_Known_Unit): New function
	Add Gnat.Byte_Swapping
	Add GNAT.SHA1
	Add new Ada 2005 units
	Ada.Numerics.Generic_Complex_Arrays, Ada.Numerics.Generic_Real_Arrays,
	Ada.Numerics.Complex_Arrays, Ada.Numerics.Real_Arrays,
	Ada.Numerics.Long_Complex_Arrays, Ada.Numerics.Long_Long_Complex_Arrays,
	Ada.Numerics.Long_Long_Real_Arrays and Ada.Numerics.Long_Real_Arrays

	* impunit.ads (Is_Known_Unit): New function

	* a-ngcoar.adb, a-ngcoar.ads, a-ngrear.adb,
	a-ngrear.ads, a-nlcoar.ads, a-nllcar.ads, a-nllrar.ads, a-nlrear.ads,
	a-nucoar.ads, a-nurear.ads, g-bytswa.adb, g-bytswa-x86.adb,
	g-bytswa.ads, g-sha1.adb, g-sha1.ads, i-forbla.ads, i-forlap.ads,
	s-gearop.adb, s-gearop.ads, s-gecobl.adb, s-gecobl.ads, s-gecola.adb,
	s-gecola.ads, s-gerebl.adb, s-gerebl.ads, s-gerela.adb, s-gerela.ads:
	New files.

	* Makefile.rtl: Add g-bytswa, g-sha1, a-fzteio and a-izteio

	* a-fzteio.ads, a-izteio.ads: New Ada 2005 run-time units.

From-SVN: r123579
parent 0ee30464
Showing with 1529 additions and 5 deletions
gcc/ada/Makefile.rtl
...@@ -26,7 +26,6 @@ ...@@ -26,7 +26,6 @@
# Objects needed only for tasking # Objects needed only for tasking
GNATRTL_TASKING_OBJS= \ GNATRTL_TASKING_OBJS= \
a-diroro$(objext) \
a-dispat$(objext) \ a-dispat$(objext) \
a-dynpri$(objext) \ a-dynpri$(objext) \
a-interr$(objext) \ a-interr$(objext) \
...@@ -135,9 +134,11 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -135,9 +134,11 @@ GNATRTL_NONTASKING_OBJS= \
a-finali$(objext) \ a-finali$(objext) \
a-flteio$(objext) \ a-flteio$(objext) \
a-fwteio$(objext) \ a-fwteio$(objext) \
a-fzteio$(objext) \
a-inteio$(objext) \ a-inteio$(objext) \
a-ioexce$(objext) \ a-ioexce$(objext) \
a-iwteio$(objext) \ a-iwteio$(objext) \
a-izteio$(objext) \
a-lcteio$(objext) \ a-lcteio$(objext) \
a-lfteio$(objext) \ a-lfteio$(objext) \
a-llctio$(objext) \ a-llctio$(objext) \
...@@ -313,6 +314,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -313,6 +314,7 @@ GNATRTL_NONTASKING_OBJS= \
g-bubsor$(objext) \ g-bubsor$(objext) \
g-busora$(objext) \ g-busora$(objext) \
g-busorg$(objext) \ g-busorg$(objext) \
g-bytswa$(objext) \
g-calend$(objext) \ g-calend$(objext) \
g-casuti$(objext) \ g-casuti$(objext) \
g-catiio$(objext) \ g-catiio$(objext) \
...@@ -350,6 +352,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -350,6 +352,7 @@ GNATRTL_NONTASKING_OBJS= \
g-regexp$(objext) \ g-regexp$(objext) \
g-regpat$(objext) \ g-regpat$(objext) \
g-sestin$(objext) \ g-sestin$(objext) \
g-sha1$(objext) \
g-soccon$(objext) \ g-soccon$(objext) \
g-socket$(objext) \ g-socket$(objext) \
g-socthi$(objext) \ g-socthi$(objext) \
......
gcc/ada/a-fzteio.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . F L O A T _ W I D E _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO;
package Ada.Float_Wide_Wide_Text_IO is
new Ada.Wide_Wide_Text_IO.Float_IO (Float);
gcc/ada/a-izteio.ads 0 → 100755
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . I N T E G E R _ W I D E _ W I D E _ T E X T _ I O --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Wide_Wide_Text_IO;
package Ada.Integer_Wide_Wide_Text_IO is
new Ada.Wide_Wide_Text_IO.Integer_IO (Integer);
gcc/ada/a-ngcoar.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.GENERIC_COMPLEX_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Real_Arrays, Ada.Numerics.Generic_Complex_Types;
generic
with package Real_Arrays is new Ada.Numerics.Generic_Real_Arrays (<>);
use Real_Arrays;
with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real);
use Complex_Types;
package Ada.Numerics.Generic_Complex_Arrays is
pragma Pure (Generic_Complex_Arrays);
-- Types
type Complex_Vector is array (Integer range <>) of Complex;
type Complex_Matrix is
array (Integer range <>, Integer range <>) of Complex;
-- Subprograms for Complex_Vector types
-- Complex_Vector selection, conversion and composition operations
function Re (X : Complex_Vector) return Real_Vector;
function Im (X : Complex_Vector) return Real_Vector;
procedure Set_Re (X : in out Complex_Vector; Re : in Real_Vector);
procedure Set_Im (X : in out Complex_Vector; Im : in Real_Vector);
function Compose_From_Cartesian
(Re : Real_Vector) return Complex_Vector;
function Compose_From_Cartesian
(Re, Im : Real_Vector) return Complex_Vector;
function Modulus (X : Complex_Vector) return Real_Vector;
function "abs" (Right : Complex_Vector) return Real_Vector renames Modulus;
function Argument (X : Complex_Vector) return Real_Vector;
function Argument
(X : Complex_Vector;
Cycle : Real'Base) return Real_Vector;
function Compose_From_Polar
(Modulus, Argument : Real_Vector) return Complex_Vector;
function Compose_From_Polar
(Modulus, Argument : Real_Vector;
Cycle : Real'Base) return Complex_Vector;
-- Complex_Vector arithmetic operations
function "+" (Right : Complex_Vector) return Complex_Vector;
function "-" (Right : Complex_Vector) return Complex_Vector;
function Conjugate (X : Complex_Vector) return Complex_Vector;
function "+" (Left, Right : Complex_Vector) return Complex_Vector;
function "-" (Left, Right : Complex_Vector) return Complex_Vector;
function "*" (Left, Right : Complex_Vector) return Complex;
function "abs" (Right : Complex_Vector) return Complex;
-- Mixed Real_Vector and Complex_Vector arithmetic operations
function "+"
(Left : Real_Vector;
Right : Complex_Vector) return Complex_Vector;
function "+"
(Left : Complex_Vector;
Right : Real_Vector) return Complex_Vector;
function "-"
(Left : Real_Vector;
Right : Complex_Vector) return Complex_Vector;
function "-"
(Left : Complex_Vector;
Right : Real_Vector) return Complex_Vector;
function "*" (Left : Real_Vector; Right : Complex_Vector) return Complex;
function "*" (Left : Complex_Vector; Right : Real_Vector) return Complex;
-- Complex_Vector scaling operations
function "*"
(Left : Complex;
Right : Complex_Vector) return Complex_Vector;
function "*"
(Left : Complex_Vector;
Right : Complex) return Complex_Vector;
function "/"
(Left : Complex_Vector;
Right : Complex) return Complex_Vector;
function "*"
(Left : Real'Base;
Right : Complex_Vector) return Complex_Vector;
function "*"
(Left : Complex_Vector;
Right : Real'Base) return Complex_Vector;
function "/"
(Left : Complex_Vector;
Right : Real'Base) return Complex_Vector;
-- Other Complex_Vector operations
function Unit_Vector
(Index : Integer;
Order : Positive;
First : Integer := 1) return Complex_Vector;
-- Subprograms for Complex_Matrix types
-- Complex_Matrix selection, conversion and composition operations
function Re (X : Complex_Matrix) return Real_Matrix;
function Im (X : Complex_Matrix) return Real_Matrix;
procedure Set_Re (X : in out Complex_Matrix; Re : in Real_Matrix);
procedure Set_Im (X : in out Complex_Matrix; Im : in Real_Matrix);
function Compose_From_Cartesian (Re : Real_Matrix) return Complex_Matrix;
function Compose_From_Cartesian
(Re, Im : Real_Matrix) return Complex_Matrix;
function Modulus (X : Complex_Matrix) return Real_Matrix;
function "abs" (Right : Complex_Matrix) return Real_Matrix renames Modulus;
function Argument (X : Complex_Matrix) return Real_Matrix;
function Argument
(X : Complex_Matrix;
Cycle : Real'Base) return Real_Matrix;
function Compose_From_Polar
(Modulus, Argument : Real_Matrix) return Complex_Matrix;
function Compose_From_Polar
(Modulus : Real_Matrix;
Argument : Real_Matrix;
Cycle : Real'Base) return Complex_Matrix;
-- Complex_Matrix arithmetic operations
function "+" (Right : Complex_Matrix) return Complex_Matrix;
function "-" (Right : Complex_Matrix) return Complex_Matrix;
function Conjugate (X : Complex_Matrix) return Complex_Matrix;
function Transpose (X : Complex_Matrix) return Complex_Matrix;
function "+" (Left, Right : Complex_Matrix) return Complex_Matrix;
function "-" (Left, Right : Complex_Matrix) return Complex_Matrix;
function "*" (Left, Right : Complex_Matrix) return Complex_Matrix;
function "*" (Left, Right : Complex_Vector) return Complex_Matrix;
function "*"
(Left : Complex_Vector;
Right : Complex_Matrix) return Complex_Vector;
function "*"
(Left : Complex_Matrix;
Right : Complex_Vector) return Complex_Vector;
-- Mixed Real_Matrix and Complex_Matrix arithmetic operations
function "+"
(Left : Real_Matrix;
Right : Complex_Matrix) return Complex_Matrix;
function "+"
(Left : Complex_Matrix;
Right : Real_Matrix) return Complex_Matrix;
function "-"
(Left : Real_Matrix;
Right : Complex_Matrix) return Complex_Matrix;
function "-"
(Left : Complex_Matrix;
Right : Real_Matrix) return Complex_Matrix;
function "*"
(Left : Real_Matrix;
Right : Complex_Matrix) return Complex_Matrix;
function "*"
(Left : Complex_Matrix;
Right : Real_Matrix) return Complex_Matrix;
function "*"
(Left : Real_Vector;
Right : Complex_Vector) return Complex_Matrix;
function "*"
(Left : Complex_Vector;
Right : Real_Vector) return Complex_Matrix;
function "*"
(Left : Real_Vector;
Right : Complex_Matrix) return Complex_Vector;
function "*"
(Left : Complex_Vector;
Right : Real_Matrix) return Complex_Vector;
function "*"
(Left : Real_Matrix;
Right : Complex_Vector) return Complex_Vector;
function "*"
(Left : Complex_Matrix;
Right : Real_Vector) return Complex_Vector;
-- Complex_Matrix scaling operations
function "*"
(Left : Complex;
Right : Complex_Matrix) return Complex_Matrix;
function "*"
(Left : Complex_Matrix;
Right : Complex) return Complex_Matrix;
function "/"
(Left : Complex_Matrix;
Right : Complex) return Complex_Matrix;
function "*"
(Left : Real'Base;
Right : Complex_Matrix) return Complex_Matrix;
function "*"
(Left : Complex_Matrix;
Right : Real'Base) return Complex_Matrix;
function "/"
(Left : Complex_Matrix;
Right : Real'Base) return Complex_Matrix;
-- Complex_Matrix inversion and related operations
function Solve
(A : Complex_Matrix;
X : Complex_Vector) return Complex_Vector;
function Solve (A, X : Complex_Matrix) return Complex_Matrix;
function Inverse (A : Complex_Matrix) return Complex_Matrix;
function Determinant (A : Complex_Matrix) return Complex;
-- Eigenvalues and vectors of a Hermitian matrix
function Eigenvalues (A : Complex_Matrix) return Real_Vector;
procedure Eigensystem
(A : in Complex_Matrix;
Values : out Real_Vector;
Vectors : out Complex_Matrix);
-- Other Complex_Matrix operations
function Unit_Matrix
(Order : Positive;
First_1, First_2 : Integer := 1) return Complex_Matrix;
end Ada.Numerics.Generic_Complex_Arrays;
gcc/ada/a-ngrear.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.GENERIC_REAL_ARRAYS --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
generic
type Real is digits <>;
package Ada.Numerics.Generic_Real_Arrays is
pragma Pure (Generic_Real_Arrays);
-- Types
type Real_Vector is array (Integer range <>) of Real'Base;
type Real_Matrix is array (Integer range <>, Integer range <>) of Real'Base;
-- Subprograms for Real_Vector types
-- Real_Vector arithmetic operations
function "+" (Right : Real_Vector) return Real_Vector;
function "-" (Right : Real_Vector) return Real_Vector;
function "abs" (Right : Real_Vector) return Real_Vector;
function "+" (Left, Right : Real_Vector) return Real_Vector;
function "-" (Left, Right : Real_Vector) return Real_Vector;
function "*" (Left, Right : Real_Vector) return Real'Base;
function "abs" (Right : Real_Vector) return Real'Base;
-- Real_Vector scaling operations
function "*" (Left : Real'Base; Right : Real_Vector) return Real_Vector;
function "*" (Left : Real_Vector; Right : Real'Base) return Real_Vector;
function "/" (Left : Real_Vector; Right : Real'Base) return Real_Vector;
-- Other Real_Vector operations
function Unit_Vector
(Index : Integer;
Order : Positive;
First : Integer := 1) return Real_Vector;
-- Subprograms for Real_Matrix types
-- Real_Matrix arithmetic operations
function "+" (Right : Real_Matrix) return Real_Matrix;
function "-" (Right : Real_Matrix) return Real_Matrix;
function "abs" (Right : Real_Matrix) return Real_Matrix;
function Transpose (X : Real_Matrix) return Real_Matrix;
function "+" (Left, Right : Real_Matrix) return Real_Matrix;
function "-" (Left, Right : Real_Matrix) return Real_Matrix;
function "*" (Left, Right : Real_Matrix) return Real_Matrix;
function "*" (Left, Right : Real_Vector) return Real_Matrix;
function "*" (Left : Real_Vector; Right : Real_Matrix) return Real_Vector;
function "*" (Left : Real_Matrix; Right : Real_Vector) return Real_Vector;
-- Real_Matrix scaling operations
function "*" (Left : Real'Base; Right : Real_Matrix) return Real_Matrix;
function "*" (Left : Real_Matrix; Right : Real'Base) return Real_Matrix;
function "/" (Left : Real_Matrix; Right : Real'Base) return Real_Matrix;
-- Real_Matrix inversion and related operations
function Solve (A : Real_Matrix; X : Real_Vector) return Real_Vector;
function Solve (A, X : Real_Matrix) return Real_Matrix;
function Inverse (A : Real_Matrix) return Real_Matrix;
function Determinant (A : Real_Matrix) return Real'Base;
-- Eigenvalues and vectors of a real symmetric matrix
function Eigenvalues (A : Real_Matrix) return Real_Vector;
procedure Eigensystem
(A : Real_Matrix;
Values : out Real_Vector;
Vectors : out Real_Matrix);
-- Other Real_Matrix operations
function Unit_Matrix
(Order : Positive;
First_1 : Integer := 1;
First_2 : Integer := 1) return Real_Matrix;
private
-- The following operations are either relatively simple compared to the
-- expense of returning unconstrained arrays, or are just function wrappers
-- calling procedures implementing the actual operation. By having the
-- front end always inline these, the expense of the unconstrained returns
-- can be avoided.
pragma Inline_Always ("+");
pragma Inline_Always ("-");
pragma Inline_Always ("*");
pragma Inline_Always ("/");
pragma Inline_Always ("abs");
pragma Inline_Always (Eigenvalues);
pragma Inline_Always (Inverse);
pragma Inline_Always (Solve);
pragma Inline_Always (Transpose);
pragma Inline_Always (Unit_Matrix);
pragma Inline_Always (Unit_Vector);
end Ada.Numerics.Generic_Real_Arrays;
gcc/ada/a-nlcoar.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_COMPLEX_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Arrays;
with Ada.Numerics.Long_Real_Arrays;
with Ada.Numerics.Long_Complex_Types;
package Ada.Numerics.Long_Complex_Arrays is new
Ada.Numerics.Generic_Complex_Arrays (Long_Real_Arrays, Long_Complex_Types);
pragma Pure (Long_Complex_Arrays);
gcc/ada/a-nllcar.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_LONG_COMPLEX_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Arrays;
with Ada.Numerics.Long_Long_Real_Arrays;
with Ada.Numerics.Long_Long_Complex_Types;
package Ada.Numerics.Long_Long_Complex_Arrays is
new Ada.Numerics.Generic_Complex_Arrays (Long_Long_Real_Arrays,
Long_Long_Complex_Types);
pragma Pure (Long_Long_Complex_Arrays);
gcc/ada/a-nllrar.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_LONG_REAL_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Real_Arrays;
package Ada.Numerics.Long_Long_Real_Arrays is
new Ada.Numerics.Generic_Real_Arrays (Long_Long_Float);
pragma Pure (Long_Long_Real_Arrays);
gcc/ada/a-nlrear.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.LONG_REAL_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Real_Arrays;
package Ada.Numerics.Long_Real_Arrays is
new Ada.Numerics.Generic_Real_Arrays (Long_Float);
pragma Pure (Long_Real_Arrays);
gcc/ada/a-nucoar.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.COMPLEX_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Complex_Arrays;
with Ada.Numerics.Real_Arrays;
with Ada.Numerics.Complex_Types;
package Ada.Numerics.Complex_Arrays is
new Ada.Numerics.Generic_Complex_Arrays (Real_Arrays, Complex_Types);
pragma Pure (Complex_Arrays);
gcc/ada/a-nurear.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.NUMERICS.REAL_ARRAYS --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
with Ada.Numerics.Generic_Real_Arrays;
package Ada.Numerics.Real_Arrays is
new Ada.Numerics.Generic_Real_Arrays (Float);
pragma Pure (Real_Arrays);
gcc/ada/g-sha1.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- G N A T . S H A 1 --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2006, AdaCore --
-- --
-- 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package implements the US Secure Hash Algorithm 1 (SHA1) as described
-- in RFC 3174. The complete text of RFC 3174 can be found at:
-- http://www.ietf.org/rfc/rfc3174.txt
-- Note: the code for this unit is derived from GNAT.MD5
with Ada.Streams;
with Interfaces;
package GNAT.SHA1 is
type Context is private;
-- This type holds the five-word (20 byte) buffer H, as described in
-- RFC 3174 (6.1). Its initial value is Initial_Context below.
Initial_Context : constant Context;
-- Initial value of a Context object. May be used to reinitialize
-- a Context value by simple assignment of this value to the object.
procedure Update
(C : in out Context;
Input : String);
procedure Wide_Update
(C : in out Context;
Input : Wide_String);
procedure Update
(C : in out Context;
Input : Ada.Streams.Stream_Element_Array);
-- Modify the Context C. If C has the initial value Initial_Context,
-- then, after a call to one of these procedures, Digest (C) will return
-- the Message-Digest of Input.
--
-- These procedures may be called successively with the same context and
-- different inputs, and these several successive calls will produce
-- the same final context as a call with the concatenation of the inputs.
subtype Message_Digest is String (1 .. 40);
-- The string type returned by function Digest
function Digest (C : Context) return Message_Digest;
-- Extracts the Message-Digest from a context. This function should be
-- used after one or several calls to Update.
function Digest (S : String) return Message_Digest;
function Wide_Digest (W : Wide_String) return Message_Digest;
function Digest
(A : Ada.Streams.Stream_Element_Array) return Message_Digest;
-- These functions are equivalent to the corresponding Update (or
-- Wide_Update) on a default initialized Context, followed by Digest
-- on the resulting Context.
private
-- Magic numbers
Initial_H0 : constant := 16#67452301#;
Initial_H1 : constant := 16#EFCDAB89#;
Initial_H2 : constant := 16#98BADCFE#;
Initial_H3 : constant := 16#10325476#;
Initial_H4 : constant := 16#C3D2E1F0#;
type H_Type is array (0 .. 4) of Interfaces.Unsigned_32;
Initial_H : constant H_Type :=
(0 => Initial_H0,
1 => Initial_H1,
2 => Initial_H2,
3 => Initial_H3,
4 => Initial_H4);
type Context is record
H : H_Type := Initial_H;
Buffer : String (1 .. 64) := (others => ASCII.NUL);
Last : Natural := 0;
Length : Natural := 0;
end record;
Initial_Context : constant Context :=
(H => Initial_H,
Buffer => (others => ASCII.NUL), Last => 0, Length => 0);
end GNAT.SHA1;
gcc/ada/i-forbla.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- INTERFACES.FORTRAN.BLAS --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Comment required if non-RM package ???
package Interfaces.Fortran.BLAS is
pragma Pure;
No_Trans : aliased constant Character := 'N';
Trans : aliased constant Character := 'T';
Conj_Trans : aliased constant Character := 'C';
-- Vector types
type Real_Vector is array (Integer range <>) of Real;
type Complex_Vector is array (Integer range <>) of Complex;
type Double_Precision_Vector is array (Integer range <>)
of Double_Precision;
type Double_Complex_Vector is array (Integer range <>) of Double_Complex;
-- Matrix types
type Real_Matrix is array (Integer range <>, Integer range <>)
of Real;
type Double_Precision_Matrix is array (Integer range <>, Integer range <>)
of Double_Precision;
type Complex_Matrix is array (Integer range <>, Integer range <>)
of Complex;
type Double_Complex_Matrix is array (Integer range <>, Integer range <>)
of Double_Complex;
-- BLAS Level 1
function sdot
(N : Positive;
X : Real_Vector;
Inc_X : Integer := 1;
Y : Real_Vector;
Inc_Y : Integer := 1) return Real;
function ddot
(N : Positive;
X : Double_Precision_Vector;
Inc_X : Integer := 1;
Y : Double_Precision_Vector;
Inc_Y : Integer := 1) return Double_Precision;
function cdot
(N : Positive;
X : Complex_Vector;
Inc_X : Integer := 1;
Y : Complex_Vector;
Inc_Y : Integer := 1) return Complex;
function zdot
(N : Positive;
X : Double_Complex_Vector;
Inc_X : Integer := 1;
Y : Double_Complex_Vector;
Inc_Y : Integer := 1) return Double_Complex;
function snrm2
(N : Natural;
X : Real_Vector;
Inc_X : Integer := 1) return Real;
function dnrm2
(N : Natural;
X : Double_Precision_Vector;
Inc_X : Integer := 1) return Double_Precision;
function scnrm2
(N : Natural;
X : Complex_Vector;
Inc_X : Integer := 1) return Real;
function dznrm2
(N : Natural;
X : Double_Complex_Vector;
Inc_X : Integer := 1) return Double_Precision;
-- BLAS Level 2
procedure sgemv
(Trans : access constant Character;
M : Natural := 0;
N : Natural := 0;
Alpha : Real := 1.0;
A : Real_Matrix;
Ld_A : Positive;
X : Real_Vector;
Inc_X : Integer := 1; -- must be non-zero
Beta : Real := 0.0;
Y : in out Real_Vector;
Inc_Y : Integer := 1); -- must be non-zero
procedure dgemv
(Trans : access constant Character;
M : Natural := 0;
N : Natural := 0;
Alpha : Double_Precision := 1.0;
A : Double_Precision_Matrix;
Ld_A : Positive;
X : Double_Precision_Vector;
Inc_X : Integer := 1; -- must be non-zero
Beta : Double_Precision := 0.0;
Y : in out Double_Precision_Vector;
Inc_Y : Integer := 1); -- must be non-zero
procedure cgemv
(Trans : access constant Character;
M : Natural := 0;
N : Natural := 0;
Alpha : Complex := (1.0, 1.0);
A : Complex_Matrix;
Ld_A : Positive;
X : Complex_Vector;
Inc_X : Integer := 1; -- must be non-zero
Beta : Complex := (0.0, 0.0);
Y : in out Complex_Vector;
Inc_Y : Integer := 1); -- must be non-zero
procedure zgemv
(Trans : access constant Character;
M : Natural := 0;
N : Natural := 0;
Alpha : Double_Complex := (1.0, 1.0);
A : Double_Complex_Matrix;
Ld_A : Positive;
X : Double_Complex_Vector;
Inc_X : Integer := 1; -- must be non-zero
Beta : Double_Complex := (0.0, 0.0);
Y : in out Double_Complex_Vector;
Inc_Y : Integer := 1); -- must be non-zero
-- BLAS Level 3
procedure sgemm
(Trans_A : access constant Character;
Trans_B : access constant Character;
M : Positive;
N : Positive;
K : Positive;
Alpha : Real := 1.0;
A : Real_Matrix;
Ld_A : Integer;
B : Real_Matrix;
Ld_B : Integer;
Beta : Real := 0.0;
C : in out Real_Matrix;
Ld_C : Integer);
procedure dgemm
(Trans_A : access constant Character;
Trans_B : access constant Character;
M : Positive;
N : Positive;
K : Positive;
Alpha : Double_Precision := 1.0;
A : Double_Precision_Matrix;
Ld_A : Integer;
B : Double_Precision_Matrix;
Ld_B : Integer;
Beta : Double_Precision := 0.0;
C : in out Double_Precision_Matrix;
Ld_C : Integer);
procedure cgemm
(Trans_A : access constant Character;
Trans_B : access constant Character;
M : Positive;
N : Positive;
K : Positive;
Alpha : Complex := (1.0, 1.0);
A : Complex_Matrix;
Ld_A : Integer;
B : Complex_Matrix;
Ld_B : Integer;
Beta : Complex := (0.0, 0.0);
C : in out Complex_Matrix;
Ld_C : Integer);
procedure zgemm
(Trans_A : access constant Character;
Trans_B : access constant Character;
M : Positive;
N : Positive;
K : Positive;
Alpha : Double_Complex := (1.0, 1.0);
A : Double_Complex_Matrix;
Ld_A : Integer;
B : Double_Complex_Matrix;
Ld_B : Integer;
Beta : Double_Complex := (0.0, 0.0);
C : in out Double_Complex_Matrix;
Ld_C : Integer);
private
pragma Import (Fortran, cdot, "cdot_");
pragma Import (Fortran, cgemm, "cgemm_");
pragma Import (Fortran, cgemv, "cgemv_");
pragma Import (Fortran, ddot, "ddot_");
pragma Import (Fortran, dgemm, "dgemm_");
pragma Import (Fortran, dgemv, "dgemv_");
pragma Import (Fortran, dnrm2, "dnrm2_");
pragma Import (Fortran, dznrm2, "dznrm2_");
pragma Import (Fortran, scnrm2, "scnrm2_");
pragma Import (Fortran, sdot, "sdot_");
pragma Import (Fortran, sgemm, "sgemm_");
pragma Import (Fortran, sgemv, "sgemv_");
pragma Import (Fortran, snrm2, "snrm2_");
pragma Import (Fortran, zdot, "zdot_");
pragma Import (Fortran, zgemm, "zgemm_");
pragma Import (Fortran, zgemv, "zgemv_");
end Interfaces.Fortran.BLAS;
gcc/ada/i-fortra.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a -- -- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. -- -- modified version, any changes that you have made are clearly indicated. --
...@@ -35,8 +35,13 @@ package Interfaces.Fortran is ...@@ -35,8 +35,13 @@ package Interfaces.Fortran is
package Single_Precision_Complex_Types is package Single_Precision_Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Real); new Ada.Numerics.Generic_Complex_Types (Real);
package Double_Precision_Complex_Types is
new Ada.Numerics.Generic_Complex_Types (Double_Precision);
type Complex is new Single_Precision_Complex_Types.Complex; type Complex is new Single_Precision_Complex_Types.Complex;
type Double_Complex is new Double_Precision_Complex_Types.Complex;
subtype Imaginary is Single_Precision_Complex_Types.Imaginary; subtype Imaginary is Single_Precision_Complex_Types.Imaginary;
i : Imaginary renames Single_Precision_Complex_Types.i; i : Imaginary renames Single_Precision_Complex_Types.i;
j : Imaginary renames Single_Precision_Complex_Types.j; j : Imaginary renames Single_Precision_Complex_Types.j;
......
gcc/ada/impunit.adb
...@@ -24,8 +24,12 @@ ...@@ -24,8 +24,12 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Lib; use Lib; with Atree; use Atree;
with Namet; use Namet; with Sinfo; use Sinfo;
with Fname.UF; use Fname.UF;
with Lib; use Lib;
with Namet; use Namet;
with Uname; use Uname;
package body Impunit is package body Impunit is
...@@ -207,6 +211,7 @@ package body Impunit is ...@@ -207,6 +211,7 @@ package body Impunit is
"g-bubsor", -- GNAT.Bubble_Sort "g-bubsor", -- GNAT.Bubble_Sort
"g-busora", -- GNAT.Bubble_Sort_A "g-busora", -- GNAT.Bubble_Sort_A
"g-busorg", -- GNAT.Bubble_Sort_G "g-busorg", -- GNAT.Bubble_Sort_G
"g-bytswa", -- Gnat.Byte_Swapping
"g-calend", -- GNAT.Calendar "g-calend", -- GNAT.Calendar
"g-casuti", -- GNAT.Case_Util "g-casuti", -- GNAT.Case_Util
"g-catiio", -- GNAT.Calendar.Time_IO "g-catiio", -- GNAT.Calendar.Time_IO
...@@ -246,6 +251,7 @@ package body Impunit is ...@@ -246,6 +251,7 @@ package body Impunit is
"g-regpat", -- GNAT.Regpat "g-regpat", -- GNAT.Regpat
"g-semaph", -- GNAT.Semaphores "g-semaph", -- GNAT.Semaphores
"g-sestin", -- GNAT.Secondary_Stack_Info "g-sestin", -- GNAT.Secondary_Stack_Info
"g-sha1 ", -- GNAT.SHA1
"g-signal", -- GNAT.Signals "g-signal", -- GNAT.Signals
"g-socket", -- GNAT.Sockets "g-socket", -- GNAT.Sockets
"g-souinf", -- GNAT.Source_Info "g-souinf", -- GNAT.Source_Info
...@@ -359,6 +365,10 @@ package body Impunit is ...@@ -359,6 +365,10 @@ package body Impunit is
"a-dispat", -- Ada.Dispatching "a-dispat", -- Ada.Dispatching
"a-envvar", -- Ada.Environment_Variables "a-envvar", -- Ada.Environment_Variables
"a-rttiev", -- Ada.Real_Time.Timing_Events "a-rttiev", -- Ada.Real_Time.Timing_Events
"a-ngcoar", -- Ada.Numerics.Generic_Complex_Arrays
"a-ngrear", -- Ada.Numerics.Generic_Real_Arrays
"a-nucoar", -- Ada.Numerics.Complex_Arrays
"a-nurear", -- Ada.Numerics.Real_Arrays
"a-stboha", -- Ada.Strings.Bounded.Hash "a-stboha", -- Ada.Strings.Bounded.Hash
"a-stfiha", -- Ada.Strings.Fixed.Hash "a-stfiha", -- Ada.Strings.Fixed.Hash
"a-strhas", -- Ada.Strings.Hash "a-strhas", -- Ada.Strings.Hash
...@@ -401,6 +411,10 @@ package body Impunit is ...@@ -401,6 +411,10 @@ package body Impunit is
"a-llctio", -- Ada.Long_Long_Complex_Text_IO "a-llctio", -- Ada.Long_Long_Complex_Text_IO
"a-llfzti", -- Ada.Long_Long_Float_Wide_Wide_Text_IO "a-llfzti", -- Ada.Long_Long_Float_Wide_Wide_Text_IO
"a-llizti", -- Ada.Long_Long_Integer_Wide_Wide_Text_IO "a-llizti", -- Ada.Long_Long_Integer_Wide_Wide_Text_IO
"a-nlcoar", -- Ada.Numerics.Long_Complex_Arrays
"a-nllcar", -- Ada.Numerics.Long_Long_Complex_Arrays
"a-nllrar", -- Ada.Numerics.Long_Long_Real_Arrays
"a-nlrear", -- Ada.Numerics.Long_Real_Arrays
"a-scteio", -- Ada.Short_Complex_Text_IO "a-scteio", -- Ada.Short_Complex_Text_IO
"a-sfztio", -- Ada.Short_Float_Wide_Wide_Text_IO "a-sfztio", -- Ada.Short_Float_Wide_Wide_Text_IO
"a-siztio", -- Ada.Short_Integer_Wide_Wide_Text_IO "a-siztio", -- Ada.Short_Integer_Wide_Wide_Text_IO
...@@ -536,4 +550,75 @@ package body Impunit is ...@@ -536,4 +550,75 @@ package body Impunit is
return Implementation_Unit; return Implementation_Unit;
end Get_Kind_Of_Unit; end Get_Kind_Of_Unit;
-------------------
-- Is_Known_Unit --
-------------------
function Is_Known_Unit (Nam : Node_Id) return Boolean is
Unam : Unit_Name_Type;
Fnam : File_Name_Type;
begin
-- If selector is not an identifier (e.g. it is a character literal or
-- some junk from a previous error), then definitely not a known unit.
if Nkind (Selector_Name (Nam)) /= N_Identifier then
return False;
end if;
-- Otherwise get corresponding file name
Unam := Get_Unit_Name (Nam);
Fnam := Get_File_Name (Unam, Subunit => False);
Get_Name_String (Fnam);
-- Remove extension from file name
if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then
Name_Len := Name_Len - 4;
else
return False;
end if;
-- Pad name to 8 characters
while Name_Len < 8 loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := ' ';
end loop;
-- If length more than 8, definitely not a match
if Name_Len /= 8 then
return False;
end if;
-- If length is 8, search our tables
for J in Non_Imp_File_Names_95'Range loop
if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
return True;
end if;
end loop;
for J in Non_Imp_File_Names_05'Range loop
if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
return True;
end if;
end loop;
-- If not found, not known
return False;
-- A safety guard, if we get an exception during this processing then it
-- is most likely the result of a previous error, or a peculiar case we
-- have not thought of. Since this routine is only used for error message
-- refinement, we will just return False.
exception
when others =>
return False;
end Is_Known_Unit;
end Impunit; end Impunit;
gcc/ada/impunit.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -58,4 +58,10 @@ package Impunit is ...@@ -58,4 +58,10 @@ package Impunit is
-- Given the unit number of a unit, this function determines the type -- Given the unit number of a unit, this function determines the type
-- of the unit, as defined above. -- of the unit, as defined above.
function Is_Known_Unit (Nam : Node_Id) return Boolean;
-- Nam is the possible name of a child unit, represented as a selected
-- component node. This function determines whether the name matches
-- one of the known library units, and if so, returns True. If the name
-- does not match any known library unit, False is returned.
end Impunit; end Impunit;
gcc/ada/s-gecobl.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- SYSTEM.GENERIC_COMPLEX_BLAS --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package comment required ???
with Ada.Numerics.Generic_Complex_Types;
generic
type Real is digits <>;
with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real);
use Complex_Types;
type Complex_Vector is array (Integer range <>) of Complex;
type Complex_Matrix is array (Integer range <>, Integer range <>)
of Complex;
package System.Generic_Complex_BLAS is
pragma Pure;
-- Although BLAS support is only available for IEEE single and double
-- compatible floating-point types, this unit will accept any type
-- and apply conversions as necessary, with possible loss of
-- precision and range.
No_Trans : aliased constant Character := 'N';
Trans : aliased constant Character := 'T';
Conj_Trans : aliased constant Character := 'C';
-- BLAS Level 1 Subprograms and Types
function dot
(N : Positive;
X : Complex_Vector;
Inc_X : Integer := 1;
Y : Complex_Vector;
Inc_Y : Integer := 1) return Complex;
function nrm2
(N : Natural;
X : Complex_Vector;
Inc_X : Integer := 1) return Real;
procedure gemv
(Trans : access constant Character;
M : Natural := 0;
N : Natural := 0;
Alpha : Complex := (1.0, 1.0);
A : Complex_Matrix;
Ld_A : Positive;
X : Complex_Vector;
Inc_X : Integer := 1; -- must be non-zero
Beta : Complex := (0.0, 0.0);
Y : in out Complex_Vector;
Inc_Y : Integer := 1); -- must be non-zero
-- BLAS Level 3
-- gemm s, d, c, z Matrix-matrix product of general matrices
procedure gemm
(Trans_A : access constant Character;
Trans_B : access constant Character;
M : Positive;
N : Positive;
K : Positive;
Alpha : Complex := (1.0, 1.0);
A : Complex_Matrix;
Ld_A : Integer;
B : Complex_Matrix;
Ld_B : Integer;
Beta : Complex := (0.0, 0.0);
C : in out Complex_Matrix;
Ld_C : Integer);
end System.Generic_Complex_BLAS;
gcc/ada/s-gecola.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- SYSTEM.GENERIC_COMPLEX_LAPACK --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package comment required ???
with Ada.Numerics.Generic_Complex_Types;
generic
type Real is digits <>;
type Real_Vector is array (Integer range <>) of Real;
with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (Real);
use Complex_Types;
type Complex_Vector is array (Integer range <>) of Complex;
type Complex_Matrix is array (Integer range <>, Integer range <>)
of Complex;
package System.Generic_Complex_LAPACK is
pragma Pure;
type Integer_Vector is array (Integer range <>) of Integer;
Upper : aliased constant Character := 'U';
Lower : aliased constant Character := 'L';
-- LAPACK Computational Routines
-- getrf computes LU factorization of a general m-by-n matrix
procedure getrf
(M : Natural;
N : Natural;
A : in out Complex_Matrix;
Ld_A : Positive;
I_Piv : out Integer_Vector;
Info : access Integer);
-- getri computes inverse of an LU-factored square matrix,
-- with multiple right-hand sides
procedure getri
(N : Natural;
A : in out Complex_Matrix;
Ld_A : Positive;
I_Piv : Integer_Vector;
Work : in out Complex_Vector;
L_Work : Integer;
Info : access Integer);
-- getrs solves a system of linear equations with an LU-factored
-- square matrix, with multiple right-hand sides
procedure getrs
(Trans : access constant Character;
N : Natural;
N_Rhs : Natural;
A : Complex_Matrix;
Ld_A : Positive;
I_Piv : Integer_Vector;
B : in out Complex_Matrix;
Ld_B : Positive;
Info : access Integer);
-- heevr computes selected eigenvalues and, optionally,
-- eigenvectors of a Hermitian matrix using the Relatively
-- Robust Representations
procedure heevr
(Job_Z : access constant Character;
Rng : access constant Character;
Uplo : access constant Character;
N : Natural;
A : in out Complex_Matrix;
Ld_A : Positive;
Vl, Vu : Real := 0.0;
Il, Iu : Integer := 1;
Abs_Tol : Real := 0.0;
M : out Integer;
W : out Real_Vector;
Z : out Complex_Matrix;
Ld_Z : Positive;
I_Supp_Z : out Integer_Vector;
Work : out Complex_Vector;
L_Work : Integer;
R_Work : out Real_Vector;
LR_Work : Integer;
I_Work : out Integer_Vector;
LI_Work : Integer;
Info : access Integer);
-- steqr computes all eigenvalues and eigenvectors of a symmetric or
-- Hermitian matrix reduced to tridiagonal form (QR algorithm)
procedure steqr
(Comp_Z : access constant Character;
N : Natural;
D : in out Real_Vector;
E : in out Real_Vector;
Z : in out Complex_Matrix;
Ld_Z : Positive;
Work : out Real_Vector;
Info : access Integer);
end System.Generic_Complex_LAPACK;
gcc/ada/s-gerebl.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- SYSTEM.GENERIC_REAL_BLAS --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package comment required ???
generic
type Real is digits <>;
type Real_Vector is array (Integer range <>) of Real;
type Real_Matrix is array (Integer range <>, Integer range <>) of Real;
package System.Generic_Real_BLAS is
pragma Pure;
-- Although BLAS support is only available for IEEE single and double
-- compatible floating-point types, this unit will accept any type
-- and apply conversions as necessary, with possible loss of
-- precision and range.
No_Trans : aliased constant Character := 'N';
Trans : aliased constant Character := 'T';
Conj_Trans : aliased constant Character := 'C';
-- BLAS Level 1 Subprograms and Types
function dot
(N : Positive;
X : Real_Vector;
Inc_X : Integer := 1;
Y : Real_Vector;
Inc_Y : Integer := 1) return Real;
function nrm2
(N : Natural;
X : Real_Vector;
Inc_X : Integer := 1) return Real;
procedure gemv
(Trans : access constant Character;
M : Natural := 0;
N : Natural := 0;
Alpha : Real := 1.0;
A : Real_Matrix;
Ld_A : Positive;
X : Real_Vector;
Inc_X : Integer := 1; -- must be non-zero
Beta : Real := 0.0;
Y : in out Real_Vector;
Inc_Y : Integer := 1); -- must be non-zero
-- BLAS Level 3
-- gemm s, d, c, z Matrix-matrix product of general matrices
procedure gemm
(Trans_A : access constant Character;
Trans_B : access constant Character;
M : Positive;
N : Positive;
K : Positive;
Alpha : Real := 1.0;
A : Real_Matrix;
Ld_A : Integer;
B : Real_Matrix;
Ld_B : Integer;
Beta : Real := 0.0;
C : in out Real_Matrix;
Ld_C : Integer);
end System.Generic_Real_BLAS;
gcc/ada/s-gerela.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- SYSTEM.GENERIC_REAL_LAPACK --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package comment required ???
generic
type Real is digits <>;
type Real_Vector is array (Integer range <>) of Real;
type Real_Matrix is array (Integer range <>, Integer range <>) of Real;
package System.Generic_Real_LAPACK is
pragma Pure;
type Integer_Vector is array (Integer range <>) of Integer;
Upper : aliased constant Character := 'U';
Lower : aliased constant Character := 'L';
-- LAPACK Computational Routines
-- gerfs Refines the solution of a system of linear equations with
-- a general matrix and estimates its error
-- getrf Computes LU factorization of a general m-by-n matrix
-- getri Computes inverse of an LU-factored general matrix
-- square matrix, with multiple right-hand sides
-- getrs Solves a system of linear equations with an LU-factored
-- square matrix, with multiple right-hand sides
-- orgtr Generates the Float orthogonal matrix Q determined by sytrd
-- steqr Computes all eigenvalues and eigenvectors of a symmetric or
-- Hermitian matrix reduced to tridiagonal form (QR algorithm)
-- sterf Computes all eigenvalues of a Float symmetric
-- tridiagonal matrix using QR algorithm
-- sytrd Reduces a Float symmetric matrix to tridiagonal form
procedure getrf
(M : Natural;
N : Natural;
A : in out Real_Matrix;
Ld_A : Positive;
I_Piv : out Integer_Vector;
Info : access Integer);
procedure getri
(N : Natural;
A : in out Real_Matrix;
Ld_A : Positive;
I_Piv : Integer_Vector;
Work : in out Real_Vector;
L_Work : Integer;
Info : access Integer);
procedure getrs
(Trans : access constant Character;
N : Natural;
N_Rhs : Natural;
A : Real_Matrix;
Ld_A : Positive;
I_Piv : Integer_Vector;
B : in out Real_Matrix;
Ld_B : Positive;
Info : access Integer);
procedure orgtr
(Uplo : access constant Character;
N : Natural;
A : in out Real_Matrix;
Ld_A : Positive;
Tau : in Real_Vector;
Work : out Real_Vector;
L_Work : Integer;
Info : access Integer);
procedure sterf
(N : Natural;
D : in out Real_Vector;
E : in out Real_Vector;
Info : access Integer);
procedure steqr
(Comp_Z : access constant Character;
N : Natural;
D : in out Real_Vector;
E : in out Real_Vector;
Z : in out Real_Matrix;
Ld_Z : Positive;
Work : out Real_Vector;
Info : access Integer);
procedure sytrd
(Uplo : access constant Character;
N : Natural;
A : in out Real_Matrix;
Ld_A : Positive;
D : out Real_Vector;
E : out Real_Vector;
Tau : out Real_Vector;
Work : out Real_Vector;
L_Work : Integer;
Info : access Integer);
end System.Generic_Real_LAPACK;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment