namet.ads, namet.adb (wn): Improve this debugging routine.

2007-04-06  Robert Dewar  <dewar@adacore.com>

	* namet.ads, namet.adb (wn): Improve this debugging routine. Calling
	it no longer destroys the contents of Name_Buffer or Name_Len and
	non-standard and invalid names are handled better.
	(Get_Decoded_Name_String): Improve performance by using
	Name_Has_No_Encodings flag in the name table.
	(Is_Valid_Name): New function to determine whether a Name_Id is valid.
	Used for debugging printouts.

From-SVN: r123586

gcc/ada/namet.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006, 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- --
@@ -244,11 +244,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
@@ -865,17 +872,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 +967,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 +1014,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 +1108,6 @@ package body Namet is
                        Name_Entries.Last + 1;
                      exit Search;
                   end if;
-
             end loop Search;
          end if;
 
@@ -1103,23 +1115,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 +1353,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;
 

gcc/ada/namet.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006, 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- --
@@ -291,6 +291,10 @@ package Namet is
    --  passed in Name_Buffer and Name_Len (which are not affected by the call).
    --  Name_Buffer (it loads these as for Get_Name_String).
 
+   function Is_Valid_Name (Id : Name_Id) return Boolean;
+   --  True if Id is a valid name -- points to a valid entry in the
+   --  Name_Entries table.
+
    procedure Reset_Name_Table;
    --  This procedure is used when there are multiple source files to reset
    --  the name table info entries associated with current entries in the
@@ -358,16 +362,22 @@ package Namet is
    --  in encoded form (i.e. including Uhh, Whhh, Qx, _op as they appear in
    --  the name table). If Id is Error_Name, or No_Name, no text is output.
 
-   procedure wn (Id : Name_Id);
-   pragma Export (Ada, wn);
-   --  Like Write_Name, but includes new line at end. Intended for use
-   --  from the debugger only.
-
    procedure Write_Name_Decoded (Id : Name_Id);
    --  Like Write_Name, except that the name written is the decoded name, as
    --  described for Get_Decoded_Name_String, and the resulting value stored
    --  in Name_Len and Name_Buffer is the decoded name.
 
+   procedure wn (Id : Name_Id);
+   pragma Export (Ada, wn);
+   --  This routine is intended for debugging use only (i.e. it is intended to
+   --  be called from the debugger). It writes the characters of the specified
+   --  name using the standard output procedures in package Output, followed by
+   --  a new line. The name is written in encoded form (i.e. including Uhh,
+   --  Whhh, Qx, _op as they appear in the name table). If Id is Error_Name,
+   --  No_Name, or invalid an appropriate string is written (<Error_Name>,
+   --  <No_Name>, <invalid name>). Unlike Write_Name, this call does not affect
+   --  the contents of Name_Buffer or Name_Len.
+
    ---------------------------
    -- Table Data Structures --
    ---------------------------
@@ -404,6 +414,12 @@ private
       Byte_Info : Byte;
       --  Byte value associated with this name
 
+      Name_Has_No_Encodings : Boolean;
+      --  This flag is set True if the name entry is known not to contain any
+      --  special character encodings. This is used to speed up repeated calls
+      --  to Get_Decoded_Name_String. A value of False means that it is not
+      --  known whether the name contains any such encodings.
+
       Hash_Link : Name_Id;
       --  Link to next entry in names table for same hash code