Commit a51cd0ec by Arnaud Charlet

[multiple changes]

2011-11-04  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Warn_On_Useless_Assignment): More accurate test
	for call vs assign.
	* gcc-interface/Make-lang.in: Update dependencies.

2011-11-04  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb: Detect more cases of Long_Float inconsistencies at
	compile time.

2011-11-04  Matthew Heaney  <heaney@adacore.com>

	* Makefile.rtl, impunit.adb: Added a-sfecin.ads,
	* a-sfhcin.ads, a-sflcin.ads, a-sbecin.ad[sb], a-sbhcin.ad[sb],
	a-sblcin.ad[sb], a-suecin.ad[sb], a-suhcin.ad[sb], a-sulcin.ad[sb]
	* a-sfecin.ads, a-sfhcin.ads, a-sflcin.ads, a-sbecin.ad[sb],
	a-sbhcin.ad[sb], a-sblcin.ad[sb], a-suecin.ad[sb], a-suhcin.ad[sb],
	a-sulcin.ad[sb]: New files.

2011-11-04  Geert Bosch  <bosch@adacore.com>

	* i-forbla-unimplemented.ads, s-gecola.adb, s-gecola.ads,
	s-gerebl.adb, s-gerebl.ads, i-forbla.adb, i-forbla.ads,
	i-forlap.ads, i-forbla-darwin.adb, s-gecobl.adb, s-gecobl.ads,
	s-gerela.adb, s-gerela.ads: Remove partial interface to BLAS/LAPACK.
	* gcc-interface/Makefile.in: Remove libgnala and related objects.

From-SVN: r180935
parent 635c6321
2011-11-04 Eric Botcazou <ebotcazou@adacore.com>
2011-11-04 Robert Dewar <dewar@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Function>: Do not assert
that the type of the parameters isn't dummy in type_annotate_only mode.
* sem_warn.adb (Warn_On_Useless_Assignment): More accurate test
for call vs assign.
* gcc-interface/Make-lang.in: Update dependencies.
2011-11-04 Robert Dewar <dewar@adacore.com>
* sem_prag.adb: Detect more cases of Long_Float inconsistencies at
compile time.
2011-11-04 Matthew Heaney <heaney@adacore.com>
* Makefile.rtl, impunit.adb: Added a-sfecin.ads,
* a-sfhcin.ads, a-sflcin.ads, a-sbecin.ad[sb], a-sbhcin.ad[sb],
a-sblcin.ad[sb], a-suecin.ad[sb], a-suhcin.ad[sb], a-sulcin.ad[sb]
* a-sfecin.ads, a-sfhcin.ads, a-sflcin.ads, a-sbecin.ad[sb],
a-sbhcin.ad[sb], a-sblcin.ad[sb], a-suecin.ad[sb], a-suhcin.ad[sb],
a-sulcin.ad[sb]: New files.
2011-11-04 Geert Bosch <bosch@adacore.com>
* i-forbla-unimplemented.ads, s-gecola.adb, s-gecola.ads,
s-gerebl.adb, s-gerebl.ads, i-forbla.adb, i-forbla.ads,
i-forlap.ads, i-forbla-darwin.adb, s-gecobl.adb, s-gecobl.ads,
s-gerela.adb, s-gerela.ads: Remove partial interface to BLAS/LAPACK.
* gcc-interface/Makefile.in: Remove libgnala and related objects.
2011-11-04 Matthew Heaney <heaney@adacore.com>
......@@ -11,6 +34,11 @@
a-convec.ad[sb], a-coinve.ad[sb] (Assign, Copy): New operations
added to package.
2011-11-04 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Function>: Do not assert
that the type of the parameters isn't dummy in type_annotate_only mode.
2011-11-04 Robert Dewar <dewar@adacore.com>
* sem_ch12.adb: Minor reformatting
......
......@@ -214,9 +214,15 @@ GNATRTL_NONTASKING_OBJS= \
a-rbtgbo$(objext) \
a-rbtgbk$(objext) \
a-rbtgso$(objext) \
a-sbecin$(objext) \
a-sbhcin$(objext) \
a-sblcin$(objext) \
a-scteio$(objext) \
a-secain$(objext) \
a-sequio$(objext) \
a-sfecin$(objext) \
a-sfhcin$(objext) \
a-sflcin$(objext) \
a-sfteio$(objext) \
a-sfwtio$(objext) \
a-sfztio$(objext) \
......@@ -261,10 +267,13 @@ GNATRTL_NONTASKING_OBJS= \
a-stzsea$(objext) \
a-stzsup$(objext) \
a-stzunb$(objext) \
a-suecin$(objext) \
a-suenco$(objext) \
a-suenst$(objext) \
a-suewst$(objext) \
a-suezst$(objext) \
a-suhcin$(objext) \
a-sulcin$(objext) \
a-suteio$(objext) \
a-swbwha$(objext) \
a-swfwha$(objext) \
......
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.BOUNDED.EQUAL_CASE_INSENSITIVE --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- ware Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Equal_Case_Insensitive;
function Ada.Strings.Bounded.Equal_Case_Insensitive
(Left, Right : Bounded.Bounded_String)
return Boolean
is
begin
return Ada.Strings.Equal_Case_Insensitive
(Left => Bounded.To_String (Left),
Right => Bounded.To_String (Right));
end Ada.Strings.Bounded.Equal_Case_Insensitive;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.BOUNDED.EQUAL_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
generic
with package Bounded is
new Ada.Strings.Bounded.Generic_Bounded_Length (<>);
function Ada.Strings.Bounded.Equal_Case_Insensitive
(Left, Right : Bounded.Bounded_String)
return Boolean;
pragma Preelaborate (Ada.Strings.Bounded.Equal_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.BOUNDED.HASH_CASE_INSENSITIVE --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- ware Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Hash_Case_Insensitive;
function Ada.Strings.Bounded.Hash_Case_Insensitive
(Key : Bounded.Bounded_String)
return Containers.Hash_Type
is
begin
return Ada.Strings.Hash_Case_Insensitive (Bounded.To_String (Key));
end Ada.Strings.Bounded.Hash_Case_Insensitive;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.BOUNDED.HASH_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Containers;
generic
with package Bounded is
new Ada.Strings.Bounded.Generic_Bounded_Length (<>);
function Ada.Strings.Bounded.Hash_Case_Insensitive
(Key : Bounded.Bounded_String)
return Containers.Hash_Type;
pragma Preelaborate (Ada.Strings.Bounded.Hash_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.BOUNDED.LESS_CASE_INSENSITIVE --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- ware Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Less_Case_Insensitive;
function Ada.Strings.Bounded.Less_Case_Insensitive
(Left, Right : Bounded.Bounded_String)
return Boolean
is
begin
return Ada.Strings.Less_Case_Insensitive
(Left => Bounded.To_String (Left),
Right => Bounded.To_String (Right));
end Ada.Strings.Bounded.Less_Case_Insensitive;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.BOUNDED.LESS_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
generic
with package Bounded is
new Ada.Strings.Bounded.Generic_Bounded_Length (<>);
function Ada.Strings.Bounded.Less_Case_Insensitive
(Left, Right : Bounded.Bounded_String)
return Boolean;
pragma Preelaborate (Ada.Strings.Bounded.Less_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.FIXED.EQUAL_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Equal_Case_Insensitive;
function Ada.Strings.Fixed.Equal_Case_Insensitive
(Left, Right : String)
return Boolean renames Ada.Strings.Equal_Case_Insensitive;
pragma Pure (Ada.Strings.Fixed.Equal_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.FIXED.HASH_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Containers;
with Ada.Strings.Hash_Case_Insensitive;
function Ada.Strings.Fixed.Hash_Case_Insensitive
(Key : String)
return Containers.Hash_Type renames Ada.Strings.Hash_Case_Insensitive;
pragma Pure (Ada.Strings.Fixed.Hash_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- GNAT LIBRARY COMPONENTS --
-- --
-- I N T E R F A C E S . F O R T R A N . B L A S --
-- ADA.STRINGS.FIXED.LESS_CASE_INSENSITIVE --
-- --
-- B o d y --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2011, 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- --
......@@ -24,19 +28,13 @@
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-- This Interfaces.Fortran.Blas package body contains the required linker
-- pragmas for automatically linking with the LAPACK linear algebra support
-- library, and the systems math library. Alternative bodies can be supplied
-- if different sets of libraries are needed.
with Ada.Strings.Less_Case_Insensitive;
function Ada.Strings.Fixed.Less_Case_Insensitive
(Left, Right : String)
return Boolean renames Ada.Strings.Less_Case_Insensitive;
package body Interfaces.Fortran.BLAS is
pragma Linker_Options ("-lgnala");
pragma Linker_Options ("-llapack");
pragma Linker_Options ("-lblas");
pragma Linker_Options ("-lm");
end Interfaces.Fortran.BLAS;
pragma Pure (Ada.Strings.Fixed.Less_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.UNBOUNDED.EQUAL_CASE_INSENSITIVE --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- ware Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded.Aux;
with Ada.Strings.Equal_Case_Insensitive;
function Ada.Strings.Unbounded.Equal_Case_Insensitive
(Left, Right : Unbounded.Unbounded_String)
return Boolean
is
SL, SR : Aux.Big_String_Access;
LL, LR : Natural;
begin
Aux.Get_String (Left, SL, LL);
Aux.Get_String (Right, SR, LR);
return Ada.Strings.Equal_Case_Insensitive
(Left => SL (1 .. LL),
Right => SR (1 .. LR));
end Ada.Strings.Unbounded.Equal_Case_Insensitive;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- GNAT LIBRARY COMPONENTS --
-- --
-- I N T E R F A C E S . F O R T R A N . B L A S --
-- ADA.STRINGS.UNBOUNDED.EQUAL_CASE_INSENSITIVE --
-- --
-- B o d y --
-- S p e c --
-- --
-- Copyright (C) 2006-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2011, 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- --
......@@ -24,15 +28,11 @@
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-- Version for Mac OS X
function Ada.Strings.Unbounded.Equal_Case_Insensitive
(Left, Right : Unbounded.Unbounded_String)
return Boolean;
package body Interfaces.Fortran.BLAS is
pragma Linker_Options ("-lgnala");
pragma Linker_Options ("-lm");
pragma Linker_Options ("-Wl,-framework,vecLib");
end Interfaces.Fortran.BLAS;
pragma Preelaborate (Ada.Strings.Unbounded.Equal_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.UNBOUNDED.HASH_CASE_INSENSITIVE --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- ware Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded.Aux;
with Ada.Strings.Hash_Case_Insensitive;
function Ada.Strings.Unbounded.Hash_Case_Insensitive
(Key : Unbounded.Unbounded_String)
return Containers.Hash_Type
is
S : Aux.Big_String_Access;
L : Natural;
begin
Aux.Get_String (Key, S, L);
return Ada.Strings.Hash_Case_Insensitive (S (1 .. L));
end Ada.Strings.Unbounded.Hash_Case_Insensitive;
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.UNBOUNDED.HASH_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Containers;
function Ada.Strings.Unbounded.Hash_Case_Insensitive
(Key : Unbounded.Unbounded_String)
return Containers.Hash_Type;
pragma Preelaborate (Ada.Strings.Unbounded.Hash_Case_Insensitive);
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.STRINGS.UNBOUNDED.LESS_CASE_INSENSITIVE --
-- --
-- B o d y --
-- --
-- Copyright (C) 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- --
-- ware Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded.Aux;
with Ada.Strings.Less_Case_Insensitive;
function Ada.Strings.Unbounded.Less_Case_Insensitive
(Left, Right : Unbounded.Unbounded_String)
return Boolean
is
SL, SR : Aux.Big_String_Access;
LL, LR : Natural;
begin
Aux.Get_String (Left, SL, LL);
Aux.Get_String (Right, SR, LR);
return Ada.Strings.Less_Case_Insensitive
(Left => SL (1 .. LL),
Right => SR (1 .. LR));
end Ada.Strings.Unbounded.Less_Case_Insensitive;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- GNAT LIBRARY COMPONENTS --
-- --
-- I N T E R F A C E S . F O R T R A N . B L A S --
-- ADA.STRINGS.UNBOUNDED.LESS_CASE_INSENSITIVE --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2011, 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- --
......@@ -24,22 +28,11 @@
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
-- This package provides a thin binding to the standard Fortran BLAS library.
-- Documentation and a reference BLAS implementation is available from
-- ftp://ftp.netlib.org. The main purpose of this package is to facilitate
-- implementation of the Ada 2005 Ada.Numerics.Generic_Real_Arrays and
-- Ada.Numerics.Generic_Complex_Arrays packages. Bindings to other BLAS
-- routines may be added over time.
-- This unit is not implemented in this GNAT configuration
package Interfaces.Fortran.BLAS is
pragma Unimplemented_Unit;
function Ada.Strings.Unbounded.Less_Case_Insensitive
(Left, Right : Unbounded.Unbounded_String)
return Boolean;
end Interfaces.Fortran.BLAS;
pragma Preelaborate (Ada.Strings.Unbounded.Less_Case_Insensitive);
......@@ -1953,32 +1953,35 @@ ada/exp_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/exp_ch2.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads \
ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
ada/elists.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
ada/erroutc.ads ada/erroutc.adb ada/exp_ch2.ads ada/exp_ch2.adb \
ada/exp_code.ads ada/exp_smem.ads ada/exp_tss.ads ada/exp_util.ads \
ada/exp_vfpt.ads ada/expander.ads ada/fname.ads ada/gnat.ads \
ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
ada/inline.ads ada/interfac.ads ada/lib.ads ada/lib-load.ads \
ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
ada/nmake.adb ada/opt.ads ada/output.ads ada/par_sco.ads ada/rident.ads \
ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads \
ada/sem_aux.ads ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads \
ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads \
ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads \
ada/sem_ch9.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sem_warn.adb ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/sinput.adb ada/snames.ads \
ada/stand.ads ada/stringt.ads ada/stylesw.ads ada/system.ads \
ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/uname.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/widechar.ads
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
ada/elists.ads ada/elists.adb ada/err_vars.ads ada/errout.ads \
ada/errout.adb ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads \
ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch2.adb ada/exp_ch4.ads \
ada/exp_code.ads ada/exp_pakd.ads ada/exp_smem.ads ada/exp_tss.ads \
ada/exp_util.ads ada/exp_vfpt.ads ada/expander.ads ada/fname.ads \
ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-htable.ads \
ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads ada/inline.ads \
ada/interfac.ads ada/lib.ads ada/lib-load.ads ada/namet.ads \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/opt.ads ada/output.ads ada/par_sco.ads ada/restrict.ads \
ada/rident.ads ada/rtsfind.ads ada/scans.ads ada/sem.ads ada/sem.adb \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch10.ads ada/sem_ch11.ads \
ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads \
ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads \
ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_eval.ads ada/sem_prag.ads \
ada/sem_res.ads ada/sem_util.ads ada/sem_warn.ads ada/sem_warn.adb \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
ada/snames.ads ada/sprint.ads ada/stand.ads ada/stringt.ads \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tree_io.ads \
ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/validsw.ads \
ada/widechar.ads
ada/exp_ch3.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
......
......@@ -2116,7 +2116,6 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
SO_OPTS = -shared-libgcc
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-darwin.ads \
i-forbla.adb<i-forbla-darwin.adb \
s-inmaop.adb<s-inmaop-posix.adb \
s-osinte.adb<s-osinte-darwin.adb \
s-osinte.ads<s-osinte-darwin.ads \
......@@ -2238,10 +2237,8 @@ LIBGNAT_OBJS = adadecode.o adaint.o argv.o cio.o cstreams.o ctrl_c.o \
include $(fsrcdir)/ada/Makefile.rtl
GNATRTL_LINEARALGEBRA_OBJS = i-forbla.o i-forlap.o
GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS) $(GNATRTL_TASKING_OBJS) \
$(GNATRTL_LINEARALGEBRA_OBJS) memtrack.o
memtrack.o
# Default run time files
......@@ -2538,9 +2535,6 @@ gnatlib: ../stamp-gnatlib1-$(RTSDIR) ../stamp-gnatlib2-$(RTSDIR)
$(AR_FOR_TARGET) $(AR_FLAGS) $(RTSDIR)/libgnarl$(arext) \
$(addprefix $(RTSDIR)/,$(GNATRTL_TASKING_OBJS))
$(RANLIB_FOR_TARGET) $(RTSDIR)/libgnarl$(arext)
$(AR_FOR_TARGET) $(AR_FLAGS) $(RTSDIR)/libgnala$(arext) \
$(addprefix $(RTSDIR)/,$(GNATRTL_LINEARALGEBRA_OBJS))
$(RANLIB_FOR_TARGET) $(RTSDIR)/libgnala$(arext)
ifeq ($(GMEM_LIB),gmemlib)
$(AR_FOR_TARGET) $(AR_FLAGS) $(RTSDIR)/libgmem$(arext) \
$(RTSDIR)/memtrack.o
......
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- I N T E R F A C E S . F O R T R A N . B L A S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides a thin binding to the standard Fortran BLAS library.
-- Documentation and a reference BLAS implementation is available from
-- ftp://ftp.netlib.org. The main purpose of this package is to facilitate
-- implementation of the Ada 2005 Ada.Numerics.Generic_Real_Arrays and
-- Ada.Numerics.Generic_Complex_Arrays packages. Bindings to other BLAS
-- routines may be added over time.
-- As actual linker arguments to link with the BLAS implementation differs
-- according to platform and chosen BLAS implementation, the linker arguments
-- are given in the body of this package. The body may need to be modified in
-- order to link with different BLAS implementations tuned to the specific
-- target.
package Interfaces.Fortran.BLAS is
pragma Pure;
pragma Elaborate_Body;
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 cdotu
(N : Positive;
X : Complex_Vector;
Inc_X : Integer := 1;
Y : Complex_Vector;
Inc_Y : Integer := 1) return Complex;
function zdotu
(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, cdotu, "cdotu_");
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, zdotu, "zdotu_");
pragma Import (Fortran, zgemm, "zgemm_");
pragma Import (Fortran, zgemv, "zgemv_");
end Interfaces.Fortran.BLAS;
......@@ -487,9 +487,6 @@ package body Impunit is
("a-ciormu", F), -- Ada.Containers.Indefinite_Ordered_Multisets
("a-coormu", F), -- Ada.Containers.Ordered_Multisets
("a-crdlli", F), -- Ada.Containers.Restricted_Doubly_Linked_Lists
("a-secain", F), -- Ada.Strings.Equal_Case_Insensitive
("a-shcain", F), -- Ada.Strings.Hash_Case_Insensitive
("a-slcain", F), -- Ada.Strings.Less_Case_Insensitive
("a-szuzti", F), -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO
("a-zchuni", F), -- Ada.Wide_Wide_Characters.Unicode
("a-ztcstr", F), -- Ada.Wide_Wide_Text_IO.C_Streams
......@@ -497,6 +494,18 @@ package body Impunit is
-- Note: strictly the following should be Ada 2012 units, but it seems
-- harmless (and useful) to make then available in Ada 2005 mode.
("a-secain", T), -- Ada.Strings.Equal_Case_Insensitive
("a-shcain", T), -- Ada.Strings.Hash_Case_Insensitive
("a-slcain", T), -- Ada.Strings.Less_Case_Insensitive
("a-sfecin", T), -- Ada.Strings.Fixed.Equal_Case_Insensitive
("a-sfhcin", T), -- Ada.Strings.Fixed.Hash_Case_Insensitive
("a-sflcin", T), -- Ada.Strings.Fixed.Less_Case_Insensitive
("a-sbecin", T), -- Ada.Strings.Bounded.Equal_Case_Insensitive
("a-sbhcin", T), -- Ada.Strings.Bounded.Hash_Case_Insensitive
("a-sblcin", T), -- Ada.Strings.Bounded.Less_Case_Insensitive
("a-suecin", T), -- Ada.Strings.Unbounded.Equal_Case_Insensitive
("a-suhcin", T), -- Ada.Strings.Unbounded.Hash_Case_Insensitive
("a-sulcin", T), -- Ada.Strings.Unbounded.Less_Case_Insensitive
("a-suezst", T), -- Ada.Strings.UTF_Encoding.Wide_Wide_Strings
---------------------------
......
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . G E N E R I C _ C O M P L E X _ B L A S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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, 0.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, 0.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;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . G E N E R I C _ C O M P L E X _ L A P A C K --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- SYSTEM.GENERIC_REAL_BLAS --
-- --
-- S p e c --
-- --
-- Copyright (C) 2009, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . G E N E R I C _ R E A L _ L A P A C K --
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2009, 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- 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 : 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;
......@@ -10952,7 +10952,8 @@ package body Sem_Prag is
-- pragma Long_Float (D_Float | G_Float);
when Pragma_Long_Float =>
when Pragma_Long_Float => Long_Float : declare
begin
GNAT_Pragma;
Check_Valid_Configuration_Pragma;
Check_Arg_Count (1);
......@@ -10967,22 +10968,42 @@ package body Sem_Prag is
if Chars (Get_Pragma_Arg (Arg1)) = Name_D_Float then
if Opt.Float_Format_Long = 'G' then
Error_Pragma ("G_Float previously specified");
end if;
Error_Pragma_Arg
("G_Float previously specified", Arg1);
elsif Current_Sem_Unit /= Main_Unit
and then Opt.Float_Format_Long /= 'D'
then
Error_Pragma_Arg
("main unit not compiled with pragma Long_Float (D_Float)",
"\pragma% must be used consistently for whole partition",
Arg1);
Opt.Float_Format_Long := 'D';
else
Opt.Float_Format_Long := 'D';
end if;
-- G_Float case (this is the default, does not need overriding)
else
if Opt.Float_Format_Long = 'D' then
Error_Pragma ("D_Float previously specified");
end if;
Opt.Float_Format_Long := 'G';
elsif Current_Sem_Unit /= Main_Unit
and then Opt.Float_Format_Long /= 'G'
then
Error_Pragma_Arg
("main unit not compiled with pragma Long_Float (G_Float)",
"\pragma% must be used consistently for whole partition",
Arg1);
else
Opt.Float_Format_Long := 'G';
end if;
end if;
Set_Standard_Fpt_Formats;
end Long_Float;
-----------------------
-- Machine_Attribute --
......
......@@ -3993,39 +3993,59 @@ package body Sem_Warn is
-- Case of assigned value never referenced
if No (N) then
declare
LA : constant Node_Id := Last_Assignment (Ent);
-- Don't give this for OUT and IN OUT formals, since
-- clearly caller may reference the assigned value. Also
-- never give such warnings for internal variables.
begin
-- Don't give this for OUT and IN OUT formals, since
-- clearly caller may reference the assigned value. Also
-- never give such warnings for internal variables.
if Ekind (Ent) = E_Variable
and then not Is_Internal_Name (Chars (Ent))
then
if Referenced_As_Out_Parameter (Ent) then
Error_Msg_NE
("?& modified by call, but value never referenced",
Last_Assignment (Ent), Ent);
else
Error_Msg_NE -- CODEFIX
("?useless assignment to&, value never referenced!",
Last_Assignment (Ent), Ent);
if Ekind (Ent) = E_Variable
and then not Is_Internal_Name (Chars (Ent))
then
-- Give appropriate message, distinguishing between
-- assignment statements and out parameters.
if Nkind_In (Parent (LA), N_Procedure_Call_Statement,
N_Parameter_Association)
then
Error_Msg_NE
("?& modified by call, but value never "
& "referenced", LA, Ent);
else
Error_Msg_NE -- CODEFIX
("?useless assignment to&, value never "
& "referenced!", LA, Ent);
end if;
end if;
end if;
end;
-- Case of assigned value overwritten
else
Error_Msg_Sloc := Sloc (N);
declare
LA : constant Node_Id := Last_Assignment (Ent);
if Referenced_As_Out_Parameter (Ent) then
Error_Msg_NE
("?& modified by call, but value overwritten #!",
Last_Assignment (Ent), Ent);
else
Error_Msg_NE -- CODEFIX
("?useless assignment to&, value overwritten #!",
Last_Assignment (Ent), Ent);
end if;
begin
Error_Msg_Sloc := Sloc (N);
-- Give appropriate message, distinguishing between
-- assignment statements and out parameters.
if Nkind_In (Parent (LA), N_Procedure_Call_Statement,
N_Parameter_Association)
then
Error_Msg_NE
("?& modified by call, but value overwritten #!",
LA, Ent);
else
Error_Msg_NE -- CODEFIX
("?useless assignment to&, value overwritten #!",
LA, Ent);
end if;
end;
end if;
-- Clear last assignment indication and we are done
......
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