OSDN Git Service

* gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.
[pf3gnuchains/gcc-fork.git] / gcc / ada / namet.adb
index 916c667..799e486 100644 (file)
@@ -6,25 +6,23 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-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 2,  or (at your option) any later ver- --
+-- 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 COPYING.  If not, write --
--- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
--- MA 02111-1307, USA.                                                      --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
 --                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
+-- 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.      --
@@ -32,7 +30,7 @@
 ------------------------------------------------------------------------------
 
 --  WARNING: There is a C version of this package. Any changes to this
---  source file must be properly reflected in the C header file a-namet.h
+--  source file must be properly reflected in the C header file namet.h
 --  which is created manually from namet.ads and namet.adb.
 
 with Debug;    use Debug;
@@ -55,7 +53,7 @@ package body Namet is
    Hash_Num : constant Int := 2**12;
    --  Number of headers in the hash table. Current hash algorithm is closely
    --  tailored to this choice, so it can only be changed if a corresponding
-   --  change is made to the hash alogorithm.
+   --  change is made to the hash algorithm.
 
    Hash_Max : constant Int := Hash_Num - 1;
    --  Indexes in the hash header table run from 0 to Hash_Num - 1
@@ -149,7 +147,7 @@ package body Namet is
 
             else
                Write_Str ("Hash_Table (");
-               Write_Int (Int (J));
+               Write_Int (J);
                Write_Str (") has ");
 
                declare
@@ -244,11 +242,18 @@ package body Namet is
    begin
       Get_Name_String (Id);
 
+      --  Skip scan if we already know there are no encodings
+
+      if Name_Entries.Table (Id).Name_Has_No_Encodings then
+         return;
+      end if;
+
       --  Quick loop to see if there is anything special to do
 
       P := 1;
       loop
          if P = Name_Len then
+            Name_Entries.Table (Id).Name_Has_No_Encodings := True;
             return;
 
          else
@@ -437,7 +442,7 @@ package body Namet is
 
                   --  Search the map. Note that this loop must terminate, if
                   --  not we have some kind of internal error, and a constraint
-                  --  constraint error may be raised.
+                  --  error may be raised.
 
                   J := Map'First;
                   loop
@@ -865,17 +870,16 @@ package body Namet is
       --  Initialize entries for one character names
 
       for C in Character loop
-         Name_Entries.Increment_Last;
-         Name_Entries.Table (Name_Entries.Last).Name_Chars_Index :=
-           Name_Chars.Last;
-         Name_Entries.Table (Name_Entries.Last).Name_Len  := 1;
-         Name_Entries.Table (Name_Entries.Last).Hash_Link := No_Name;
-         Name_Entries.Table (Name_Entries.Last).Int_Info  := 0;
-         Name_Entries.Table (Name_Entries.Last).Byte_Info := 0;
-         Name_Chars.Increment_Last;
-         Name_Chars.Table (Name_Chars.Last) := C;
-         Name_Chars.Increment_Last;
-         Name_Chars.Table (Name_Chars.Last) := ASCII.NUL;
+         Name_Entries.Append
+           ((Name_Chars_Index      => Name_Chars.Last,
+             Name_Len              => 1,
+             Byte_Info             => 0,
+             Int_Info              => 0,
+             Name_Has_No_Encodings => True,
+             Hash_Link             => No_Name));
+
+         Name_Chars.Append (C);
+         Name_Chars.Append (ASCII.NUL);
       end loop;
 
       --  Clear hash table
@@ -961,6 +965,15 @@ package body Namet is
       return Name_Chars.Table (S + 1) = 'O';
    end Is_Operator_Name;
 
+   -------------------
+   -- Is_Valid_Name --
+   -------------------
+
+   function Is_Valid_Name (Id : Name_Id) return Boolean is
+   begin
+      return Id in Name_Entries.First .. Name_Entries.Last;
+   end Is_Valid_Name;
+
    --------------------
    -- Length_Of_Name --
    --------------------
@@ -999,23 +1012,21 @@ package body Namet is
 
    function Name_Enter return Name_Id is
    begin
-      Name_Entries.Increment_Last;
-      Name_Entries.Table (Name_Entries.Last).Name_Chars_Index :=
-        Name_Chars.Last;
-      Name_Entries.Table (Name_Entries.Last).Name_Len  := Short (Name_Len);
-      Name_Entries.Table (Name_Entries.Last).Hash_Link := No_Name;
-      Name_Entries.Table (Name_Entries.Last).Int_Info  := 0;
-      Name_Entries.Table (Name_Entries.Last).Byte_Info := 0;
+      Name_Entries.Append
+        ((Name_Chars_Index      => Name_Chars.Last,
+          Name_Len              => Short (Name_Len),
+          Byte_Info             => 0,
+          Int_Info              => 0,
+          Name_Has_No_Encodings => False,
+          Hash_Link             => No_Name));
 
       --  Set corresponding string entry in the Name_Chars table
 
       for J in 1 .. Name_Len loop
-         Name_Chars.Increment_Last;
-         Name_Chars.Table (Name_Chars.Last) := Name_Buffer (J);
+         Name_Chars.Append (Name_Buffer (J));
       end loop;
 
-      Name_Chars.Increment_Last;
-      Name_Chars.Table (Name_Chars.Last) := ASCII.NUL;
+      Name_Chars.Append (ASCII.NUL);
 
       return Name_Entries.Last;
    end Name_Enter;
@@ -1095,7 +1106,6 @@ package body Namet is
                        Name_Entries.Last + 1;
                      exit Search;
                   end if;
-
             end loop Search;
          end if;
 
@@ -1103,23 +1113,21 @@ package body Namet is
          --  hash table. We now create a new entry in the names table. The hash
          --  link pointing to the new entry (Name_Entries.Last+1) has been set.
 
-         Name_Entries.Increment_Last;
-         Name_Entries.Table (Name_Entries.Last).Name_Chars_Index :=
-           Name_Chars.Last;
-         Name_Entries.Table (Name_Entries.Last).Name_Len  := Short (Name_Len);
-         Name_Entries.Table (Name_Entries.Last).Hash_Link := No_Name;
-         Name_Entries.Table (Name_Entries.Last).Int_Info  := 0;
-         Name_Entries.Table (Name_Entries.Last).Byte_Info := 0;
+         Name_Entries.Append
+           ((Name_Chars_Index      => Name_Chars.Last,
+             Name_Len              => Short (Name_Len),
+             Hash_Link             => No_Name,
+             Name_Has_No_Encodings => False,
+             Int_Info              => 0,
+             Byte_Info             => 0));
 
          --  Set corresponding string entry in the Name_Chars table
 
          for J in 1 .. Name_Len loop
-            Name_Chars.Increment_Last;
-            Name_Chars.Table (Name_Chars.Last) := Name_Buffer (J);
+            Name_Chars.Append (Name_Buffer (J));
          end loop;
 
-         Name_Chars.Increment_Last;
-         Name_Chars.Table (Name_Chars.Last) := ASCII.NUL;
+         Name_Chars.Append (ASCII.NUL);
 
          return Name_Entries.Last;
       end if;
@@ -1343,8 +1351,27 @@ package body Namet is
    --------
 
    procedure wn (Id : Name_Id) is
+      S : Int;
+
    begin
-      Write_Name (Id);
+      if not Id'Valid then
+         Write_Str ("<invalid name_id>");
+
+      elsif Id = No_Name then
+         Write_Str ("<No_Name>");
+
+      elsif Id = Error_Name then
+         Write_Str ("<Error_Name>");
+
+      else
+         S := Name_Entries.Table (Id).Name_Chars_Index;
+         Name_Len := Natural (Name_Entries.Table (Id).Name_Len);
+
+         for J in 1 .. Name_Len loop
+            Write_Char (Name_Chars.Table (S + Int (J)));
+         end loop;
+      end if;
+
       Write_Eol;
    end wn;