2010-10-11 Robert Dewar <dewar@adacore.com>

	* aspects.ads, aspects.adb: Major revision of this package for 2nd
	stage of aspects implementation.
	* gcc-interface/Make-lang.in: Add entry for aspects.o
	* gcc-interface/Makefile.in: Add aspects.o to GNATMAKE_OBJS
	* par-ch13.adb (Aspect_Specifications_Present): New function
	(P_Aspect_Specifications): New procedure
	* par-ch3.adb (P_Type_Declaration): Handle aspect specifications
	(P_Derived_Type_Def_Or_Private_Ext_Decl): Handle aspect specifications
	(P_Identifier_Declarations): Handle aspect specifications
	(P_Component_Items): Handle aspect specifications
	(P_Subtype_Declaration): Handle aspect specifications
	* par-ch6.adb (P_Subprogram): Handle aspect specifications
	* par-ch9.adb (P_Entry_Declaration): Handle aspect specifications
	* par.adb (Aspect_Specifications_Present): New function
	(P_Aspect_Specifications): New procedure
	* sem.adb (Analyze_Full_Type_Declaration): New name for
	Analyze_Type_Declaration.
	(Analyze_Formal_Package_Declaration): New name (add _Declaration)
	(Analyze_Formal_Subprogram_Declaration): New name (add _Declaration)
	(Analyze_Protected_Type_Declaration): New name (add _Declaration)
	(Analyze_Single_Protected_Declaration): New name (add _Declaration)
	(Analyze_Single_Task_Declaration): New name (add _Declaration)
	(Analyze_Task_Type_Declaration): New name (add _Declaration)
	* sem_cat.adb (Analyze_Full_Type_Declaration): New name for
	Analyze_Type_Declaration.
	* sem_ch11.adb (Analyze_Exception_Declaration): Analyze aspect
	specifications.
	* sem_ch12.adb (Analyze_Formal_Object_Declaration): Handle aspect
	specifications.
	(Analyze_Formal_Package_Declaration): New name (add _Declaration)
	(Analyze_Formal_Package_Declaration): Handle aspect specifications
	(Analyze_Formal_Subprogram_Declaration): New name (add _Declaration)
	(Analyze_Formal_Subprogram_Declaration): Handle aspect specifications
	(Analyze_Formal_Type_Declaration): Handle aspect specifications
	(Analyze_Generic_Package_Declaration): Handle aspect specifications
	(Analyze_Generic_Subprogram_Declaration): Handle aspect specifications
	(Analyze_Package_Instantiation): Handle aspect specifications
	(Analyze_Subprogram_Instantiation): Handle aspect specifications
	* sem_ch12.ads (Analyze_Formal_Package_Declaration): New name (add
	_Declaration).
	(Analyze_Formal_Subprogram_Declaration): New name (add _Declaration)
	* sem_ch13.adb (Analyze_Aspect_Specifications): New procedure
	(Duplicate_Clause): New function, calls to this function are added to
	processing for all aspects.
	* sem_ch13.ads (Analyze_Aspect_Specifications): New procedure
	* sem_ch3.adb (Analyze_Full_Type_Declaration): New name for
	Analyze_Type_Declaration.
	* sem_ch3.ads (Analyze_Full_Type_Declaration): New name for
	Analyze_Type_Declaration.
	* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Analyze aspect
	specifications.
	(Analyze_Subprogram_Declaration): Analyze aspect specifications
	* sem_ch7.adb (Analyze_Package_Declaration): Analyze aspect
	specifications.
	(Analyze_Private_Type_Declaration): Analyze aspect specifications
	* sem_ch9.adb (Analyze_Protected_Type_Declaration): Analyze aspect
	specifications.
	(Analyze_Protected_Type_Declaration): New name (add _Declaration)
	(Analyze_Single_Protected_Declaration): Analyze aspect specifications
	(Analyze_Single_Protected_Declaration): New name (add _Declaration)
	(Analyze_Single_Task_Declaration): Analyze aspect specifications
	(Analyze_Single_Task_Declaration): New name (add _Declaration)
	(Analyze_Task_Type_Declaration): Analyze aspect specifications
	(Analyze_Task_Type_Declaration): New name (add _Declaration)
	* sem_ch9.ads (Analyze_Protected_Type_Declaration): New name (add
	_Declaration).
	(Analyze_Single_Protected_Declaration): New name (add _Declaration)
	(Analyze_Single_Task_Declaration): New name (add _Declaration)
	(Analyze_Task_Type_Declaration): New name (add _Declaration)
	* sem_prag.adb: Use Get_Pragma_Arg systematically so that we do not
	have to generate unnecessary pragma argument associations (this matches
	the doc).
	Throughout do changes to accomodate aspect specifications, including
	specializing messages, handling the case of not going through all
	homonyms, and allowing for cancellation.
	* sinfo.ads, sinfo.adb: Clean up obsolete documentation for Flag1,2,3
	(Aspect_Cancel): New flag
	(From_Aspect_Specification): New flag
	(First_Aspect): Removed flag
	(Last_Aspect): Removed flag
	* sprint.adb (Sprint_Aspect_Specifications): New procedure
	(Sprint_Node_Actual): Add calls to Sprint_Aspect_Specifications

2010-10-11  Bob Duff  <duff@adacore.com>

	* sem_res.adb (Resolve_Actuals): Minor change to warning messages so
	they match in Ada 95, 2005, and 2012 modes, in the case where the
	language didn't change. Same thing for the run-time exception message.

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* debug.adb Document that switch -gnatd.p enables the CIL verifier.

2010-10-11  Robert Dewar  <dewar@adacore.com>

	* s-htable.adb: Minor reformatting.



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

1 files changed, 126 insertions, 14 deletions

diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index a0382e788f4..4b08632c57f 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -29,10 +29,43 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Atree;  use Atree;
+with Nlists; use Nlists;
+with Sinfo;  use Sinfo;
 with Snames; use Snames;
 
+with GNAT.HTable; use GNAT.HTable;
+
 package body Aspects is
 
+   ------------------------------------------
+   -- Hash Table for Aspect Specifications --
+   ------------------------------------------
+
+   type AS_Hash_Range is range 0 .. 510;
+   --  Size of hash table headers
+
+   function AS_Hash (F : Node_Id) return AS_Hash_Range;
+   --  Hash function for hash table
+
+   function AS_Hash (F : Node_Id) return AS_Hash_Range is
+   begin
+      return AS_Hash_Range (F mod 511);
+   end AS_Hash;
+
+   package Aspect_Specifications_Hash_Table is new
+     GNAT.HTable.Simple_HTable
+       (Header_Num => AS_Hash_Range,
+        Element    => List_Id,
+        No_Element => No_List,
+        Key        => Node_Id,
+        Hash       => AS_Hash,
+        Equal      => "=");
+
+   -----------------------------------------
+   -- Table Linking Names and Aspect_Id's --
+   -----------------------------------------
+
    type Aspect_Entry is record
       Nam : Name_Id;
       Asp : Aspect_Id;
@@ -42,12 +75,10 @@ package body Aspects is
      (Name_Ada_2005,                     Aspect_Ada_2005),
      (Name_Ada_2012,                     Aspect_Ada_2012),
      (Name_Address,                      Aspect_Address),
-     (Name_Aliased,                      Aspect_Aliased),
      (Name_Alignment,                    Aspect_Alignment),
      (Name_Atomic,                       Aspect_Atomic),
      (Name_Atomic_Components,            Aspect_Atomic_Components),
      (Name_Bit_Order,                    Aspect_Bit_Order),
-     (Name_C_Pass_By_Copy,               Aspect_C_Pass_By_Copy),
      (Name_Component_Size,               Aspect_Component_Size),
      (Name_Discard_Names,                Aspect_Discard_Names),
      (Name_External_Tag,                 Aspect_External_Tag),
@@ -60,12 +91,9 @@ package body Aspects is
      (Name_Pack,                         Aspect_Pack),
      (Name_Persistent_BSS,               Aspect_Persistent_BSS),
      (Name_Post,                         Aspect_Post),
-     (Name_Postcondition,                Aspect_Postcondition),
      (Name_Pre,                          Aspect_Pre),
-     (Name_Precondition,                 Aspect_Precondition),
      (Name_Predicate,                    Aspect_Predicate),
      (Name_Preelaborable_Initialization, Aspect_Preelaborable_Initialization),
-     (Name_Psect_Object,                 Aspect_Psect_Object),
      (Name_Pure_Function,                Aspect_Pure_Function),
      (Name_Shared,                       Aspect_Shared),
      (Name_Size,                         Aspect_Size),
@@ -83,8 +111,31 @@ package body Aspects is
      (Name_Value_Size,                   Aspect_Value_Size),
      (Name_Volatile,                     Aspect_Volatile),
      (Name_Volatile_Components,          Aspect_Volatile_Components),
-     (Name_Warnings,                     Aspect_Warnings),
-     (Name_Weak_External,                Aspect_Weak_External));
+     (Name_Warnings,                     Aspect_Warnings));
+
+   -------------------------------------
+   -- Hash Table for Aspect Id Values --
+   -------------------------------------
+
+   type AI_Hash_Range is range 0 .. 112;
+   --  Size of hash table headers
+
+   function AI_Hash (F : Name_Id) return AI_Hash_Range;
+   --  Hash function for hash table
+
+   function AI_Hash (F : Name_Id) return AI_Hash_Range is
+   begin
+      return AI_Hash_Range (F mod 113);
+   end AI_Hash;
+
+   package Aspect_Id_Hash_Table is new
+     GNAT.HTable.Simple_HTable
+       (Header_Num => AI_Hash_Range,
+        Element    => Aspect_Id,
+        No_Element => No_Aspect,
+        Key        => Name_Id,
+        Hash       => AI_Hash,
+        Equal      => "=");
 
    -------------------
    -- Get_Aspect_Id --
@@ -92,13 +143,74 @@ package body Aspects is
 
    function Get_Aspect_Id (Name : Name_Id) return Aspect_Id is
    begin
-      for J in Aspect_Names'Range loop
-         if Aspect_Names (J).Nam = Name then
-            return Aspect_Names (J).Asp;
-         end if;
-      end loop;
-
-      return No_Aspect;
+      return Aspect_Id_Hash_Table.Get (Name);
    end Get_Aspect_Id;
 
+   ---------------------------
+   -- Aspect_Specifications --
+   ---------------------------
+
+   function Aspect_Specifications (N : Node_Id) return List_Id is
+   begin
+      return Aspect_Specifications_Hash_Table.Get (N);
+   end Aspect_Specifications;
+
+   -----------------------------------
+   -- Permits_Aspect_Specifications --
+   -----------------------------------
+
+   Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
+     (N_Abstract_Subprogram_Declaration        => True,
+      N_Component_Declaration                  => True,
+      N_Entry_Declaration                      => True,
+      N_Exception_Declaration                  => True,
+      N_Formal_Abstract_Subprogram_Declaration => True,
+      N_Formal_Concrete_Subprogram_Declaration => True,
+      N_Formal_Object_Declaration              => True,
+      N_Formal_Package_Declaration             => True,
+      N_Formal_Type_Declaration                => True,
+      N_Full_Type_Declaration                  => True,
+      N_Function_Instantiation                 => True,
+      N_Generic_Package_Declaration            => True,
+      N_Generic_Subprogram_Declaration         => True,
+      N_Object_Declaration                     => True,
+      N_Package_Declaration                    => True,
+      N_Package_Instantiation                  => True,
+      N_Private_Extension_Declaration          => True,
+      N_Private_Type_Declaration               => True,
+      N_Procedure_Instantiation                => True,
+      N_Protected_Type_Declaration             => True,
+      N_Single_Protected_Declaration           => True,
+      N_Single_Task_Declaration                => True,
+      N_Subprogram_Declaration                 => True,
+      N_Subtype_Declaration                    => True,
+      N_Task_Type_Declaration                  => True,
+      others                                   => False);
+
+   function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
+   begin
+      return Has_Aspect_Specifications_Flag (Nkind (N));
+   end Permits_Aspect_Specifications;
+
+   -------------------------------
+   -- Set_Aspect_Specifications --
+   -------------------------------
+
+   procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
+   begin
+      pragma Assert (Permits_Aspect_Specifications (N));
+      pragma Assert (not Has_Aspect_Specifications (N));
+      pragma Assert (L /= No_List);
+
+      Set_Has_Aspect_Specifications (N);
+      Set_Parent (L, N);
+      Aspect_Specifications_Hash_Table.Set (N, L);
+   end Set_Aspect_Specifications;
+
+--  Package initialization sets up Aspect Id hash table
+
+begin
+   for J in Aspect_Names'Range loop
+      Aspect_Id_Hash_Table.Set (Aspect_Names (J).Nam, Aspect_Names (J).Asp);
+   end loop;
 end Aspects;