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;
---------------------------
-- 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, "__");
end if;
IS_Nam := Name_Find (Buffer);
- return Bucket_Range_Type (IS_Nam);
+ return Bucket_Range_Type (abs IS_Nam);
end Hash;
--------------------
-- 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
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
-- 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,
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
-- 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 --
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.
-- 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 --
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;
-- 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;
-----------------
-----------------
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
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;
-----------------
pragma Warnings (Off, Dummy);
begin
- Node_Count := 0;
Atree_Private_Part.Nodes.Init;
Atree_Private_Part.Flags.Init;
Orig_Nodes.Init;
-- 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;
--------------
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;
(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;
--------------
(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;
-------------------------
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 --
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 --
-------------
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;
---------------
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;
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 --
----------------
procedure Unlock is
begin
- Nodes.Locked := False;
Flags.Locked := False;
Orig_Nodes.Locked := False;
end Unlock;
-- 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
-- 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 --
----------------------------------------
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 --
-- 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
-- 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
-- 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;
-- 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,
Rewrite_Ins => False,
Analyzed => False,
Comes_From_Source => False,
- -- modified by Set_Comes_From_Source_Default
Error_Posted => False,
Flag4 => False,
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,
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
begin
pragma Assert (Present (Nam));
- return Bucket_Range_Type (Nam);
+ return Bucket_Range_Type (abs Nam);
end Hash_File_Name;
---------------------
-- 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
-- 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
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.
-- --
------------------------------------------------------------------------------
-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;
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;
--------------------------
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;
----------------
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
-- 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;
end;
<<End_Of_Program>>
- null;
+
+ if Debug_Flag_Dot_AA then
+ Atree.Print_Statistics;
+ end if;
-- The outer exception handler handles an unrecoverable error
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 --
--------------------
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 --
--------------------------
----------------
procedure Initialize is
- E : constant List_Id := Error_List;
-
begin
Lists.Init;
Next_Node.Init;
-- 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;
------------------
-- "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.
-- 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.
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;
-----------------
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);
-- --
------------------------------------------------------------------------------
-pragma Style_Checks (All_Checks);
--- No subprogram ordering check, due to logical grouping
-
with Atree; use Atree;
package body Sinfo 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
----------------
procedure Print_Init is
+ Max_Hash_Entries : constant Nat :=
+ Approx_Num_Nodes_And_Entities + Num_Lists + Num_Elists;
begin
Printing_Descendants := True;
Write_Eol;
-- 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
-- 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
/* 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)
projects / gcc.git / commitdiff