aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/accessibility.adb38
-rw-r--r--gcc/ada/atree.adb210
-rw-r--r--gcc/ada/einfo-utils.adb6
-rw-r--r--gcc/ada/einfo-utils.ads6
-rw-r--r--gcc/ada/frontend.adb2
-rw-r--r--gcc/ada/gen_il-gen-gen_entities.adb27
-rw-r--r--gcc/ada/gen_il-types.ads1
-rw-r--r--gcc/ada/sem.adb1
-rw-r--r--gcc/ada/sem.ads3
-rw-r--r--gcc/ada/sem_ch8.adb5
-rw-r--r--gcc/ada/sem_ch8.ads5
-rw-r--r--gcc/ada/sem_util.adb8
-rw-r--r--gcc/ada/sem_util.ads3
13 files changed, 231 insertions, 84 deletions
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index bc897d1..bc217be 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -119,8 +119,9 @@ package body Accessibility is
is
Loc : constant Source_Ptr := Sloc (Expr);
- function Accessibility_Level (Expr : Node_Id) return Node_Id
- is (Accessibility_Level (Expr, Level, In_Return_Context));
+ function Accessibility_Level (Expr : Node_Id) return Node_Id is
+ (Accessibility_Level
+ (Expr, Level, In_Return_Context, Allow_Alt_Model));
-- Renaming of the enclosing function to facilitate recursive calls
function Make_Level_Literal (Level : Uint) return Node_Id;
@@ -164,7 +165,19 @@ package body Accessibility is
Ent := Defining_Entity_Or_Empty (Node_Par);
if Present (Ent) then
- Encl_Scop := Find_Enclosing_Scope (Ent);
+ -- X'Old is nested within the current subprogram, so we do not
+ -- want Find_Enclosing_Scope of that subprogram. If this is an
+ -- allocator, then we're looking for the innermost master of
+ -- the call, so again we do not want Find_Enclosing_Scope.
+
+ if (Nkind (N) = N_Attribute_Reference
+ and then Attribute_Name (N) = Name_Old)
+ or else Nkind (N) = N_Allocator
+ then
+ Encl_Scop := Ent;
+ else
+ Encl_Scop := Find_Enclosing_Scope (Ent);
+ end if;
-- Ignore transient scopes made during expansion while also
-- taking into account certain expansions - like iterators
@@ -177,17 +190,13 @@ package body Accessibility is
then
-- Note that in some rare cases the scope depth may not be
-- set, for example, when we are in the middle of analyzing
- -- a type and the enclosing scope is said type. So, instead,
- -- continue to move up the parent chain since the scope
- -- depth of the type's parent is the same as that of the
- -- type.
-
- if not Scope_Depth_Set (Encl_Scop) then
- pragma Assert (Nkind (Parent (Encl_Scop))
- = N_Full_Type_Declaration);
+ -- a type and the enclosing scope is said type. In that case
+ -- simply return zero for the outermost scope.
+
+ if Scope_Depth_Set (Encl_Scop) then
+ return Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
else
- return
- Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
+ return Uint_0;
end if;
end if;
@@ -424,7 +433,7 @@ package body Accessibility is
when N_Aggregate =>
return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
- -- The accessibility level is that of the access type, except for an
+ -- The accessibility level is that of the access type, except for
-- anonymous allocators which have special rules defined in RM 3.10.2
-- (14/3).
@@ -472,6 +481,7 @@ package body Accessibility is
and then Present (Get_Dynamic_Accessibility (Entity (Pre)))
and then Level = Dynamic_Level
then
+ pragma Assert (Is_Anonymous_Access_Type (Etype (Pre)));
return New_Occurrence_Of
(Get_Dynamic_Accessibility (Entity (Pre)), Loc);
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 5597d16..8e4c443 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -33,6 +33,8 @@ with Output; use Output;
with Sinfo.Utils; use Sinfo.Utils;
with System.Storage_Elements;
+with GNAT.Table;
+
package body Atree is
---------------
@@ -900,10 +902,7 @@ package body Atree is
function Get_Field_Value
(N : Node_Id; Field : Node_Or_Entity_Field) return Field_Size_32_Bit
is
- pragma Assert
- (if Field /= F_Scope_Depth_Value then -- ???Temporarily disable check
- Field_Checking.Field_Present (N, Field));
- -- Assert partially disabled because it fails in rare cases
+ pragma Assert (Field_Checking.Field_Present (N, Field));
Desc : Field_Descriptor renames Field_Descriptors (Field);
NN : constant Node_Or_Entity_Id := Node_To_Fetch_From (N, Field);
@@ -2889,6 +2888,34 @@ package body Atree is
Node_Counts : array (Node_Kind) of Count := (others => 0);
Entity_Counts : array (Entity_Kind) of Count := (others => 0);
+ -- We put the Node_Kinds and Entity_Kinds into a table just because
+ -- GNAT.Table has a handy sort procedure. We're sorting in decreasing
+ -- order of Node_Counts, for printing.
+
+ package Node_Kind_Table is new GNAT.Table
+ (Table_Component_Type => Node_Kind,
+ Table_Index_Type => Pos,
+ Table_Low_Bound => Pos'First,
+ Table_Initial => 8,
+ Table_Increment => 100
+ );
+ function Higher_Count (X, Y : Node_Kind) return Boolean is
+ (Node_Counts (X) > Node_Counts (Y));
+ procedure Sort_Node_Kind_Table is new
+ Node_Kind_Table.Sort_Table (Lt => Higher_Count);
+
+ package Entity_Kind_Table is new GNAT.Table
+ (Table_Component_Type => Entity_Kind,
+ Table_Index_Type => Pos,
+ Table_Low_Bound => Pos'First,
+ Table_Initial => 8,
+ Table_Increment => 100
+ );
+ function Higher_Count (X, Y : Entity_Kind) return Boolean is
+ (Entity_Counts (X) > Entity_Counts (Y));
+ procedure Sort_Entity_Kind_Table is new
+ Entity_Kind_Table.Sort_Table (Lt => Higher_Count);
+
All_Node_Offsets : Node_Offsets.Table_Type renames
Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last);
begin
@@ -2897,6 +2924,8 @@ package body Atree is
Write_Int (Int (Slots.Last));
Write_Line (" non-header slots");
+ -- Count up the number of each kind of node and entity
+
for N in All_Node_Offsets'Range loop
declare
K : constant Node_Kind := Nkind (N);
@@ -2910,44 +2939,95 @@ package body Atree is
end;
end loop;
+ -- Copy kinds to tables, and sort:
+
for K in Node_Kind loop
- declare
- Count : constant Nat_64 := Node_Counts (K);
- begin
- Write_Int_64 (Count);
- Write_Ratio (Count, Int_64 (Node_Offsets.Last));
- Write_Str (" ");
- Write_Str (Node_Kind'Image (K));
- Write_Str (" ");
- Write_Int (Int (Sinfo.Nodes.Size (K)));
- Write_Str (" slots");
- Write_Eol;
- end;
+ Node_Kind_Table.Append (K);
end loop;
+ Sort_Node_Kind_Table;
for K in Entity_Kind loop
- declare
- Count : constant Nat_64 := Entity_Counts (K);
- begin
- Write_Int_64 (Count);
- Write_Ratio (Count, Int_64 (Node_Offsets.Last));
- Write_Str (" ");
- Write_Str (Entity_Kind'Image (K));
- Write_Str (" ");
- Write_Int (Int (Einfo.Entities.Size (K)));
- Write_Str (" slots");
- Write_Eol;
- end;
+ Entity_Kind_Table.Append (K);
end loop;
+ Sort_Entity_Kind_Table;
+
+ -- Print out the counts for each kind in decreasing order. Exit the loop
+ -- if we see a zero count, because all the rest must be zero, and the
+ -- zero ones are boring.
+
+ declare
+ use Node_Kind_Table;
+ -- Note: the full qualification of First below is needed for
+ -- bootstrap builds.
+ Table : Table_Type renames Node_Kind_Table.Table
+ (Node_Kind_Table.First .. Last);
+ begin
+ for J in Table'Range loop
+ declare
+ K : constant Node_Kind := Table (J);
+ Count : constant Nat_64 := Node_Counts (K);
+ begin
+ exit when Count = 0; -- skip the rest
+
+ Write_Int_64 (Count);
+ Write_Ratio (Count, Int_64 (Node_Offsets.Last));
+ Write_Str (" ");
+ Write_Str (Node_Kind'Image (K));
+ Write_Str (" ");
+ Write_Int (Int (Sinfo.Nodes.Size (K)));
+ Write_Str (" slots");
+ Write_Eol;
+ end;
+ end loop;
+ end;
+
+ declare
+ use Entity_Kind_Table;
+ -- Note: the full qualification of First below is needed for
+ -- bootstrap builds.
+ Table : Table_Type renames Entity_Kind_Table.Table
+ (Entity_Kind_Table.First .. Last);
+ begin
+ for J in Table'Range loop
+ declare
+ K : constant Entity_Kind := Table (J);
+ Count : constant Nat_64 := Entity_Counts (K);
+ begin
+ exit when Count = 0; -- skip the rest
+
+ Write_Int_64 (Count);
+ Write_Ratio (Count, Int_64 (Node_Offsets.Last));
+ Write_Str (" ");
+ Write_Str (Entity_Kind'Image (K));
+ Write_Str (" ");
+ Write_Int (Int (Einfo.Entities.Size (K)));
+ Write_Str (" slots");
+ Write_Eol;
+ end;
+ end loop;
+ end;
end Print_Node_Statistics;
procedure Print_Field_Statistics is
Total, G_Total, S_Total : Call_Count := 0;
+
+ -- Use a table for sorting, as done in Print_Node_Statistics.
+
+ package Field_Table is new GNAT.Table
+ (Table_Component_Type => Node_Or_Entity_Field,
+ Table_Index_Type => Pos,
+ Table_Low_Bound => Pos'First,
+ Table_Initial => 8,
+ Table_Increment => 100
+ );
+ function Higher_Count (X, Y : Node_Or_Entity_Field) return Boolean is
+ (Get_Count (X) + Set_Count (X) > Get_Count (Y) + Set_Count (Y));
+ procedure Sort_Field_Table is new
+ Field_Table.Sort_Table (Lt => Higher_Count);
begin
Write_Int_64 (Get_Original_Node_Count);
Write_Str (" + ");
Write_Int_64 (Set_Original_Node_Count);
- Write_Eol;
Write_Line (" Original_Node_Count getter and setter calls");
Write_Eol;
@@ -2970,32 +3050,55 @@ package body Atree is
Write_Int_64 (S_Total);
Write_Line (" total getter and setter calls");
- for Field in Node_Or_Entity_Field loop
- declare
- G : constant Call_Count := Get_Count (Field);
- S : constant Call_Count := Set_Count (Field);
- GS : constant Call_Count := G + S;
-
- Desc : Field_Descriptor renames Field_Descriptors (Field);
- Slot : constant Field_Offset :=
- (Field_Size (Desc.Kind) * Desc.Offset) / Slot_Size;
+ -- Copy fields to the table, and sort:
- begin
- Write_Int_64 (GS);
- Write_Ratio (GS, Total);
- Write_Str (" = ");
- Write_Int_64 (G);
- Write_Str (" + ");
- Write_Int_64 (S);
- Write_Str (" ");
- Write_Str (Node_Or_Entity_Field'Image (Field));
- Write_Str (" in slot ");
- Write_Int (Int (Slot));
- Write_Str (" size ");
- Write_Int (Int (Field_Size (Desc.Kind)));
- Write_Eol;
- end;
+ for F in Node_Or_Entity_Field loop
+ Field_Table.Append (F);
end loop;
+ Sort_Field_Table;
+
+ -- Print out the counts for each field in decreasing order of
+ -- getter+setter sum. As in Print_Node_Statistics, exit the loop
+ -- if we see a zero sum.
+
+ declare
+ use Field_Table;
+ -- Note: the full qualification of First below is needed for
+ -- bootstrap builds.
+ Table : Table_Type renames
+ Field_Table.Table (Field_Table.First .. Last);
+ begin
+ for J in Table'Range loop
+ declare
+ Field : constant Node_Or_Entity_Field := Table (J);
+
+ G : constant Call_Count := Get_Count (Field);
+ S : constant Call_Count := Set_Count (Field);
+ GS : constant Call_Count := G + S;
+
+ Desc : Field_Descriptor renames Field_Descriptors (Field);
+ Slot : constant Field_Offset :=
+ (Field_Size (Desc.Kind) * Desc.Offset) / Slot_Size;
+
+ begin
+ exit when GS = 0; -- skip the rest
+
+ Write_Int_64 (GS);
+ Write_Ratio (GS, Total);
+ Write_Str (" = ");
+ Write_Int_64 (G);
+ Write_Str (" + ");
+ Write_Int_64 (S);
+ Write_Str (" ");
+ Write_Str (Node_Or_Entity_Field'Image (Field));
+ Write_Str (" in slot ");
+ Write_Int (Int (Slot));
+ Write_Str (" size ");
+ Write_Int (Int (Field_Size (Desc.Kind)));
+ Write_Eol;
+ end;
+ end loop;
+ end;
end Print_Field_Statistics;
procedure Print_Statistics is
@@ -3003,6 +3106,7 @@ package body Atree is
Write_Eol;
Write_Eol;
Print_Node_Statistics;
+ Write_Eol;
Print_Field_Statistics;
end Print_Statistics;
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index cb9a00d..9bee1f4 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -2589,7 +2589,7 @@ package body Einfo.Utils is
-- Scope_Depth --
-----------------
- function Scope_Depth (Id : E) return Uint is
+ function Scope_Depth (Id : Scope_Kind_Id) return Uint is
Scop : Entity_Id;
begin
@@ -2601,7 +2601,7 @@ package body Einfo.Utils is
return Scope_Depth_Value (Scop);
end Scope_Depth;
- function Scope_Depth_Default_0 (Id : E) return U is
+ function Scope_Depth_Default_0 (Id : Scope_Kind_Id) return U is
begin
if Scope_Depth_Set (Id) then
return Scope_Depth (Id);
@@ -2615,7 +2615,7 @@ package body Einfo.Utils is
-- Scope_Depth_Set --
---------------------
- function Scope_Depth_Set (Id : E) return B is
+ function Scope_Depth_Set (Id : Scope_Kind_Id) return B is
begin
return not Is_Record_Type (Id)
and then not Field_Is_Initial_Zero (Id, F_Scope_Depth_Value);
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
index 20ca470..21a8891 100644
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -242,10 +242,10 @@ package Einfo.Utils is
function Type_Low_Bound (Id : E) return N with Inline;
function Underlying_Type (Id : E) return Entity_Id;
- function Scope_Depth (Id : E) return U with Inline;
- function Scope_Depth_Set (Id : E) return B with Inline;
+ function Scope_Depth (Id : Scope_Kind_Id) return U with Inline;
+ function Scope_Depth_Set (Id : Scope_Kind_Id) return B with Inline;
- function Scope_Depth_Default_0 (Id : E) return U;
+ function Scope_Depth_Default_0 (Id : Scope_Kind_Id) return U;
-- In rare cases, the Scope_Depth_Value (queried by Scope_Depth) is
-- not correctly set before querying it; this may be used instead of
-- Scope_Depth in such cases. It returns Uint_0 if the Scope_Depth_Value
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index f2faa09..eb9378d 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -565,6 +565,4 @@ begin
if Mapping_File_Name /= null then
Fmap.Update_Mapping_File (Mapping_File_Name.all);
end if;
-
- return;
end Frontend;
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index f980ba2..3e6ed96 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -1423,4 +1423,31 @@ begin -- Gen_IL.Gen.Gen_Entities
E_Subprogram_Body,
E_Subprogram_Type));
+ -- Entities that represent scopes. These can be on the scope stack,
+ -- and Scope_Depth can be queried. These are the kinds that have
+ -- the Scope_Depth_Value attribute, plus Record_Kind, which has
+ -- a synthesized Scope_Depth.
+
+ Union (Scope_Kind,
+ Children =>
+ (E_Void,
+ E_Private_Type,
+ E_Private_Subtype,
+ E_Limited_Private_Type,
+ E_Limited_Private_Subtype,
+ Concurrent_Kind,
+ Subprogram_Kind,
+ E_Entry,
+ E_Entry_Family,
+ E_Block,
+ Generic_Unit_Kind,
+ E_Loop,
+ E_Return_Statement,
+ E_Package,
+ E_Package_Body,
+ E_Subprogram_Body,
+ Record_Kind,
+ E_Incomplete_Type,
+ E_Subprogram_Type));
+
end Gen_IL.Gen.Gen_Entities;
diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads
index be6ba52..be389eb 100644
--- a/gcc/ada/gen_il-types.ads
+++ b/gcc/ada/gen_il-types.ads
@@ -177,6 +177,7 @@ package Gen_IL.Types is
Record_Kind,
Record_Field_Kind,
Scalar_Kind,
+ Scope_Kind,
Signed_Integer_Kind,
Subprogram_Type_Or_Kind,
Subprogram_Kind,
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 3bff8d2..0356ffc 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -27,7 +27,6 @@ with Atree; use Atree;
with Debug; use Debug;
with Debug_A; use Debug_A;
with Einfo; use Einfo;
-with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
with Exp_SPARK; use Exp_SPARK;
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 19abbf1..10d4bd2 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -201,6 +201,7 @@
-- called Preanalyze_And_Resolve and is in Sem_Res.
with Alloc;
+with Einfo.Entities; use Einfo.Entities;
with Opt; use Opt;
with Table;
with Types; use Types;
@@ -485,7 +486,7 @@ package Sem is
-- configuration file.
type Scope_Stack_Entry is record
- Entity : Entity_Id;
+ Entity : Scope_Kind_Id;
-- Entity representing the scope
Last_Subprogram_Name : String_Ptr;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 6e0db36..3c55cb6 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -26,7 +26,6 @@
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
-with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
with Errout; use Errout;
@@ -9301,7 +9300,7 @@ package body Sem_Ch8 is
procedure Pop_Scope is
SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last);
- S : constant Entity_Id := SST.Entity;
+ S : constant Scope_Kind_Id := SST.Entity;
begin
if Debug_Flag_E then
@@ -9363,7 +9362,7 @@ package body Sem_Ch8 is
-- Push_Scope --
----------------
- procedure Push_Scope (S : Entity_Id) is
+ procedure Push_Scope (S : Scope_Kind_Id) is
E : constant Entity_Id := Scope (S);
function Component_Alignment_Default return Component_Alignment_Kind;
diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads
index 87323e0..246ab87 100644
--- a/gcc/ada/sem_ch8.ads
+++ b/gcc/ada/sem_ch8.ads
@@ -23,7 +23,8 @@
-- --
------------------------------------------------------------------------------
-with Types; use Types;
+with Einfo.Entities; use Einfo.Entities;
+with Types; use Types;
package Sem_Ch8 is
-----------------------------------
@@ -148,7 +149,7 @@ package Sem_Ch8 is
-- Mark a given entity or node Id's relevant use clauses as effective,
-- including redundant ones and ones outside of the current scope.
- procedure Push_Scope (S : Entity_Id);
+ procedure Push_Scope (S : Scope_Kind_Id);
-- Make new scope stack entry, pushing S, the entity for a scope onto the
-- top of the scope table. The current setting of the scope suppress flags
-- is saved for restoration on exit.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cc9dcb3..e778bab 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8938,10 +8938,16 @@ package body Sem_Util is
-- Find_Enclosing_Scope --
--------------------------
- function Find_Enclosing_Scope (N : Node_Id) return Entity_Id is
+ function Find_Enclosing_Scope (N : Node_Id) return Scope_Kind_Id is
Par : Node_Id;
begin
+ -- If N is an entity, simply return its Scope
+
+ if Nkind (N) in N_Entity then
+ return Scope (N);
+ end if;
+
-- Examine the parent chain looking for a construct which defines a
-- scope.
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b56a235..92016bc 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -889,7 +889,8 @@ package Sem_Util is
-- such a loop exists, return the entity of its identifier (E_Loop scope),
-- otherwise return Empty.
- function Find_Enclosing_Scope (N : Node_Id) return Entity_Id;
+ function Find_Enclosing_Scope (N : Node_Id) return Scope_Kind_Id with
+ Post => Find_Enclosing_Scope'Result /= N;
-- Find the nearest scope which encloses arbitrary node N
function Find_Loop_In_Conditional_Block (N : Node_Id) return Node_Id;
generated by cgit v1.1 at 2025-10-17 19:14:02 +0000