Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P R J . A T T R                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2001-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.  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#" &
   "SVmain_language#" &
   "Lbroots#" &
   "SVexternally_built#" &
 
   --  Directories
 
   "SVobject_dir#" &
   "SVexec_dir#" &
   "LVsource_dirs#" &
   "Lainherit_source_path#" &
   "LVexcluded_source_dirs#" &
 
   --  Source files
 
   "LVsource_files#" &
   "LVlocally_removed_files#" &
   "LVexcluded_source_files#" &
   "SVsource_list_file#" &
   "SVexcluded_source_list_file#" &
   "LVinterfaces#" &
 
   --  Libraries
 
   "SVlibrary_dir#" &
   "SVlibrary_name#" &
   "SVlibrary_kind#" &
   "SVlibrary_version#" &
   "LVlibrary_interface#" &
   "SVlibrary_auto_init#" &
   "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
 
   "Pnaming#" &
   "Saspecification_suffix#" &
   "Saspec_suffix#" &
   "Saimplementation_suffix#" &
   "Sabody_suffix#" &
   "SVseparate_suffix#" &
   "SVcasing#" &
   "SVdot_replacement#" &
   "sAspecification#" &
   "sAspec#" &
   "sAimplementation#" &
   "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#" &
   "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#" &
 
   --  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;