diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-04-06 09:24:39 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-04-06 09:24:39 +0000 |
commit | bdf2dac0859811fd382a7aeef641f1909a5af0a1 (patch) | |
tree | 8ae2d74d6461a8766909dc772a22d72f70b08188 | |
parent | 398d21cdd1a880d272be90bb7ee192c6ea09d02c (diff) | |
download | gcc-bdf2dac0859811fd382a7aeef641f1909a5af0a1.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123586 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ada/namet.adb | 101 | ||||
-rw-r--r-- | gcc/ada/namet.ads | 28 |
2 files changed, 87 insertions, 42 deletions
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 25511db11e9..0f4074c49be 100644 --- a/gcc/ada/namet.adb +++ b/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; diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 4bf12e6a85c..a669485a4bc 100644 --- a/gcc/ada/namet.ads +++ b/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 |