aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ali-util.adb2
-rw-r--r--gcc/ada/ali.adb5
-rw-r--r--gcc/ada/atree.adb329
-rw-r--r--gcc/ada/atree.ads53
-rw-r--r--gcc/ada/bindo-writers.adb2
-rw-r--r--gcc/ada/debug.adb4
-rw-r--r--gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst4
-rw-r--r--gcc/ada/einfo.adb3
-rw-r--r--gcc/ada/exp_dist.adb2
-rw-r--r--gcc/ada/fmap.adb4
-rw-r--r--gcc/ada/fname-uf.adb2
-rw-r--r--gcc/ada/gnat1drv.adb11
-rw-r--r--gcc/ada/namet.adb9
-rw-r--r--gcc/ada/namet.ads4
-rw-r--r--gcc/ada/nlists.adb8
-rw-r--r--gcc/ada/nlists.ads1
-rw-r--r--gcc/ada/opt.ads6
-rw-r--r--gcc/ada/osint.adb2
-rw-r--r--gcc/ada/sem_ch8.adb5
-rw-r--r--gcc/ada/sinfo.adb3
-rw-r--r--gcc/ada/switch-c.adb7
-rw-r--r--gcc/ada/treepr.adb4
-rw-r--r--gcc/ada/types.ads85
-rw-r--r--gcc/ada/types.h32
24 files changed, 317 insertions, 270 deletions
diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb
index ec7ec2f..9dcc656 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 6b0d6c7..3bf1257 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 7e05a48..982742c 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 e958a9b..2787535 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 88c8b25..cca6687 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 f00f747..e855654 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 972d512..7afe76d 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 f1cdb19..9ea2616 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 1618fe6..760a412 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 a5ae66e..40aeef1 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 97d3b7b..48e2bc2 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 26a65fa..1a9cef5 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 e39e0b9..99fd23f 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 ce7cac1..8e83eb91 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 29eec04..ef39ed4 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 67fc661..5afe272 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 88a1ef4..1377de8 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 3ae76cf..e935c2b 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 19fa81d..430af2d 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 082f06f..065d3c6 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 1816808..e086a5d 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 e76b138..d902ab8 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 6a1d94d..4e917cd 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 e7eeae0..76cf950 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)
generated by cgit v1.1 at 2024-11-06 08:08:03 +0000