diff options
author | Bob Duff <duff@adacore.com> | 2020-07-14 17:10:19 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-20 03:21:35 -0400 |
commit | 83dcc2bd35e5dc981a13959b9bb6750736cd6544 (patch) | |
tree | b2ecadbe1434218ceaec2b21a0539708482a3755 | |
parent | 1b93e420fc10f0eaeb2b09d9b86c8defb5b459a4 (diff) | |
download | gcc-83dcc2bd35e5dc981a13959b9bb6750736cd6544.tar.gz |
[Ada] Flexible AST node structure
gcc/ada/
* atree.ads: Make Default_Node a constant. Remove the
modification of Comes_From_Source, and use a separate flag for
that. Change Sloc to 0; it always overwritten, and never left
as the No_Location value.
(Print_Statistics): Move to spec so we can call it from
gnat1drv.
(Num_Nodes): Rename to clarify that this is approximate.
Correct comment: nodes and entities are never deleted, the count
is never decremented, and this is not used by Xref.
(Initialize): Correct comment: Error_List is not created here.
Other minor naming and comment changes.
* atree.adb (Extend_Node, New_Copy, New_Entity, New_Node):
Streamline these. Simplify and improve efficiency. Move code
from Allocate_Initialize_Node to these, where it can be executed
unconditionally. Take advantage of automatic zeroing of the
Nodes table.
(Allocate_Initialize_Node): Remove this. It was an efficiency
bottleneck, and somewhat complicated, because it was called from
4 places, and had all sorts of conditionals to check where it
was called from. Better to move most of that code to the call
sites, where it can be executed (or not) unconditionally.
(Allocate_New_Node): New procedure to partly replace
Allocate_Initialize_Node (called from just 2 of those 4 places).
(Comes_From_Source_Default): New flag written/read by
Set_Comes_From_Source_Default/Get_Comes_From_Source_Default.
This allows us to make Default_Node into a constant with
all-zeros value.
(Set_Paren_Count_Of_Copy): New procedure to avoid duplicated
code.
(Report): New procedure to encapsulate the call to the reporting
procedure.
(Atree_Private_Part): We now need a body for this package, to
contain package body Nodes.
(Approx_Num_Nodes_And_Entities): Was Num_Nodes. For efficiency,
compute the answer from Nodes.Last. That way we don't need to
increment a counter on every node creation. Other minor naming
and comment changes.
* gnat1drv.adb: Call Atree.Print_Statistics if -gnatd.A switch
was given. Add comment documenting the new order dependency (we
must process the command line before calling Atree.Initialize).
* debug.adb: Document -gnatd.A.
* einfo.adb, sinfo.adb: Remove useless Style_Checks pragmas.
* nlists.ads (Allocate_List_Tables): Inline makes node creation
a little faster.
* nlists.adb (Initialize): Remove local constant E, which didn't
seem to add clarity.
* treepr.adb (Print_Init): Use renamed
Approx_Num_Nodes_And_Entities function.
* types.ads: Change the Low and High bounds as described above.
* types.h: Change Low and High bounds to match types.ads.
* sem_ch8.adb, namet.adb, namet.ads: Move the computation of
Last_Name_Id from sem_ch8 to namet, and correct it to not assume
Name_Ids are positive.
* ali.adb, ali-util.adb, bindo-writers.adb, exp_dist.adb,
fmap.adb, fname-uf.adb, osint.adb: Fix various hash functions to
avoid assuming the various ranges are positive. Note that "mod"
returns a nonnegative result when the second operand is
positive. "rem" can return negative values in that case (in
particular, if the first operand is negative, which it now is).
* switch-c.adb: Allow switch -gnaten to control the value of
Nodes_Size_In_Meg.
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Remove traling whitespaces.
* opt.ads (Nodes_Size_In_Meg): New Variable.
-rw-r--r-- | gcc/ada/ali-util.adb | 2 | ||||
-rw-r--r-- | gcc/ada/ali.adb | 5 | ||||
-rw-r--r-- | gcc/ada/atree.adb | 329 | ||||
-rw-r--r-- | gcc/ada/atree.ads | 53 | ||||
-rw-r--r-- | gcc/ada/bindo-writers.adb | 2 | ||||
-rw-r--r-- | gcc/ada/debug.adb | 4 | ||||
-rw-r--r-- | gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst | 4 | ||||
-rw-r--r-- | gcc/ada/einfo.adb | 3 | ||||
-rw-r--r-- | gcc/ada/exp_dist.adb | 2 | ||||
-rw-r--r-- | gcc/ada/fmap.adb | 4 | ||||
-rw-r--r-- | gcc/ada/fname-uf.adb | 2 | ||||
-rw-r--r-- | gcc/ada/gnat1drv.adb | 11 | ||||
-rw-r--r-- | gcc/ada/namet.adb | 9 | ||||
-rw-r--r-- | gcc/ada/namet.ads | 4 | ||||
-rw-r--r-- | gcc/ada/nlists.adb | 8 | ||||
-rw-r--r-- | gcc/ada/nlists.ads | 1 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 6 | ||||
-rw-r--r-- | gcc/ada/osint.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sinfo.adb | 3 | ||||
-rw-r--r-- | gcc/ada/switch-c.adb | 7 | ||||
-rw-r--r-- | gcc/ada/treepr.adb | 4 | ||||
-rw-r--r-- | gcc/ada/types.ads | 85 | ||||
-rw-r--r-- | gcc/ada/types.h | 32 |
24 files changed, 317 insertions, 270 deletions
diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index ec7ec2f7e78..9dcc656c2bb 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -179,7 +179,7 @@ package body ALI.Util is function Hash (F : File_Name_Type) return Header_Num is begin - return Header_Num (Int (F) rem Header_Num'Range_Length); + return Header_Num (Int (F) mod Header_Num'Range_Length); end Hash; --------------------------- diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 6b0d6c75d45..3bf12578b73 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -590,7 +590,8 @@ package body ALI is -- scope__name__line_column__locations -- -- * The String is converted into a Name_Id - -- * The Name_Id is used as the hash + -- + -- * The absolute value of the Name_Id is used as the hash Append (Buffer, IS_Rec.Scope); Append (Buffer, "__"); @@ -606,7 +607,7 @@ package body ALI is end if; IS_Nam := Name_Find (Buffer); - return Bucket_Range_Type (IS_Nam); + return Bucket_Range_Type (abs IS_Nam); end Hash; -------------------- diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 7e05a484bc6..982742c76b9 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -57,7 +57,8 @@ package body Atree is -- assertions this lock has no effect. Reporting_Proc : Report_Proc := null; - -- Record argument to last call to Set_Reporting_Proc + -- Set_Reporting_Proc sets this. Set_Reporting_Proc must be called only + -- once. Rewriting_Proc : Rewrite_Proc := null; -- This soft link captures the procedure invoked during a node rewrite @@ -113,16 +114,11 @@ package body Atree is procedure Node_Debug_Output (Op : String; N : Node_Id); -- Called by nnd; writes Op followed by information about N - procedure Print_Statistics; - pragma Export (Ada, Print_Statistics); - -- Print various statistics on the tables maintained by the package - ----------------------------- -- Local Objects and Types -- ----------------------------- - Node_Count : Nat; - -- Count allocated nodes for Num_Nodes function + Comes_From_Source_Default : Boolean := False; use Unchecked_Access; -- We are allowed to see these from within our own body @@ -504,7 +500,7 @@ package body Atree is -- Note: eventually, this should be a field in the Node directly, but -- for now we do not want to disturb the efficiency of a power of 2 - -- for the node size + -- for the node size. ????We are planning to get rid of power-of-2. package Orig_Nodes is new Table.Table ( Table_Component_Type => Node_Id, @@ -541,15 +537,19 @@ package body Atree is Table_Increment => 200, Table_Name => "Paren_Counts"); + procedure Set_Paren_Count_Of_Copy (Target, Source : Node_Id); + pragma Inline (Set_Paren_Count_Of_Copy); + -- Called when copying a node. Makes sure the Paren_Count of the copy is + -- correct. + ----------------------- -- Local Subprograms -- ----------------------- - function Allocate_Initialize_Node - (Src : Node_Id; - With_Extension : Boolean) return Node_Id; - -- Allocate a new node or node extension. If Src is not empty, the - -- information for the newly-allocated node is copied from it. + function Allocate_New_Node return Node_Id; + pragma Inline (Allocate_New_Node); + -- Allocate a new node or first part of a node extension. Initialize the + -- Nodes.Table entry, Flags, Orig_Nodes, and List tables. procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id); -- Fix up parent pointers for the syntactic children of Fix_Node after a @@ -559,79 +559,28 @@ package body Atree is -- Mark arbitrary node or entity N as Ghost when it is created within a -- Ghost region. - ------------------------------ - -- Allocate_Initialize_Node -- - ------------------------------ + procedure Report (Target, Source : Node_Id); + pragma Inline (Report); + -- Invoke the reporting procedure if available - function Allocate_Initialize_Node - (Src : Node_Id; - With_Extension : Boolean) return Node_Id - is - New_Id : Node_Id; + ----------------------- + -- Allocate_New_Node -- + ----------------------- + function Allocate_New_Node return Node_Id is + New_Id : Node_Id; begin - if Present (Src) - and then not Has_Extension (Src) - and then With_Extension - and then Src = Nodes.Last - then - New_Id := Src; - - -- We are allocating a new node, or extending a node other than - -- Nodes.Last. - - else - if Present (Src) then - Nodes.Append (Nodes.Table (Src)); - Flags.Append (Flags.Table (Src)); - else - Nodes.Append (Default_Node); - Flags.Append (Default_Flags); - end if; - - New_Id := Nodes.Last; - Orig_Nodes.Append (New_Id); - Node_Count := Node_Count + 1; - end if; - - -- Clear Check_Actuals to False - - Set_Check_Actuals (New_Id, False); - - -- Specifically copy Paren_Count to deal with creating new table entry - -- if the parentheses count is at the maximum possible value already. - - if Present (Src) and then Nkind (Src) in N_Subexpr then - Set_Paren_Count (New_Id, Paren_Count (Src)); - end if; - - -- Set extension nodes if required - - if With_Extension then - if Present (Src) and then Has_Extension (Src) then - for J in 1 .. Num_Extension_Nodes loop - Nodes.Append (Nodes.Table (Src + J)); - Flags.Append (Flags.Table (Src + J)); - end loop; - else - for J in 1 .. Num_Extension_Nodes loop - Nodes.Append (Default_Node_Extension); - Flags.Append (Default_Flags); - end loop; - end if; - end if; - - Orig_Nodes.Set_Last (Nodes.Last); + Nodes.Append (Default_Node); + New_Id := Nodes.Last; + Flags.Append (Default_Flags); + Orig_Nodes.Append (New_Id); + Nodes.Table (Nodes.Last).Comes_From_Source := + Comes_From_Source_Default; Allocate_List_Tables (Nodes.Last); - - -- Invoke the reporting procedure (if available) - - if Reporting_Proc /= null then - Reporting_Proc.all (Target => New_Id, Source => Src); - end if; + Report (Target => New_Id, Source => Empty); return New_Id; - end Allocate_Initialize_Node; + end Allocate_New_Node; -------------- -- Analyzed -- @@ -762,12 +711,7 @@ package body Atree is Flags.Table (Destination) := Flags.Table (Source); - -- Specifically set Paren_Count to make sure auxiliary table entry - -- gets correctly made if the parentheses count is at the max value. - - if Nkind (Destination) in N_Subexpr then - Set_Paren_Count (Destination, Paren_Count (Source)); - end if; + Set_Paren_Count_Of_Copy (Target => Destination, Source => Source); -- Deal with copying extension nodes if present. No need to copy flags -- table entries, since they are always zero for extending components. @@ -1056,12 +1000,14 @@ package body Atree is -- Extend_Node -- ----------------- - function Extend_Node (Node : Node_Id) return Entity_Id is - Result : Entity_Id; + function Extend_Node (Source : Node_Id) return Entity_Id is + pragma Assert (Present (Source)); + pragma Assert (not Has_Extension (Source)); + New_Id : Entity_Id; procedure Debug_Extend_Node; pragma Inline (Debug_Extend_Node); - -- Debug routine for debug flag N + -- Debug routine for -gnatdn ----------------------- -- Debug_Extend_Node -- @@ -1071,13 +1017,13 @@ package body Atree is begin if Debug_Flag_N then Write_Str ("Extend node "); - Write_Int (Int (Node)); + Write_Int (Int (Source)); - if Result = Node then + if New_Id = Source then Write_Str (" in place"); else Write_Str (" copied to "); - Write_Int (Int (Result)); + Write_Int (Int (New_Id)); end if; -- Write_Eol; @@ -1087,12 +1033,34 @@ package body Atree is -- Start of processing for Extend_Node begin - pragma Assert (not (Has_Extension (Node))); + -- Optimize the case where Source happens to be the last node; in that + -- case, we don't need to move it. + + if Source = Nodes.Last then + New_Id := Source; + else + Nodes.Append (Nodes.Table (Source)); + Flags.Append (Flags.Table (Source)); + New_Id := Nodes.Last; + Orig_Nodes.Append (New_Id); + end if; + + Set_Check_Actuals (New_Id, False); + + -- Set extension nodes + + for J in 1 .. Num_Extension_Nodes loop + Nodes.Append (Default_Node_Extension); + Flags.Append (Default_Flags); + end loop; + + Orig_Nodes.Set_Last (Nodes.Last); + Allocate_List_Tables (Nodes.Last); + Report (Target => New_Id, Source => Source); - Result := Allocate_Initialize_Node (Node, With_Extension => True); pragma Debug (Debug_Extend_Node); - return Result; + return New_Id; end Extend_Node; ----------------- @@ -1100,6 +1068,8 @@ package body Atree is ----------------- procedure Fix_Parents (Ref_Node, Fix_Node : Node_Id) is + pragma Assert (Nkind (Ref_Node) = Nkind (Fix_Node)); + procedure Fix_Parent (Field : Union_Id); -- Fix up one parent pointer. Field is checked to see if it points to -- a node, list, or element list that has a parent that points to @@ -1157,7 +1127,7 @@ package body Atree is function Get_Comes_From_Source_Default return Boolean is begin - return Default_Node.Comes_From_Source; + return Comes_From_Source_Default; end Get_Comes_From_Source_Default; ----------------- @@ -1188,7 +1158,6 @@ package body Atree is pragma Warnings (Off, Dummy); begin - Node_Count := 0; Atree_Private_Part.Nodes.Init; Atree_Private_Part.Flags.Init; Orig_Nodes.Init; @@ -1252,9 +1221,8 @@ package body Atree is -- We used to Release the tables, as in the comments below, but that is -- a waste of time. We're only wasting virtual memory here, and the -- release calls copy large amounts of data. + -- ???Get rid of Release? - -- Nodes.Release; - Nodes.Locked := True; -- Flags.Release; Flags.Locked := True; -- Orig_Nodes.Release; @@ -1314,38 +1282,60 @@ package body Atree is -------------- function New_Copy (Source : Node_Id) return Node_Id is - New_Id : Node_Id := Source; - + New_Id : Node_Id; begin - if Source > Empty_Or_Error then - New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source)); + if Source <= Empty_Or_Error then + return Source; + end if; - Nodes.Table (New_Id).In_List := False; - Nodes.Table (New_Id).Link := Empty_List_Or_Node; + Nodes.Append (Nodes.Table (Source)); + Flags.Append (Flags.Table (Source)); + New_Id := Nodes.Last; + Orig_Nodes.Append (New_Id); + Set_Check_Actuals (New_Id, False); + Set_Paren_Count_Of_Copy (Target => New_Id, Source => Source); - -- If the original is marked as a rewrite insertion, then unmark the - -- copy, since we inserted the original, not the copy. + -- Set extension nodes if required - Nodes.Table (New_Id).Rewrite_Ins := False; - pragma Debug (New_Node_Debugging_Output (New_Id)); + if Has_Extension (Source) then + for J in 1 .. Num_Extension_Nodes loop + Nodes.Append (Nodes.Table (Source + J)); + Flags.Append (Flags.Table (Source + J)); + end loop; + Orig_Nodes.Set_Last (Nodes.Last); + else + pragma Assert (Orig_Nodes.Table (Orig_Nodes.Last) = Nodes.Last); + end if; - -- Clear Is_Overloaded since we cannot have semantic interpretations - -- of this new node. + Allocate_List_Tables (Nodes.Last); + Report (Target => New_Id, Source => Source); - if Nkind (Source) in N_Subexpr then - Set_Is_Overloaded (New_Id, False); - end if; + Nodes.Table (New_Id).In_List := False; + Nodes.Table (New_Id).Link := Empty_List_Or_Node; - -- Always clear Has_Aspects, the caller must take care of copying - -- aspects if this is required for the particular situation. + -- If the original is marked as a rewrite insertion, then unmark the + -- copy, since we inserted the original, not the copy. - Set_Has_Aspects (New_Id, False); + Nodes.Table (New_Id).Rewrite_Ins := False; + pragma Debug (New_Node_Debugging_Output (New_Id)); - -- Mark the copy as Ghost depending on the current Ghost region + -- Clear Is_Overloaded since we cannot have semantic interpretations + -- of this new node. - Mark_New_Ghost_Node (New_Id); + if Nkind (Source) in N_Subexpr then + Set_Is_Overloaded (New_Id, False); end if; + -- Always clear Has_Aspects, the caller must take care of copying + -- aspects if this is required for the particular situation. + + Set_Has_Aspects (New_Id, False); + + -- Mark the copy as Ghost depending on the current Ghost region + + Mark_New_Ghost_Node (New_Id); + + pragma Assert (New_Id /= Source); return New_Id; end New_Copy; @@ -1357,30 +1347,35 @@ package body Atree is (New_Node_Kind : Node_Kind; New_Sloc : Source_Ptr) return Entity_Id is - Ent : Entity_Id; - - begin pragma Assert (New_Node_Kind in N_Entity); + New_Id : constant Entity_Id := Allocate_New_Node; + begin + -- Set extension nodes - Ent := Allocate_Initialize_Node (Empty, With_Extension => True); + for J in 1 .. Num_Extension_Nodes loop + Nodes.Append (Default_Node_Extension); + Flags.Append (Default_Flags); + end loop; + + Orig_Nodes.Set_Last (Nodes.Last); -- If this is a node with a real location and we are generating -- source nodes, then reset Current_Error_Node. This is useful -- if we bomb during parsing to get a error location for the bomb. - if Default_Node.Comes_From_Source and then New_Sloc > No_Location then - Current_Error_Node := Ent; + if New_Sloc > No_Location and then Comes_From_Source_Default then + Current_Error_Node := New_Id; end if; - Nodes.Table (Ent).Nkind := New_Node_Kind; - Nodes.Table (Ent).Sloc := New_Sloc; - pragma Debug (New_Node_Debugging_Output (Ent)); + Nodes.Table (New_Id).Nkind := New_Node_Kind; + Nodes.Table (New_Id).Sloc := New_Sloc; + pragma Debug (New_Node_Debugging_Output (New_Id)); -- Mark the new entity as Ghost depending on the current Ghost region - Mark_New_Ghost_Node (Ent); + Mark_New_Ghost_Node (New_Id); - return Ent; + return New_Id; end New_Entity; -------------- @@ -1391,29 +1386,27 @@ package body Atree is (New_Node_Kind : Node_Kind; New_Sloc : Source_Ptr) return Node_Id is - Nod : Node_Id; - - begin pragma Assert (New_Node_Kind not in N_Entity); - - Nod := Allocate_Initialize_Node (Empty, With_Extension => False); - Nodes.Table (Nod).Nkind := New_Node_Kind; - Nodes.Table (Nod).Sloc := New_Sloc; - pragma Debug (New_Node_Debugging_Output (Nod)); + New_Id : constant Node_Id := Allocate_New_Node; + pragma Assert (Orig_Nodes.Table (Orig_Nodes.Last) = Nodes.Last); + begin + Nodes.Table (New_Id).Nkind := New_Node_Kind; + Nodes.Table (New_Id).Sloc := New_Sloc; + pragma Debug (New_Node_Debugging_Output (New_Id)); -- If this is a node with a real location and we are generating source -- nodes, then reset Current_Error_Node. This is useful if we bomb -- during parsing to get an error location for the bomb. - if Default_Node.Comes_From_Source and then New_Sloc > No_Location then - Current_Error_Node := Nod; + if Comes_From_Source_Default and then New_Sloc > No_Location then + Current_Error_Node := New_Id; end if; -- Mark the new node as Ghost depending on the current Ghost region - Mark_New_Ghost_Node (Nod); + Mark_New_Ghost_Node (New_Id); - return Nod; + return New_Id; end New_Node; ------------------------- @@ -1494,14 +1487,18 @@ package body Atree is return Nodes.Table (First_Node_Id)'Address; end Nodes_Address; - --------------- - -- Num_Nodes -- - --------------- + ----------------------------------- + -- Approx_Num_Nodes_And_Entities -- + ----------------------------------- - function Num_Nodes return Nat is + function Approx_Num_Nodes_And_Entities return Nat is begin - return Node_Count; - end Num_Nodes; + -- This is an overestimate, because entities take up more space, but + -- that really doesn't matter; it's not worth subtracting out the + -- "extra". + + return Nat (Nodes.Last - First_Node_Id); + end Approx_Num_Nodes_And_Entities; ------------------- -- Original_Node -- @@ -1763,6 +1760,17 @@ package body Atree is end if; end Replace; + ------------ + -- Report -- + ------------ + + procedure Report (Target, Source : Node_Id) is + begin + if Reporting_Proc /= null then + Reporting_Proc.all (Target, Source); + end if; + end Report; + ------------- -- Rewrite -- ------------- @@ -1895,7 +1903,7 @@ package body Atree is procedure Set_Comes_From_Source_Default (Default : Boolean) is begin - Default_Node.Comes_From_Source := Default; + Comes_From_Source_Default := Default; end Set_Comes_From_Source_Default; --------------- @@ -1983,6 +1991,8 @@ package body Atree is Nodes.Table (N).Pflag1 := True; Nodes.Table (N).Pflag2 := True; + -- Search for existing table entry + for J in Paren_Counts.First .. Paren_Counts.Last loop if N = Paren_Counts.Table (J).Nod then Paren_Counts.Table (J).Count := Val; @@ -1990,10 +2000,30 @@ package body Atree is end if; end loop; + -- No existing table entry; make a new one + Paren_Counts.Append ((Nod => N, Count => Val)); end if; end Set_Paren_Count; + ----------------------------- + -- Set_Paren_Count_Of_Copy -- + ----------------------------- + + procedure Set_Paren_Count_Of_Copy (Target, Source : Node_Id) is + begin + -- We already copied the two Pflags. We need to update the Paren_Counts + -- table only if greater than 2. + + if Nkind (Source) in N_Subexpr + and then Paren_Count (Source) > 2 + then + Set_Paren_Count (Target, Paren_Count (Source)); + end if; + + pragma Assert (Paren_Count (Target) = Paren_Count (Source)); + end Set_Paren_Count_Of_Copy; + ---------------- -- Set_Parent -- ---------------- @@ -8756,7 +8786,6 @@ package body Atree is procedure Unlock is begin - Nodes.Locked := False; Flags.Locked := False; Orig_Nodes.Locked := False; end Unlock; diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index e958a9b7af5..278753519af 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -70,7 +70,7 @@ package Atree is -- Currently entities are composed of 7 sequentially allocated 32-byte -- nodes, considered as a single record. The following definition gives - -- the number of extension nodes. + -- the number of extension nodes. ????We plan to change this. Num_Extension_Nodes : Node_Id := 6; -- This value is increased by one if debug flag -gnatd.N is set. This is @@ -81,6 +81,10 @@ package Atree is -- 2.01 for the nodes/entities ratio and a 2% increase in compilation time -- on average for the GCC-based compiler at -O0 on a 32-bit x86 host. + procedure Print_Statistics; + pragma Export (Ada, Print_Statistics); + -- Print various statistics on the tables maintained by the package + ---------------------------------------- -- Definitions of Fields in Tree Node -- ---------------------------------------- @@ -231,12 +235,9 @@ package Atree is function Flags_Address return System.Address; -- Return address of Flags table (used in Back_End for Gigi call) - function Num_Nodes return Nat; - -- Total number of nodes allocated, where an entity counts as a single - -- node. This count is incremented every time a node or entity is - -- allocated, and decremented every time a node or entity is deleted. - -- This value is used by Xref and by Treepr to allocate hash tables of - -- suitable size for hashing Node_Id values. + function Approx_Num_Nodes_And_Entities return Nat; + -- This is an approximation to the number of nodes and entities allocated, + -- used to determine sizes of hash tables. ----------------------- -- Use of Empty Node -- @@ -404,9 +405,8 @@ package Atree is -- place, and then for subsequent modifications as required. procedure Initialize; - -- Called at the start of compilation to initialize the allocation of - -- the node and list tables and make the standard entries for Empty, - -- Error and Error_List. + -- Called at the start of compilation to initialize the allocation of the + -- node and list tables and make the entries for Empty and Error. procedure Lock; -- Called before the back end is invoked to lock the nodes table @@ -551,7 +551,7 @@ package Atree is -- semantic chains: Homonym and Next_Entity: the corresponding links must -- be adjusted by the caller, according to context. - function Extend_Node (Node : Node_Id) return Entity_Id; + function Extend_Node (Source : Node_Id) return Entity_Id; -- This function returns a copy of its input node with an extension added. -- The fields of the extension are set to Empty. Due to the way extensions -- are handled (as four consecutive array elements), it may be necessary @@ -3843,7 +3843,8 @@ package Atree is -- Field6-11 Holds Field36-Field41 end case; - end record; + end record; -- Node_Record + pragma Suppress_Initialization (Node_Record); -- see package Nodes below pragma Pack (Node_Record); for Node_Record'Size use 8 * 32; @@ -3855,7 +3856,7 @@ package Atree is -- Default value used to initialize default nodes. Note that some of the -- fields get overwritten, and in particular, Nkind always gets reset. - Default_Node : Node_Record := ( + Default_Node : constant Node_Record := ( Is_Extension => False, Pflag1 => False, Pflag2 => False, @@ -3864,7 +3865,6 @@ package Atree is Rewrite_Ins => False, Analyzed => False, Comes_From_Source => False, - -- modified by Set_Comes_From_Source_Default Error_Posted => False, Flag4 => False, @@ -3886,7 +3886,7 @@ package Atree is Nkind => N_Unused_At_Start, - Sloc => No_Location, + Sloc => 0, Link => Empty_List_Or_Node, Field1 => Empty_List_Or_Node, Field2 => Empty_List_Or_Node, @@ -3938,17 +3938,18 @@ package Atree is Field11 => Empty_List_Or_Node, Field12 => Empty_List_Or_Node); - -- The following defines the extendable array used for the nodes table - -- Nodes with extensions use six consecutive entries in the array - - package Nodes is new Table.Table ( - Table_Component_Type => Node_Record, - Table_Index_Type => Node_Id'Base, - Table_Low_Bound => First_Node_Id, - Table_Initial => Alloc.Nodes_Initial, - Table_Increment => Alloc.Nodes_Increment, - Release_Threshold => Alloc.Nodes_Release_Threshold, - Table_Name => "Nodes"); + -- The following defines the extendable array used for the nodes table. + -- Nodes with extensions use multiple consecutive entries in the array + -- (see Num_Extension_Nodes). + + package Nodes is new Table.Table + (Table_Component_Type => Node_Record, + Table_Index_Type => Node_Id'Base, + Table_Low_Bound => First_Node_Id, + Table_Initial => Alloc.Nodes_Initial, + Table_Increment => Alloc.Nodes_Increment, + Release_Threshold => Alloc.Nodes_Release_Threshold, + Table_Name => "Nodes"); -- The following is a parallel table to Nodes, which provides 8 more -- bits of space that logically belong to the corresponding node. This diff --git a/gcc/ada/bindo-writers.adb b/gcc/ada/bindo-writers.adb index 88c8b25d312..cca6687f5f4 100644 --- a/gcc/ada/bindo-writers.adb +++ b/gcc/ada/bindo-writers.adb @@ -1561,7 +1561,7 @@ package body Bindo.Writers is begin pragma Assert (Present (Nam)); - return Bucket_Range_Type (Nam); + return Bucket_Range_Type (abs Nam); end Hash_File_Name; --------------------- diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index f00f7471de1..e8556543eef 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -118,7 +118,7 @@ package body Debug is -- d.y Disable implicit pragma Elaborate_All on task bodies -- d.z Restore previous support for frontend handling of Inline_Always - -- d.A + -- d.A Print Atree statistics -- d.B Generate a bug box on abort_statement -- d.C Generate concatenation call, do not generate inline code -- d.D Disable errors on use of overriding keyword in Ada 95 mode @@ -841,6 +841,8 @@ package body Debug is -- handling of Inline_Always by the front end on such targets. For the -- targets that do not use the GCC back end, this switch is ignored. + -- d.A Print Atree statistics + -- d.B Generate a bug box when we see an abort_statement, even though -- there is no bug. Useful for testing Comperr.Compiler_Abort: write -- some code containing an abort_statement, and compile it with diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 972d512ed44..7afe76df10c 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -6499,8 +6499,8 @@ be presented in subsequent sections. limitations: * Starting the program's execution in the debugger will cause it to - stop at the start of the ``main`` function instead of the main subprogram. - This can be worked around by manually inserting a breakpoint on that + stop at the start of the ``main`` function instead of the main subprogram. + This can be worked around by manually inserting a breakpoint on that subprogram and resuming the program's execution until reaching that breakpoint. * Programs using GNAT.Compiler_Version will not link. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index f1cdb196563..9ea261683c4 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -29,9 +29,6 @@ -- -- ------------------------------------------------------------------------------ -pragma Style_Checks (All_Checks); --- Turn off subprogram ordering, not used for this unit - with Atree; use Atree; with Elists; use Elists; with Namet; use Namet; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 1618fe666f3..760a4123216 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -5296,7 +5296,7 @@ package body Exp_Dist is function Hash (F : Name_Id) return Hash_Index is begin - return Hash_Index (Natural (F) mod Positive (Hash_Index'Last + 1)); + return Hash_Index (Integer (F) mod Positive (Hash_Index'Last + 1)); end Hash; -------------------------- diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index a5ae66ed7be..40aeef15111 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -162,12 +162,12 @@ package body Fmap is function Hash (F : File_Name_Type) return Header_Num is begin - return Header_Num (Int (F) rem Header_Num'Range_Length); + return Header_Num (Int (F) mod Header_Num'Range_Length); end Hash; function Hash (F : Unit_Name_Type) return Header_Num is begin - return Header_Num (Int (F) rem Header_Num'Range_Length); + return Header_Num (Int (F) mod Header_Num'Range_Length); end Hash; ---------------- diff --git a/gcc/ada/fname-uf.adb b/gcc/ada/fname-uf.adb index 97d3b7b9856..48e2bc24a52 100644 --- a/gcc/ada/fname-uf.adb +++ b/gcc/ada/fname-uf.adb @@ -598,7 +598,7 @@ package body Fname.UF is function SFN_Hash (F : Unit_Name_Type) return SFN_Header_Num is begin - return SFN_Header_Num (Int (F) rem SFN_Header_Num'Range_Length); + return SFN_Header_Num (Int (F) mod SFN_Header_Num'Range_Length); end SFN_Hash; begin diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 26a65fa210d..1a9cef55449 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1067,9 +1067,13 @@ begin -- Initialize all packages. For the most part, these initialization -- calls can be made in any order. Exceptions are as follows: - -- Lib.Initialize need to be called before Scan_Compiler_Arguments, + -- Lib.Initialize needs to be called before Scan_Compiler_Arguments, -- because it initializes a table filled by Scan_Compiler_Arguments. + -- Atree.Initialize needs to be called after Scan_Compiler_Arguments, + -- because the value specified by the -gnaten switch is used by + -- Atree.Initialize. + Osint.Initialize; Fmap.Reset_Tables; Lib.Initialize; @@ -1692,7 +1696,10 @@ begin end; <<End_Of_Program>> - null; + + if Debug_Flag_Dot_AA then + Atree.Print_Statistics; + end if; -- The outer exception handler handles an unrecoverable error diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index e39e0b927d2..99fd23f8c67 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -1094,6 +1094,15 @@ package body Namet is return Id in Name_Entries.First .. Name_Entries.Last; end Is_Valid_Name; + ------------------ + -- Last_Name_Id -- + ------------------ + + function Last_Name_Id return Name_Id is + begin + return Name_Id (Int (First_Name_Id) + Name_Entries_Count - 1); + end Last_Name_Id; + -------------------- -- Length_Of_Name -- -------------------- diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index ce7cac1affb..8e83eb91eee 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -437,6 +437,10 @@ package Namet is function Name_Entries_Count return Nat; -- Return current number of entries in the names table + function Last_Name_Id return Name_Id; + -- Return the last Name_Id in the table. This information is valid until + -- new names have been added. + -------------------------- -- Obsolete Subprograms -- -------------------------- diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb index 29eec045caa..ef39ed4d780 100644 --- a/gcc/ada/nlists.adb +++ b/gcc/ada/nlists.adb @@ -338,8 +338,6 @@ package body Nlists is ---------------- procedure Initialize is - E : constant List_Id := Error_List; - begin Lists.Init; Next_Node.Init; @@ -348,9 +346,9 @@ package body Nlists is -- Allocate Error_List list header Lists.Increment_Last; - Set_Parent (E, Empty); - Set_First (E, Empty); - Set_Last (E, Empty); + Set_Parent (Error_List, Empty); + Set_First (Error_List, Empty); + Set_Last (Error_List, Empty); end Initialize; ------------------ diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads index 67fc6613517..5afe27226dd 100644 --- a/gcc/ada/nlists.ads +++ b/gcc/ada/nlists.ads @@ -377,6 +377,7 @@ package Nlists is -- "if Present (Statements)" as opposed to "if Statements /= No_List". procedure Allocate_List_Tables (N : Node_Or_Entity_Id); + pragma Inline (Allocate_List_Tables); -- Called when nodes table is expanded to include node N. This call -- makes sure that list structures internal to Nlists are adjusted -- appropriately to reflect this increase in the size of the nodes table. diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 88a1ef412ad..1377de8450c 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1199,6 +1199,12 @@ package Opt is -- If a pragma No_Tagged_Streams is active for the current scope, this -- points to the corresponding pragma. + Nodes_Size_In_Meg : Nat := 0; + -- GNAT + -- Amount of memory to allocate for all nodes, in units of 2**20 bytes. + -- Set by the -gnaten switch; 0 means -gnaten was not given, and a default + -- value should be used. + Normalize_Scalars : Boolean := False; -- GNAT, GNATBIND -- Set True if a pragma Normalize_Scalars applies to the current unit. diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 3ae76cf9a5a..e935c2b50ad 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1072,7 +1072,7 @@ package body Osint is function File_Hash (F : File_Name_Type) return File_Hash_Num is begin - return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length); + return File_Hash_Num (Int (F) mod File_Hash_Num'Range_Length); end File_Hash; ----------------- diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 19fa81d8dc0..430af2ded2f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5553,11 +5553,6 @@ package body Sem_Ch8 is declare E : Entity_Id; Ematch : Entity_Id := Empty; - - Last_Name_Id : constant Name_Id := - Name_Id (Nat (First_Name_Id) + - Name_Entries_Count - 1); - begin for Nam in First_Name_Id .. Last_Name_Id loop E := Get_Name_Entity_Id (Nam); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 082f06f4b2a..065d3c6509b 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -29,9 +29,6 @@ -- -- ------------------------------------------------------------------------------ -pragma Style_Checks (All_Checks); --- No subprogram ordering check, due to logical grouping - with Atree; use Atree; package body Sinfo is diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 1816808c0cb..e086a5d9d2b 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -673,6 +673,13 @@ package body Switch.C is new String'(Switch_Chars (Ptr .. Max)); return; + -- -gnaten (memory to allocate for nodes) + + when 'n' => + Ptr := Ptr + 1; + Scan_Pos + (Switch_Chars, Max, Ptr, Nodes_Size_In_Meg, C); + -- -gnateO= (object path file) -- This is an internal switch diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index e76b138efb4..d902ab820df 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -869,6 +869,8 @@ package body Treepr is ---------------- procedure Print_Init is + Max_Hash_Entries : constant Nat := + Approx_Num_Nodes_And_Entities + Num_Lists + Num_Elists; begin Printing_Descendants := True; Write_Eol; @@ -877,7 +879,7 @@ package body Treepr is -- the maximum possible number of entries, so that the hash table -- cannot get significantly overloaded. - Hash_Table_Len := (150 * (Num_Nodes + Num_Lists + Num_Elists)) / 100; + Hash_Table_Len := (150 * Max_Hash_Entries) / 100; Hash_Table := new Hash_Table_Type (0 .. Hash_Table_Len - 1); for J in Hash_Table'Range loop diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 6a1d94db8b0..4e917cd26ea 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -265,97 +265,86 @@ package Types is -- These types are represented as integer indices into various tables. -- However, they should be treated as private, except in a few documented - -- cases. In particular it is never appropriate to perform arithmetic - -- operations using these types. + -- cases. In particular it is usually inappropriate to perform arithmetic + -- operations using these types. One exception is in computing hash + -- functions of these types. -- In most contexts, the strongly typed interface determines which of these -- types is present. However, there are some situations (involving untyped -- traversals of the tree), where it is convenient to be easily able to -- distinguish these values. The underlying representation in all cases is -- an integer type Union_Id, and we ensure that the range of the various - -- possible values for each of the above types is disjoint so that this - -- distinction is possible. + -- possible values for each of the above types is disjoint (except that + -- List_Id and Node_Id overlap at Empty) so that this distinction is + -- possible. -- Note: it is also helpful for debugging purposes to make these ranges -- distinct. If a bug leads to misidentification of a value, then it will -- typically result in an out of range value and a Constraint_Error. + -- The range of Node_Id is most of the nonnegative integers. The other + -- ranges are negative. Uint has a very large range, because a substantial + -- part of this range is used to store direct values; see Uintp for + -- details. The other types have 100 million values, which should be + -- plenty. + type Union_Id is new Int; -- The type in the tree for a union of possible ID values - List_Low_Bound : constant := -100_000_000; + -- Following are the Low and High bounds of the various ranges. + + List_Low_Bound : constant := -099_999_999; -- The List_Id values are subscripts into an array of list headers which - -- has List_Low_Bound as its lower bound. This value is chosen so that all - -- List_Id values are negative, and the value zero is in the range of both - -- List_Id and Node_Id values (see further description below). + -- has List_Low_Bound as its lower bound. List_High_Bound : constant := 0; - -- Maximum List_Id subscript value. This allows up to 100 million list Id - -- values, which is in practice infinite, and there is no need to check the - -- range. The range overlaps the node range by one element (with value - -- zero), which is used both for the Empty node, and for indicating no - -- list. The fact that the same value is used is convenient because it - -- means that the default value of Empty applies to both nodes and lists, - -- and also is more efficient to test for. + -- Maximum List_Id subscript value. The ranges of List_Id and Node_Id + -- overlap by one element (with value zero), which is used both for the + -- Empty node, and for No_List. The fact that the same value is used is + -- convenient because it means that the default value of Empty applies to + -- both nodes and lists, and also is more efficient to test for. Node_Low_Bound : constant := 0; -- The tree Id values start at zero, because we use zero for Empty (to - -- allow a zero test for Empty). Actual tree node subscripts start at 0 - -- since Empty is a legitimate node value. + -- allow a zero test for Empty). - Node_High_Bound : constant := 099_999_999; - -- Maximum number of nodes that can be allocated is 100 million, which - -- is in practice infinite, and there is no need to check the range. + Node_High_Bound : constant := + (if Standard'Address_Size = 32 then 299_999_999 else 1_999_999_999); - Elist_Low_Bound : constant := 100_000_000; + Elist_Low_Bound : constant := -199_999_999; -- The Elist_Id values are subscripts into an array of elist headers which -- has Elist_Low_Bound as its lower bound. - Elist_High_Bound : constant := 199_999_999; - -- Maximum Elist_Id subscript value. This allows up to 100 million Elists, - -- which is in practice infinite and there is no need to check the range. + Elist_High_Bound : constant := -100_000_000; - Elmt_Low_Bound : constant := 200_000_000; + Elmt_Low_Bound : constant := -299_999_999; -- Low bound of element Id values. The use of these values is internal to -- the Elists package, but the definition of the range is included here -- since it must be disjoint from other Id values. The Elmt_Id values are -- subscripts into an array of list elements which has this as lower bound. - Elmt_High_Bound : constant := 299_999_999; - -- Upper bound of Elmt_Id values. This allows up to 100 million element - -- list members, which is in practice infinite (no range check needed). + Elmt_High_Bound : constant := -200_000_000; - Names_Low_Bound : constant := 300_000_000; - -- Low bound for name Id values + Names_Low_Bound : constant := -399_999_999; - Names_High_Bound : constant := 399_999_999; - -- Maximum number of names that can be allocated is 100 million, which is - -- in practice infinite and there is no need to check the range. + Names_High_Bound : constant := -300_000_000; - Strings_Low_Bound : constant := 400_000_000; - -- Low bound for string Id values + Strings_Low_Bound : constant := -499_999_999; - Strings_High_Bound : constant := 499_999_999; - -- Maximum number of strings that can be allocated is 100 million, which - -- is in practice infinite and there is no need to check the range. + Strings_High_Bound : constant := -400_000_000; - Ureal_Low_Bound : constant := 500_000_000; - -- Low bound for Ureal values + Ureal_Low_Bound : constant := -599_999_999; - Ureal_High_Bound : constant := 599_999_999; - -- Maximum number of Ureal values stored is 100_000_000 which is in - -- practice infinite so that no check is required. + Ureal_High_Bound : constant := -500_000_000; - Uint_Low_Bound : constant := 600_000_000; + Uint_Low_Bound : constant := -2_100_000_000; -- Low bound for Uint values - Uint_Table_Start : constant := 2_000_000_000; + Uint_Table_Start : constant := -699_999_999; -- Location where table entries for universal integers start (see -- Uintp spec for details of the representation of Uint values). - Uint_High_Bound : constant := 2_099_999_999; - -- The range of Uint values is very large, since a substantial part - -- of this range is used to store direct values, see Uintp for details. + Uint_High_Bound : constant := -600_000_000; -- The following subtype definitions are used to provide convenient names -- for membership tests on Int values to see what data type range they diff --git a/gcc/ada/types.h b/gcc/ada/types.h index e7eeae0b4ca..76cf950ae93 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -150,30 +150,32 @@ typedef int Union_Id; /* Range definitions for Tree Data: */ -#define List_Low_Bound -100000000 +#define List_Low_Bound -99999999 #define List_High_Bound 0 #define Node_Low_Bound 0 -#define Node_High_Bound 99999999 +#define Node_High_Bound 1999999999 +/* Above is the correct value of Node_High_Bound for 64-bit machines. It is + wrong for 32-bit machines, but that doesn't matter. */ -#define Elist_Low_Bound 100000000 -#define Elist_High_Bound 199999999 +#define Elist_Low_Bound -199999999 +#define Elist_High_Bound -100000000 -#define Elmt_Low_Bound 200000000 -#define Elmt_High_Bound 299999999 +#define Elmt_Low_Bound -299999999 +#define Elmt_High_Bound -200000000 -#define Names_Low_Bound 300000000 -#define Names_High_Bound 399999999 +#define Names_Low_Bound -399999999 +#define Names_High_Bound -300000000 -#define Strings_Low_Bound 400000000 -#define Strings_High_Bound 499999999 +#define Strings_Low_Bound -499999999 +#define Strings_High_Bound -400000000 -#define Ureal_Low_Bound 500000000 -#define Ureal_High_Bound 599999999 +#define Ureal_Low_Bound -599999999 +#define Ureal_High_Bound -500000000 -#define Uint_Low_Bound 600000000 -#define Uint_Table_Start 2000000000 -#define Uint_High_Bound 2099999999 +#define Uint_Low_Bound -2100000000 +#define Uint_Table_Start -699999999 +#define Uint_High_Bound -600000000 SUBTYPE (List_Range, Int, List_Low_Bound, List_High_Bound) SUBTYPE (Node_Range, Int, Node_Low_Bound, Node_High_Bound) |