aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2015-10-27 11:54:29 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2015-10-27 12:54:29 +0100
commitcd8d6792e3375d86e3ca810f261deef4f3f12048 (patch)
tree1296c6a36b3da1e2d76b761c628df9e819e69a75
parent461e4145898e7bdf5b6a0aec280246c0046fe807 (diff)
downloadgcc-cd8d6792e3375d86e3ca810f261deef4f3f12048.zip
gcc-cd8d6792e3375d86e3ca810f261deef4f3f12048.tar.gz
gcc-cd8d6792e3375d86e3ca810f261deef4f3f12048.tar.bz2
namet.adb, namet.ads: Minor reformatting.
2015-10-27 Hristian Kirtchev <kirtchev@adacore.com> * namet.adb, namet.ads: Minor reformatting. From-SVN: r229426
-rw-r--r--gcc/ada/ChangeLog4
-rw-r--r--gcc/ada/namet.adb68
-rw-r--r--gcc/ada/namet.ads260
3 files changed, 171 insertions, 161 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1ec3066..d11df2e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,7 @@
+2015-10-27 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * namet.adb, namet.ads: Minor reformatting.
+
2015-10-27 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Analyze_Allocator): Do not perform legality check
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index cfaec6e..902f347 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -628,7 +628,11 @@ package body Namet is
-- Get_Last_Two_Chars --
------------------------
- procedure Get_Last_Two_Chars (N : Name_Id; C1, C2 : out Character) is
+ procedure Get_Last_Two_Chars
+ (N : Name_Id;
+ C1 : out Character;
+ C2 : out Character)
+ is
NE : Name_Entry renames Name_Entries.Table (N);
NEL : constant Int := Int (NE.Name_Len);
@@ -1309,6 +1313,37 @@ package body Namet is
T = V11;
end Nam_In;
+ -----------------
+ -- Name_Equals --
+ -----------------
+
+ function Name_Equals (N1 : Name_Id; N2 : Name_Id) return Boolean is
+ begin
+ if N1 = N2 then
+ return True;
+ end if;
+
+ declare
+ L1 : constant Int := Int (Name_Entries.Table (N1).Name_Len);
+ L2 : constant Int := Int (Name_Entries.Table (N2).Name_Len);
+
+ begin
+ if L1 /= L2 then
+ return False;
+ end if;
+
+ declare
+ use Name_Chars;
+ I1 : constant Int := Name_Entries.Table (N1).Name_Chars_Index;
+ I2 : constant Int := Name_Entries.Table (N2).Name_Chars_Index;
+
+ begin
+ return (Name_Chars.Table (1 + I1 .. I1 + L1) =
+ Name_Chars.Table (1 + I2 .. I2 + L2));
+ end;
+ end;
+ end Name_Equals;
+
------------------
-- Reinitialize --
------------------
@@ -1421,7 +1456,6 @@ package body Namet is
-----------------------------
procedure Store_Encoded_Character (C : Char_Code) is
-
procedure Set_Hex_Chars (C : Char_Code);
-- Stores given value, which is in the range 0 .. 255, as two hex
-- digits (using lower case a-f) in Name_Buffer, incrementing Name_Len.
@@ -1639,36 +1673,6 @@ package body Namet is
end if;
end Write_Name_Decoded;
- -----------------
- -- Name_Equals --
- -----------------
-
- function Name_Equals (N1, N2 : Name_Id) return Boolean is
- begin
- if N1 = N2 then
- return True;
- end if;
-
- declare
- L1 : constant Int := Int (Name_Entries.Table (N1).Name_Len);
- L2 : constant Int := Int (Name_Entries.Table (N2).Name_Len);
- begin
- if L1 /= L2 then
- return False;
- end if;
-
- declare
- use Name_Chars;
-
- I1 : constant Int := Name_Entries.Table (N1).Name_Chars_Index;
- I2 : constant Int := Name_Entries.Table (N2).Name_Chars_Index;
- begin
- return (Name_Chars.Table (1 + I1 .. I1 + L1)
- = Name_Chars.Table (1 + I2 .. I2 + L2));
- end;
- end;
- end Name_Equals;
-
-- Package initialization, initialize tables
begin
diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads
index 4a17e6e..fa30a8a 100644
--- a/gcc/ada/namet.ads
+++ b/gcc/ada/namet.ads
@@ -309,36 +309,24 @@ package Namet is
-- Subprograms --
-----------------
+ procedure Add_Char_To_Name_Buffer (C : Character);
+ pragma Inline (Add_Char_To_Name_Buffer);
+ -- Add given character to the end of the string currently stored in the
+ -- Name_Buffer, incrementing Name_Len.
+
+ procedure Add_Nat_To_Name_Buffer (V : Nat);
+ -- Add decimal representation of given value to the end of the string
+ -- currently stored in Name_Buffer, incrementing Name_Len as required.
+
+ procedure Add_Str_To_Name_Buffer (S : String);
+ -- Add characters of string S to the end of the string currently stored in
+ -- the Name_Buffer, incrementing Name_Len by the length of the string.
+
procedure Finalize;
-- Called at the end of a use of the Namet package (before a subsequent
-- call to Initialize). Currently this routine is only used to generate
-- debugging output.
- procedure Get_Name_String (Id : Name_Id);
- -- Get_Name_String is used to retrieve the string associated with an entry
- -- in the names table. The resulting string is stored in Name_Buffer and
- -- Name_Len is set. It is an error to call Get_Name_String with one of the
- -- special name Id values (No_Name or Error_Name).
-
- function Get_Name_String (Id : Name_Id) return String;
- -- This functional form returns the result as a string without affecting
- -- the contents of either Name_Buffer or Name_Len. The lower bound is 1.
-
- procedure Get_Unqualified_Name_String (Id : Name_Id);
- -- Similar to the above except that qualification (as defined in unit
- -- Exp_Dbug) is removed (including both preceding __ delimited names, and
- -- also the suffixes used to indicate package body entities and to
- -- distinguish between overloaded entities). Note that names are not
- -- qualified until just before the call to gigi, so this routine is only
- -- needed by processing that occurs after gigi has been called. This
- -- includes all ASIS processing, since ASIS works on the tree written
- -- after gigi has been called.
-
- procedure Get_Name_String_And_Append (Id : Name_Id);
- -- Like Get_Name_String but the resulting characters are appended to the
- -- current contents of the entry stored in Name_Buffer, and Name_Len is
- -- incremented to include the added characters.
-
procedure Get_Decoded_Name_String (Id : Name_Id);
-- Same calling sequence an interface as Get_Name_String, except that the
-- result is decoded, so that upper half characters and wide characters
@@ -346,15 +334,6 @@ package Namet is
-- their source forms (special characters and enclosed in quotes), and
-- character literals appear surrounded by apostrophes.
- procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id);
- -- Similar to the above except that qualification (as defined in unit
- -- Exp_Dbug) is removed (including both preceding __ delimited names, and
- -- also the suffix used to indicate package body entities). Note that
- -- names are not qualified until just before the call to gigi, so this
- -- routine is only needed by processing that occurs after gigi has been
- -- called. This includes all ASIS processing, since ASIS works on the tree
- -- written after gigi has been called.
-
procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id);
-- This routine is similar to Decoded_Name, except that the brackets
-- notation (Uhh replaced by ["hh"], Whhhh replaced by ["hhhh"],
@@ -366,6 +345,34 @@ package Namet is
-- by the character set options (e.g. in the binder generation of
-- symbols).
+ procedure Get_Last_Two_Chars
+ (N : Name_Id;
+ C1 : out Character;
+ C2 : out Character);
+ -- Obtains last two characters of a name. C1 is last but one character and
+ -- C2 is last character. If name is less than two characters long then both
+ -- C1 and C2 are set to ASCII.NUL on return.
+
+ procedure Get_Name_String (Id : Name_Id);
+ -- Get_Name_String is used to retrieve the string associated with an entry
+ -- in the names table. The resulting string is stored in Name_Buffer and
+ -- Name_Len is set. It is an error to call Get_Name_String with one of the
+ -- special name Id values (No_Name or Error_Name).
+
+ function Get_Name_String (Id : Name_Id) return String;
+ -- This functional form returns the result as a string without affecting
+ -- the contents of either Name_Buffer or Name_Len. The lower bound is 1.
+
+ procedure Get_Name_String_And_Append (Id : Name_Id);
+ -- Like Get_Name_String but the resulting characters are appended to the
+ -- current contents of the entry stored in Name_Buffer, and Name_Len is
+ -- incremented to include the added characters.
+
+ function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean;
+ function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean;
+ function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean;
+ -- Fetches the Boolean values associated with the given name
+
function Get_Name_Table_Byte (Id : Name_Id) return Byte;
pragma Inline (Get_Name_Table_Byte);
-- Fetches the Byte value associated with the given name
@@ -374,14 +381,24 @@ package Namet is
pragma Inline (Get_Name_Table_Int);
-- Fetches the Int value associated with the given name
- function Get_Name_Table_Boolean1 (Id : Name_Id) return Boolean;
- function Get_Name_Table_Boolean2 (Id : Name_Id) return Boolean;
- function Get_Name_Table_Boolean3 (Id : Name_Id) return Boolean;
- -- Fetches the Boolean values associated with the given name
+ procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id);
+ -- Similar to the above except that qualification (as defined in unit
+ -- Exp_Dbug) is removed (including both preceding __ delimited names, and
+ -- also the suffix used to indicate package body entities). Note that
+ -- names are not qualified until just before the call to gigi, so this
+ -- routine is only needed by processing that occurs after gigi has been
+ -- called. This includes all ASIS processing, since ASIS works on the tree
+ -- written after gigi has been called.
- function Is_Operator_Name (Id : Name_Id) return Boolean;
- -- Returns True if name given is of the form of an operator (that
- -- is, it starts with an upper case O).
+ procedure Get_Unqualified_Name_String (Id : Name_Id);
+ -- Similar to the above except that qualification (as defined in unit
+ -- Exp_Dbug) is removed (including both preceding __ delimited names, and
+ -- also the suffixes used to indicate package body entities and to
+ -- distinguish between overloaded entities). Note that names are not
+ -- qualified until just before the call to gigi, so this routine is only
+ -- needed by processing that occurs after gigi has been called. This
+ -- includes all ASIS processing, since ASIS works on the tree written
+ -- after gigi has been called.
procedure Initialize;
-- This is a dummy procedure. It is retained for easy compatibility with
@@ -391,16 +408,48 @@ package Namet is
-- of Initialize being called more than once. See also Reinitialize which
-- allows reinitialization of the tables.
- procedure Lock;
- -- Lock name tables before calling back end. We reserve some extra space
- -- before locking to avoid unnecessary inefficiencies when we unlock.
+ procedure Insert_Str_In_Name_Buffer (S : String; Index : Positive);
+ -- Inserts given string in name buffer, starting at Index. Any existing
+ -- characters at or past this location get moved beyond the inserted string
+ -- and Name_Len is incremented by the length of the string.
- procedure Reinitialize;
- -- Clears the name tables and removes all existing entries from the table.
+ function Is_Internal_Name return Boolean;
+ -- Like the form with an Id argument, except that the name to be tested 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).
- procedure Unlock;
- -- Unlocks the name table to allow use of the extra space reserved by the
- -- call to Lock. See gnat1drv for details of the need for this.
+ function Is_Internal_Name (Id : Name_Id) return Boolean;
+ -- Returns True if the name is an internal name (i.e. contains a character
+ -- for which Is_OK_Internal_Letter is true, or if the name starts or ends
+ -- with an underscore. This call destroys the value of Name_Len and
+ -- Name_Buffer (it loads these as for Get_Name_String).
+ --
+ -- Note: if the name is qualified (has a double underscore), then only the
+ -- final entity name is considered, not the qualifying names. Consider for
+ -- example that the name:
+ --
+ -- pkg__B_1__xyz
+ --
+ -- is not an internal name, because the B comes from the internal name of
+ -- a qualifying block, but the xyz means that this was indeed a declared
+ -- identifier called "xyz" within this block and there is nothing internal
+ -- about that name.
+
+ function Is_OK_Internal_Letter (C : Character) return Boolean;
+ pragma Inline (Is_OK_Internal_Letter);
+ -- Returns true if C is a suitable character for using as a prefix or a
+ -- suffix of an internally generated name, i.e. it is an upper case letter
+ -- other than one of the ones used for encoding source names (currently the
+ -- set of reserved letters is O, Q, U, W) and also returns False for the
+ -- letter X, which is reserved for debug output (see Exp_Dbug).
+
+ function Is_Operator_Name (Id : Name_Id) return Boolean;
+ -- Returns True if name given is of the form of an operator (that is, it
+ -- starts with an upper case O).
+
+ 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.
function Length_Of_Name (Id : Name_Id) return Nat;
pragma Inline (Length_Of_Name);
@@ -409,25 +458,14 @@ package Namet is
-- calling Get_Name_String and reading Name_Len, except that a call to
-- Length_Of_Name does not affect the contents of Name_Len and Name_Buffer.
+ procedure Lock;
+ -- Lock name tables before calling back end. We reserve some extra space
+ -- before locking to avoid unnecessary inefficiencies when we unlock.
+
function Name_Chars_Address return System.Address;
-- Return starting address of name characters table (used in Back_End call
-- to Gigi).
- function Name_Find return Name_Id;
- -- Name_Find is called with a string stored in Name_Buffer whose length is
- -- in Name_Len (i.e. the characters of the name are in subscript positions
- -- 1 to Name_Len in Name_Buffer). It searches the names table to see if the
- -- string has already been stored. If so the Id of the existing entry is
- -- returned. Otherwise a new entry is created with its Name_Table_Int
- -- fields set to zero/false. The contents of Name_Buffer and Name_Len are
- -- not modified by this call. Note that it is permissible for Name_Len to
- -- be set to zero to lookup the null name string.
-
- function Name_Find_Str (S : String) return Name_Id;
- -- Similar to Name_Find, except that the string is provided as an argument.
- -- This call destroys the contents of Name_Buffer and Name_Len (by storing
- -- the given string there.
-
function Name_Enter return Name_Id;
-- Name_Enter has the same calling interface as Name_Find. The difference
-- is that it does not search the table for an existing match, and also
@@ -445,79 +483,47 @@ package Namet is
function Name_Entries_Count return Nat;
-- Return current number of entries in the names table
- function Is_OK_Internal_Letter (C : Character) return Boolean;
- pragma Inline (Is_OK_Internal_Letter);
- -- Returns true if C is a suitable character for using as a prefix or a
- -- suffix of an internally generated name, i.e. it is an upper case letter
- -- other than one of the ones used for encoding source names (currently
- -- the set of reserved letters is O, Q, U, W) and also returns False for
- -- the letter X, which is reserved for debug output (see Exp_Dbug).
+ function Name_Equals (N1 : Name_Id; N2 : Name_Id) return Boolean;
+ -- Return whether N1 and N2 denote the same character sequence
- function Is_Internal_Name (Id : Name_Id) return Boolean;
- -- Returns True if the name is an internal name (i.e. contains a character
- -- for which Is_OK_Internal_Letter is true, or if the name starts or ends
- -- with an underscore. This call destroys the value of Name_Len and
- -- Name_Buffer (it loads these as for Get_Name_String).
- --
- -- Note: if the name is qualified (has a double underscore), then only the
- -- final entity name is considered, not the qualifying names. Consider for
- -- example that the name:
- --
- -- pkg__B_1__xyz
- --
- -- is not an internal name, because the B comes from the internal name of
- -- a qualifying block, but the xyz means that this was indeed a declared
- -- identifier called "xyz" within this block and there is nothing internal
- -- about that name.
+ function Name_Find return Name_Id;
+ -- Name_Find is called with a string stored in Name_Buffer whose length is
+ -- in Name_Len (i.e. the characters of the name are in subscript positions
+ -- 1 to Name_Len in Name_Buffer). It searches the names table to see if the
+ -- string has already been stored. If so the Id of the existing entry is
+ -- returned. Otherwise a new entry is created with its Name_Table_Int
+ -- fields set to zero/false. The contents of Name_Buffer and Name_Len are
+ -- not modified by this call. Note that it is permissible for Name_Len to
+ -- be set to zero to lookup the null name string.
- function Is_Internal_Name return Boolean;
- -- Like the form with an Id argument, except that the name to be tested 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 Name_Find_Str (S : String) return Name_Id;
+ -- Similar to Name_Find, except that the string is provided as an argument.
+ -- This call destroys the contents of Name_Buffer and Name_Len (by storing
+ -- the given string there.
- 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 Reinitialize;
+ -- Clears the name tables and removes all existing entries from the 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
- -- names table. There is no harm in keeping the names entries themselves
- -- from one compilation to another, but we can't keep the entity info,
- -- since this refers to tree nodes, which are destroyed between each main
- -- source file.
-
- procedure Add_Char_To_Name_Buffer (C : Character);
- pragma Inline (Add_Char_To_Name_Buffer);
- -- Add given character to the end of the string currently stored in the
- -- Name_Buffer, incrementing Name_Len.
-
- procedure Add_Nat_To_Name_Buffer (V : Nat);
- -- Add decimal representation of given value to the end of the string
- -- currently stored in Name_Buffer, incrementing Name_Len as required.
-
- procedure Add_Str_To_Name_Buffer (S : String);
- -- Add characters of string S to the end of the string currently stored
- -- in the Name_Buffer, incrementing Name_Len by the length of the string.
-
- procedure Insert_Str_In_Name_Buffer (S : String; Index : Positive);
- -- Inserts given string in name buffer, starting at Index. Any existing
- -- characters at or past this location get moved beyond the inserted string
- -- and Name_Len is incremented by the length of the string.
+ -- This procedure is used when there are multiple source files to reset the
+ -- name table info entries associated with current entries in the names
+ -- table. There is no harm in keeping the names entries themselves from one
+ -- compilation to another, but we can't keep the entity info, since this
+ -- refers to tree nodes, which are destroyed between each main source file.
procedure Set_Character_Literal_Name (C : Char_Code);
-- This procedure sets the proper encoded name for the character literal
-- for the given character code. On return Name_Buffer and Name_Len are
-- set to reflect the stored name.
- procedure Set_Name_Table_Int (Id : Name_Id; Val : Int);
- pragma Inline (Set_Name_Table_Int);
- -- Sets the Int value associated with the given name
-
procedure Set_Name_Table_Byte (Id : Name_Id; Val : Byte);
pragma Inline (Set_Name_Table_Byte);
-- Sets the Byte value associated with the given name
+ procedure Set_Name_Table_Int (Id : Name_Id; Val : Int);
+ pragma Inline (Set_Name_Table_Int);
+ -- Sets the Int value associated with the given name
+
procedure Set_Name_Table_Boolean1 (Id : Name_Id; Val : Boolean);
procedure Set_Name_Table_Boolean2 (Id : Name_Id; Val : Boolean);
procedure Set_Name_Table_Boolean3 (Id : Name_Id; Val : Boolean);
@@ -543,10 +549,9 @@ package Namet is
-- Writes out internal tables to current tree file using the relevant
-- Table.Tree_Write routines.
- procedure Get_Last_Two_Chars (N : Name_Id; C1, C2 : out Character);
- -- Obtains last two characters of a name. C1 is last but one character
- -- and C2 is last character. If name is less than two characters long,
- -- then both C1 and C2 are set to ASCII.NUL on return.
+ procedure Unlock;
+ -- Unlocks the name table to allow use of the extra space reserved by the
+ -- call to Lock. See gnat1drv for details of the need for this.
procedure Write_Name (Id : Name_Id);
-- Write_Name writes the characters of the specified name using the
@@ -561,9 +566,6 @@ package Namet is
-- described for Get_Decoded_Name_String, and the resulting value stored
-- in Name_Len and Name_Buffer is the decoded name.
- function Name_Equals (N1, N2 : Name_Id) return Boolean;
- -- Return whether N1 and N2 denote the same character sequence
-
------------------------------
-- File and Unit Name Types --
------------------------------