From cd8d6792e3375d86e3ca810f261deef4f3f12048 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 27 Oct 2015 11:54:29 +0000 Subject: [PATCH] namet.adb, namet.ads: Minor reformatting. 2015-10-27 Hristian Kirtchev * namet.adb, namet.ads: Minor reformatting. From-SVN: r229426 --- gcc/ada/ChangeLog | 4 + gcc/ada/namet.adb | 68 ++++++------ gcc/ada/namet.ads | 260 +++++++++++++++++++++++----------------------- 3 files changed, 171 insertions(+), 161 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1ec3066ceca..d11df2e8114 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2015-10-27 Hristian Kirtchev + + * namet.adb, namet.ads: Minor reformatting. + 2015-10-27 Ed Schonberg * sem_ch4.adb (Analyze_Allocator): Do not perform legality check diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index cfaec6e545a..902f347b938 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 4a17e6eeee9..fa30a8ad780 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 -- ------------------------------ -- 2.30.2