obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 990 insertions, 0 deletions

diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb
new file mode 100644
index 000000000..6fb2c0a3e
--- /dev/null
+++ b/gcc/ada/prj-attr.adb
@@ -0,0 +1,990 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             P R J . A T T R                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2001-2010, 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.  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 COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Osint;
+with Prj.Com; use Prj.Com;
+
+with GNAT.Case_Util; use GNAT.Case_Util;
+
+package body Prj.Attr is
+
+   use GNAT;
+
+   --  Data for predefined attributes and packages
+
+   --  Names are in lower case and end with '#'
+
+   --  Package names are preceded by 'P'
+
+   --  Attribute names are preceded by two or three letters:
+
+   --  The first letter is one of
+   --    'S' for Single
+   --    's' for Single with optional index
+   --    'L' for List
+   --    'l' for List of strings with optional indexes
+
+   --  The second letter is one of
+   --    'V' for single variable
+   --    'A' for associative array
+   --    'a' for case insensitive associative array
+   --    'b' for associative array, case insensitive if file names are case
+   --        insensitive
+   --    'c' same as 'b', with optional index
+
+   --  The third optional letter is
+   --     'R' to indicate that the attribute is read-only
+   --     'O' to indicate that others is allowed as an index for an associative
+   --     array
+
+   --  End is indicated by two consecutive '#'
+
+   Initialization_Data : constant String :=
+
+   --  project level attributes
+
+   --  General
+
+   "SVRname#" &
+   "SVRproject_dir#" &
+   "lVmain#" &
+   "LVlanguages#" &
+   "Lbroots#" &
+   "SVexternally_built#" &
+
+   --  Directories
+
+   "SVobject_dir#" &
+   "SVexec_dir#" &
+   "LVsource_dirs#" &
+   "Lainherit_source_path#" &
+   "LVexcluded_source_dirs#" &
+   "LVignore_source_sub_dirs#" &
+
+   --  Source files
+
+   "LVsource_files#" &
+   "LVlocally_removed_files#" &
+   "LVexcluded_source_files#" &
+   "SVsource_list_file#" &
+   "SVexcluded_source_list_file#" &
+   "LVinterfaces#" &
+
+   --  Projects (in aggregate projects)
+
+   "LVproject_files#" &
+   "LVproject_path#" &
+   "SAexternal#" &
+
+   --  Libraries
+
+   "SVlibrary_dir#" &
+   "SVlibrary_name#" &
+   "SVlibrary_kind#" &
+   "SVlibrary_version#" &
+   "LVlibrary_interface#" &
+   "SVlibrary_auto_init#" &
+   "LVleading_library_options#" &
+   "LVlibrary_options#" &
+   "SVlibrary_src_dir#" &
+   "SVlibrary_ali_dir#" &
+   "SVlibrary_gcc#" &
+   "SVlibrary_symbol_file#" &
+   "SVlibrary_symbol_policy#" &
+   "SVlibrary_reference_symbol_file#" &
+
+   --  Configuration - General
+
+   "SVdefault_language#" &
+   "LVrun_path_option#" &
+   "SVrun_path_origin#" &
+   "SVseparate_run_path_options#" &
+   "Satoolchain_version#" &
+   "Satoolchain_description#" &
+   "Saobject_generated#" &
+   "Saobjects_linked#" &
+   "SVtarget#" &
+
+   --  Configuration - Libraries
+
+   "SVlibrary_builder#" &
+   "SVlibrary_support#" &
+
+   --  Configuration - Archives
+
+   "LVarchive_builder#" &
+   "LVarchive_builder_append_option#" &
+   "LVarchive_indexer#" &
+   "SVarchive_suffix#" &
+   "LVlibrary_partial_linker#" &
+
+   --  Configuration - Shared libraries
+
+   "SVshared_library_prefix#" &
+   "SVshared_library_suffix#" &
+   "SVsymbolic_link_supported#" &
+   "SVlibrary_major_minor_id_supported#" &
+   "SVlibrary_auto_init_supported#" &
+   "LVshared_library_minimum_switches#" &
+   "LVlibrary_version_switches#" &
+   "SVlibrary_install_name_option#" &
+   "Saruntime_library_dir#" &
+   "Saruntime_source_dir#" &
+
+   --  package Naming
+   --  Some attributes are obsolescent, and renamed in the tree (see
+   --  Prj.Dect.Rename_Obsolescent_Attributes).
+
+   "Pnaming#" &
+   "Saspecification_suffix#" &  --  Always renamed to "spec_suffix" in tree
+   "Saspec_suffix#" &
+   "Saimplementation_suffix#" & --  Always renamed to "body_suffix" in tree
+   "Sabody_suffix#" &
+   "SVseparate_suffix#" &
+   "SVcasing#" &
+   "SVdot_replacement#" &
+   "sAspecification#" &  --  Always renamed to "spec" in project tree
+   "sAspec#" &
+   "sAimplementation#" & --  Always renamed to "body" in project tree
+   "sAbody#" &
+   "Laspecification_exceptions#" &
+   "Laimplementation_exceptions#" &
+
+   --  package Compiler
+
+   "Pcompiler#" &
+   "Ladefault_switches#" &
+   "LcOswitches#" &
+   "SVlocal_configuration_pragmas#" &
+   "Salocal_config_file#" &
+
+   --  Configuration - Compiling
+
+   "Sadriver#" &
+   "Larequired_switches#" &
+   "Laleading_required_switches#" &
+   "Latrailing_required_switches#" &
+   "Lapic_option#" &
+   "Sapath_syntax#" &
+   "Saobject_file_suffix#" &
+   "Laobject_file_switches#" &
+   "Lamulti_unit_switches#" &
+   "Samulti_unit_object_separator#" &
+
+   --  Configuration - Mapping files
+
+   "Lamapping_file_switches#" &
+   "Samapping_spec_suffix#" &
+   "Samapping_body_suffix#" &
+
+   --  Configuration - Config files
+
+   "Laconfig_file_switches#" &
+   "Saconfig_body_file_name#" &
+   "Saconfig_body_file_name_index#" &
+   "Saconfig_body_file_name_pattern#" &
+   "Saconfig_spec_file_name#" &
+   "Saconfig_spec_file_name_index#" &
+   "Saconfig_spec_file_name_pattern#" &
+   "Saconfig_file_unique#" &
+
+   --  Configuration - Dependencies
+
+   "Ladependency_switches#" &
+   "Ladependency_driver#" &
+
+   --  Configuration - Search paths
+
+   "Lainclude_switches#" &
+   "Sainclude_path#" &
+   "Sainclude_path_file#" &
+
+   --  package Builder
+
+   "Pbuilder#" &
+   "Ladefault_switches#" &
+   "LcOswitches#" &
+   "Lcglobal_compilation_switches#" &
+   "Scexecutable#" &
+   "SVexecutable_suffix#" &
+   "SVglobal_configuration_pragmas#" &
+   "Saglobal_config_file#" &
+
+   --  package gnatls
+
+   "Pgnatls#" &
+   "LVswitches#" &
+
+   --  package Binder
+
+   "Pbinder#" &
+   "Ladefault_switches#" &
+   "LcOswitches#" &
+
+   --  Configuration - Binding
+
+   "Sadriver#" &
+   "Larequired_switches#" &
+   "Saprefix#" &
+   "Saobjects_path#" &
+   "Saobjects_path_file#" &
+
+   --  package Linker
+
+   "Plinker#" &
+   "LVrequired_switches#" &
+   "Ladefault_switches#" &
+   "LcOleading_switches#" &
+   "LcOswitches#" &
+   "LVlinker_options#" &
+   "SVmap_file_option#" &
+
+   --  Configuration - Linking
+
+   "SVdriver#" &
+   "LVexecutable_switch#" &
+   "SVlib_dir_switch#" &
+   "SVlib_name_switch#" &
+
+   --  Configuration - Response files
+
+   "SVmax_command_line_length#" &
+   "SVresponse_file_format#" &
+   "LVresponse_file_switches#" &
+
+   --  package Cross_Reference
+
+   "Pcross_reference#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Finder
+
+   "Pfinder#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Pretty_Printer
+
+   "Ppretty_printer#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package gnatstub
+
+   "Pgnatstub#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Check
+
+   "Pcheck#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Synchronize
+
+   "Psynchronize#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Eliminate
+
+   "Peliminate#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Metrics
+
+   "Pmetrics#" &
+   "Ladefault_switches#" &
+   "LbOswitches#" &
+
+   --  package Ide
+
+   "Pide#" &
+   "Ladefault_switches#" &
+   "SVremote_host#" &
+   "SVprogram_host#" &
+   "SVcommunication_protocol#" &
+   "Sacompiler_command#" &
+   "SVdebugger_command#" &
+   "SVgnatlist#" &
+   "SVvcs_kind#" &
+   "SVvcs_file_check#" &
+   "SVvcs_log_check#" &
+   "SVdocumentation_dir#" &
+
+   --  package Stack
+
+   "Pstack#" &
+   "LVswitches#" &
+
+   "#";
+
+   Initialized : Boolean := False;
+   --  A flag to avoid multiple initialization
+
+   Package_Names     : String_List_Access := new Strings.String_List (1 .. 20);
+   Last_Package_Name : Natural := 0;
+   --  Package_Names (1 .. Last_Package_Name) contains the list of the known
+   --  package names, coming from the Initialization_Data string or from
+   --  calls to one of the two procedures Register_New_Package.
+
+   procedure Add_Package_Name (Name : String);
+   --  Add a package name in the Package_Name list, extending it, if necessary
+
+   function Name_Id_Of (Name : String) return Name_Id;
+   --  Returns the Name_Id for Name in lower case
+
+   ----------------------
+   -- Add_Package_Name --
+   ----------------------
+
+   procedure Add_Package_Name (Name : String) is
+   begin
+      if Last_Package_Name = Package_Names'Last then
+         declare
+            New_List : constant Strings.String_List_Access :=
+                         new Strings.String_List (1 .. Package_Names'Last * 2);
+         begin
+            New_List (Package_Names'Range) := Package_Names.all;
+            Package_Names := New_List;
+         end;
+      end if;
+
+      Last_Package_Name := Last_Package_Name + 1;
+      Package_Names (Last_Package_Name) := new String'(Name);
+   end Add_Package_Name;
+
+   -----------------------
+   -- Attribute_Kind_Of --
+   -----------------------
+
+   function Attribute_Kind_Of
+     (Attribute : Attribute_Node_Id) return Attribute_Kind
+   is
+   begin
+      if Attribute = Empty_Attribute then
+         return Unknown;
+      else
+         return Attrs.Table (Attribute.Value).Attr_Kind;
+      end if;
+   end Attribute_Kind_Of;
+
+   -----------------------
+   -- Attribute_Name_Of --
+   -----------------------
+
+   function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id is
+   begin
+      if Attribute = Empty_Attribute then
+         return No_Name;
+      else
+         return Attrs.Table (Attribute.Value).Name;
+      end if;
+   end Attribute_Name_Of;
+
+   --------------------------
+   -- Attribute_Node_Id_Of --
+   --------------------------
+
+   function Attribute_Node_Id_Of
+     (Name        : Name_Id;
+      Starting_At : Attribute_Node_Id) return Attribute_Node_Id
+   is
+      Id : Attr_Node_Id := Starting_At.Value;
+
+   begin
+      while Id /= Empty_Attr
+        and then Attrs.Table (Id).Name /= Name
+      loop
+         Id := Attrs.Table (Id).Next;
+      end loop;
+
+      return (Value => Id);
+   end Attribute_Node_Id_Of;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+      Start             : Positive          := Initialization_Data'First;
+      Finish            : Positive          := Start;
+      Current_Package   : Pkg_Node_Id       := Empty_Pkg;
+      Current_Attribute : Attr_Node_Id      := Empty_Attr;
+      Is_An_Attribute   : Boolean           := False;
+      Var_Kind          : Variable_Kind     := Undefined;
+      Optional_Index    : Boolean           := False;
+      Attr_Kind         : Attribute_Kind    := Single;
+      Package_Name      : Name_Id           := No_Name;
+      Attribute_Name    : Name_Id           := No_Name;
+      First_Attribute   : Attr_Node_Id      := Attr.First_Attribute;
+      Read_Only         : Boolean;
+      Others_Allowed    : Boolean;
+
+      function Attribute_Location return String;
+      --  Returns a string depending if we are in the project level attributes
+      --  or in the attributes of a package.
+
+      ------------------------
+      -- Attribute_Location --
+      ------------------------
+
+      function Attribute_Location return String is
+      begin
+         if Package_Name = No_Name then
+            return "project level attributes";
+
+         else
+            return "attribute of package """ &
+            Get_Name_String (Package_Name) & """";
+         end if;
+      end Attribute_Location;
+
+   --  Start of processing for Initialize
+
+   begin
+      --  Don't allow Initialize action to be repeated
+
+      if Initialized then
+         return;
+      end if;
+
+      --  Make sure the two tables are empty
+
+      Attrs.Init;
+      Package_Attributes.Init;
+
+      while Initialization_Data (Start) /= '#' loop
+         Is_An_Attribute := True;
+         case Initialization_Data (Start) is
+            when 'P' =>
+
+               --  New allowed package
+
+               Start := Start + 1;
+
+               Finish := Start;
+               while Initialization_Data (Finish) /= '#' loop
+                  Finish := Finish + 1;
+               end loop;
+
+               Package_Name :=
+                 Name_Id_Of (Initialization_Data (Start .. Finish - 1));
+
+               for Index in First_Package .. Package_Attributes.Last loop
+                  if Package_Name = Package_Attributes.Table (Index).Name then
+                     Osint.Fail ("duplicate name """
+                                 & Initialization_Data (Start .. Finish - 1)
+                                 & """ in predefined packages.");
+                  end if;
+               end loop;
+
+               Is_An_Attribute := False;
+               Current_Attribute := Empty_Attr;
+               Package_Attributes.Increment_Last;
+               Current_Package := Package_Attributes.Last;
+               Package_Attributes.Table (Current_Package) :=
+                 (Name             => Package_Name,
+                  Known            => True,
+                  First_Attribute  => Empty_Attr);
+               Start := Finish + 1;
+
+               Add_Package_Name (Get_Name_String (Package_Name));
+
+            when 'S' =>
+               Var_Kind       := Single;
+               Optional_Index := False;
+
+            when 's' =>
+               Var_Kind       := Single;
+               Optional_Index := True;
+
+            when 'L' =>
+               Var_Kind       := List;
+               Optional_Index := False;
+
+            when 'l' =>
+               Var_Kind         := List;
+               Optional_Index := True;
+
+            when others =>
+               raise Program_Error;
+         end case;
+
+         if Is_An_Attribute then
+
+            --  New attribute
+
+            Start := Start + 1;
+            case Initialization_Data (Start) is
+               when 'V' =>
+                  Attr_Kind := Single;
+
+               when 'A' =>
+                  Attr_Kind := Associative_Array;
+
+               when 'a' =>
+                  Attr_Kind := Case_Insensitive_Associative_Array;
+
+               when 'b' =>
+                  if Osint.File_Names_Case_Sensitive then
+                     Attr_Kind := Associative_Array;
+                  else
+                     Attr_Kind := Case_Insensitive_Associative_Array;
+                  end if;
+
+               when 'c' =>
+                  if Osint.File_Names_Case_Sensitive then
+                     Attr_Kind := Optional_Index_Associative_Array;
+                  else
+                     Attr_Kind :=
+                       Optional_Index_Case_Insensitive_Associative_Array;
+                  end if;
+
+               when others =>
+                  raise Program_Error;
+            end case;
+
+            Start := Start + 1;
+
+            Read_Only := False;
+            Others_Allowed := False;
+
+            if Initialization_Data (Start) = 'R' then
+               Read_Only := True;
+               Start := Start + 1;
+
+            elsif Initialization_Data (Start) = 'O' then
+               Others_Allowed := True;
+               Start := Start + 1;
+            end if;
+
+            Finish := Start;
+
+            while Initialization_Data (Finish) /= '#' loop
+               Finish := Finish + 1;
+            end loop;
+
+            Attribute_Name :=
+              Name_Id_Of (Initialization_Data (Start .. Finish - 1));
+            Attrs.Increment_Last;
+
+            if Current_Attribute = Empty_Attr then
+               First_Attribute := Attrs.Last;
+
+               if Current_Package /= Empty_Pkg then
+                  Package_Attributes.Table (Current_Package).First_Attribute
+                    := Attrs.Last;
+               end if;
+
+            else
+               --  Check that there are no duplicate attributes
+
+               for Index in First_Attribute .. Attrs.Last - 1 loop
+                  if Attribute_Name = Attrs.Table (Index).Name then
+                     Osint.Fail ("duplicate attribute """
+                                 & Initialization_Data (Start .. Finish - 1)
+                                 & """ in " & Attribute_Location);
+                  end if;
+               end loop;
+
+               Attrs.Table (Current_Attribute).Next :=
+                 Attrs.Last;
+            end if;
+
+            Current_Attribute := Attrs.Last;
+            Attrs.Table (Current_Attribute) :=
+              (Name           => Attribute_Name,
+               Var_Kind       => Var_Kind,
+               Optional_Index => Optional_Index,
+               Attr_Kind      => Attr_Kind,
+               Read_Only      => Read_Only,
+               Others_Allowed => Others_Allowed,
+               Next           => Empty_Attr);
+            Start := Finish + 1;
+         end if;
+      end loop;
+
+      Initialized := True;
+   end Initialize;
+
+   ------------------
+   -- Is_Read_Only --
+   ------------------
+
+   function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean is
+   begin
+      return Attrs.Table (Attribute.Value).Read_Only;
+   end Is_Read_Only;
+
+   ----------------
+   -- Name_Id_Of --
+   ----------------
+
+   function Name_Id_Of (Name : String) return Name_Id is
+   begin
+      Name_Len := 0;
+      Add_Str_To_Name_Buffer (Name);
+      To_Lower (Name_Buffer (1 .. Name_Len));
+      return Name_Find;
+   end Name_Id_Of;
+
+   --------------------
+   -- Next_Attribute --
+   --------------------
+
+   function Next_Attribute
+     (After : Attribute_Node_Id) return Attribute_Node_Id
+   is
+   begin
+      if After = Empty_Attribute then
+         return Empty_Attribute;
+      else
+         return (Value => Attrs.Table (After.Value).Next);
+      end if;
+   end Next_Attribute;
+
+   -----------------------
+   -- Optional_Index_Of --
+   -----------------------
+
+   function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean is
+   begin
+      if Attribute = Empty_Attribute then
+         return False;
+      else
+         return Attrs.Table (Attribute.Value).Optional_Index;
+      end if;
+   end Optional_Index_Of;
+
+   function Others_Allowed_For
+     (Attribute : Attribute_Node_Id) return Boolean
+   is
+   begin
+      if Attribute = Empty_Attribute then
+         return False;
+      else
+         return Attrs.Table (Attribute.Value).Others_Allowed;
+      end if;
+   end Others_Allowed_For;
+
+   -----------------------
+   -- Package_Name_List --
+   -----------------------
+
+   function Package_Name_List return Strings.String_List is
+   begin
+      return Package_Names (1 .. Last_Package_Name);
+   end Package_Name_List;
+
+   ------------------------
+   -- Package_Node_Id_Of --
+   ------------------------
+
+   function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id is
+   begin
+      for Index in Package_Attributes.First .. Package_Attributes.Last loop
+         if Package_Attributes.Table (Index).Name = Name then
+            if Package_Attributes.Table (Index).Known then
+               return (Value => Index);
+            else
+               return Unknown_Package;
+            end if;
+         end if;
+      end loop;
+
+      --  If there is no package with this name, return Empty_Package
+
+      return Empty_Package;
+   end Package_Node_Id_Of;
+
+   ----------------------------
+   -- Register_New_Attribute --
+   ----------------------------
+
+   procedure Register_New_Attribute
+     (Name               : String;
+      In_Package         : Package_Node_Id;
+      Attr_Kind          : Defined_Attribute_Kind;
+      Var_Kind           : Defined_Variable_Kind;
+      Index_Is_File_Name : Boolean := False;
+      Opt_Index          : Boolean := False)
+   is
+      Attr_Name       : Name_Id;
+      First_Attr      : Attr_Node_Id := Empty_Attr;
+      Curr_Attr       : Attr_Node_Id;
+      Real_Attr_Kind  : Attribute_Kind;
+
+   begin
+      if Name'Length = 0 then
+         Fail ("cannot register an attribute with no name");
+         raise Project_Error;
+      end if;
+
+      if In_Package = Empty_Package then
+         Fail ("attempt to add attribute """
+               & Name
+               & """ to an undefined package");
+         raise Project_Error;
+      end if;
+
+      Attr_Name := Name_Id_Of (Name);
+
+      First_Attr :=
+        Package_Attributes.Table (In_Package.Value).First_Attribute;
+
+      --  Check if attribute name is a duplicate
+
+      Curr_Attr := First_Attr;
+      while Curr_Attr /= Empty_Attr loop
+         if Attrs.Table (Curr_Attr).Name = Attr_Name then
+            Fail ("duplicate attribute name """
+                  & Name
+                  & """ in package """
+                  & Get_Name_String
+                     (Package_Attributes.Table (In_Package.Value).Name)
+                  & """");
+            raise Project_Error;
+         end if;
+
+         Curr_Attr := Attrs.Table (Curr_Attr).Next;
+      end loop;
+
+      Real_Attr_Kind := Attr_Kind;
+
+      --  If Index_Is_File_Name, change the attribute kind if necessary
+
+      if Index_Is_File_Name and then not Osint.File_Names_Case_Sensitive then
+         case Attr_Kind is
+            when Associative_Array =>
+               Real_Attr_Kind := Case_Insensitive_Associative_Array;
+
+            when Optional_Index_Associative_Array =>
+               Real_Attr_Kind :=
+                 Optional_Index_Case_Insensitive_Associative_Array;
+
+            when others =>
+               null;
+         end case;
+      end if;
+
+      --  Add the new attribute
+
+      Attrs.Increment_Last;
+      Attrs.Table (Attrs.Last) :=
+        (Name           => Attr_Name,
+         Var_Kind       => Var_Kind,
+         Optional_Index => Opt_Index,
+         Attr_Kind      => Real_Attr_Kind,
+         Read_Only      => False,
+         Others_Allowed => False,
+         Next           => First_Attr);
+
+      Package_Attributes.Table (In_Package.Value).First_Attribute :=
+        Attrs.Last;
+   end Register_New_Attribute;
+
+   --------------------------
+   -- Register_New_Package --
+   --------------------------
+
+   procedure Register_New_Package (Name : String; Id : out Package_Node_Id) is
+      Pkg_Name : Name_Id;
+
+   begin
+      if Name'Length = 0 then
+         Fail ("cannot register a package with no name");
+         Id := Empty_Package;
+         return;
+      end if;
+
+      Pkg_Name := Name_Id_Of (Name);
+
+      for Index in Package_Attributes.First .. Package_Attributes.Last loop
+         if Package_Attributes.Table (Index).Name = Pkg_Name then
+            Fail ("cannot register a package with a non unique name"""
+                  & Name
+                  & """");
+            Id := Empty_Package;
+            return;
+         end if;
+      end loop;
+
+      Package_Attributes.Increment_Last;
+      Id := (Value => Package_Attributes.Last);
+      Package_Attributes.Table (Package_Attributes.Last) :=
+        (Name             => Pkg_Name,
+         Known            => True,
+         First_Attribute  => Empty_Attr);
+
+      Add_Package_Name (Get_Name_String (Pkg_Name));
+   end Register_New_Package;
+
+   procedure Register_New_Package
+     (Name       : String;
+      Attributes : Attribute_Data_Array)
+   is
+      Pkg_Name   : Name_Id;
+      Attr_Name  : Name_Id;
+      First_Attr : Attr_Node_Id := Empty_Attr;
+      Curr_Attr  : Attr_Node_Id;
+      Attr_Kind  : Attribute_Kind;
+
+   begin
+      if Name'Length = 0 then
+         Fail ("cannot register a package with no name");
+         raise Project_Error;
+      end if;
+
+      Pkg_Name := Name_Id_Of (Name);
+
+      for Index in Package_Attributes.First .. Package_Attributes.Last loop
+         if Package_Attributes.Table (Index).Name = Pkg_Name then
+            Fail ("cannot register a package with a non unique name"""
+                  & Name
+                  & """");
+            raise Project_Error;
+         end if;
+      end loop;
+
+      for Index in Attributes'Range loop
+         Attr_Name := Name_Id_Of (Attributes (Index).Name);
+
+         Curr_Attr := First_Attr;
+         while Curr_Attr /= Empty_Attr loop
+            if Attrs.Table (Curr_Attr).Name = Attr_Name then
+               Fail ("duplicate attribute name """
+                     & Attributes (Index).Name
+                     & """ in new package """
+                     & Name
+                     & """");
+               raise Project_Error;
+            end if;
+
+            Curr_Attr := Attrs.Table (Curr_Attr).Next;
+         end loop;
+
+         Attr_Kind := Attributes (Index).Attr_Kind;
+
+         if Attributes (Index).Index_Is_File_Name
+           and then not Osint.File_Names_Case_Sensitive
+         then
+            case Attr_Kind is
+               when Associative_Array =>
+                  Attr_Kind := Case_Insensitive_Associative_Array;
+
+               when Optional_Index_Associative_Array =>
+                  Attr_Kind :=
+                    Optional_Index_Case_Insensitive_Associative_Array;
+
+               when others =>
+                  null;
+            end case;
+         end if;
+
+         Attrs.Increment_Last;
+         Attrs.Table (Attrs.Last) :=
+           (Name           => Attr_Name,
+            Var_Kind       => Attributes (Index).Var_Kind,
+            Optional_Index => Attributes (Index).Opt_Index,
+            Attr_Kind      => Attr_Kind,
+            Read_Only      => False,
+            Others_Allowed => False,
+            Next           => First_Attr);
+         First_Attr := Attrs.Last;
+      end loop;
+
+      Package_Attributes.Increment_Last;
+      Package_Attributes.Table (Package_Attributes.Last) :=
+        (Name             => Pkg_Name,
+         Known            => True,
+         First_Attribute  => First_Attr);
+
+      Add_Package_Name (Get_Name_String (Pkg_Name));
+   end Register_New_Package;
+
+   ---------------------------
+   -- Set_Attribute_Kind_Of --
+   ---------------------------
+
+   procedure Set_Attribute_Kind_Of
+     (Attribute : Attribute_Node_Id;
+      To        : Attribute_Kind)
+   is
+   begin
+      if Attribute /= Empty_Attribute then
+         Attrs.Table (Attribute.Value).Attr_Kind := To;
+      end if;
+   end Set_Attribute_Kind_Of;
+
+   --------------------------
+   -- Set_Variable_Kind_Of --
+   --------------------------
+
+   procedure Set_Variable_Kind_Of
+     (Attribute : Attribute_Node_Id;
+      To        : Variable_Kind)
+   is
+   begin
+      if Attribute /= Empty_Attribute then
+         Attrs.Table (Attribute.Value).Var_Kind := To;
+      end if;
+   end Set_Variable_Kind_Of;
+
+   ----------------------
+   -- Variable_Kind_Of --
+   ----------------------
+
+   function Variable_Kind_Of
+     (Attribute : Attribute_Node_Id) return Variable_Kind
+   is
+   begin
+      if Attribute = Empty_Attribute then
+         return Undefined;
+      else
+         return Attrs.Table (Attribute.Value).Var_Kind;
+      end if;
+   end Variable_Kind_Of;
+
+   ------------------------
+   -- First_Attribute_Of --
+   ------------------------
+
+   function First_Attribute_Of
+     (Pkg : Package_Node_Id) return Attribute_Node_Id
+   is
+   begin
+      if Pkg = Empty_Package then
+         return Empty_Attribute;
+      else
+         return
+           (Value => Package_Attributes.Table (Pkg.Value).First_Attribute);
+      end if;
+   end First_Attribute_Of;
+
+end Prj.Attr;