[Ada] Fix link from body protected entry implementation to source code

Message ID 20210507093823.GA140811@adacore.com
State New
Headers show
  • [Ada] Fix link from body protected entry implementation to source code
Related show

Commit Message

Pierre-Marie de Rodat May 7, 2021, 9:38 a.m.
CodePeer needs to recognize internally generated procedures that
implement protected entries. Previously this was done with an extra
field in the procedure entity; now it is done with an extra field in the
procedure body.

The new field bypasses the trouble with the procedure entity changing
its type from E_Void to E_Procedure to E_Subprogram_Body. Also, it is
closer to similar flags like Is_Protected_Subprogram_Body and

Finally, the new field links bodies just like the old field linked

Tested on x86_64-pc-linux-gnu, committed on trunk


	* einfo.ads: Move Corresponding_Protected_Entry...
	* sinfo.ads: ... here.
	* exp_ch9.adb (Build_Entry_Body): Link procedure and entry
	* gen_il-fields.ads (Opt_Field_Enum): Add
	Corresponding_Entry_Body field to nodes; remove
	Corresponding_Protected_Entry field from entities.
	* gen_il-gen-gen_entities.adb (Gen_Entities): Remove
	Corresponding_Protected_Entry field from E_Void and
	* gen_il-gen-gen_nodes.adb (Gen_Nodes): Add
	Corresponding_Entry_Body field to N_Subprogram_Body.
	* sem_ch6.adb (Analyze_Subprogram_Specification): Remove
	manipulation of Ekind and Corresponding_Protected_Entry added as
	part of the support for varsize-nodes.


diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -786,10 +786,6 @@  package Einfo is
 --       Modify_Tree_For_C is set. Denotes the internally built procedure
 --       with an extra out parameter created for it.
---    Corresponding_Protected_Entry (Node18)
---       Defined in subprogram bodies. Set for subprogram bodies that implement
---       a protected type entry to point to the entity for the entry.
 --    Corresponding_Record_Component (Node21)
 --       Defined in components of a derived untagged record type, including
 --       discriminants. For a regular component or a girder discriminant,

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -3779,10 +3779,6 @@  package body Exp_Ch9 is
                raise Program_Error;
          end case;
-         --  Establish link between subprogram body entity and source entry
-         Set_Corresponding_Protected_Entry (Bod_Id, Ent);
          --  Create body of entry procedure. The renaming declarations are
          --  placed ahead of the block that contains the actual entry body.
@@ -3816,6 +3812,10 @@  package body Exp_Ch9 is
                                  (RTE (RE_Get_GNAT_Exception), Loc)))))))));
+         --  Establish link between subprogram body and source entry body
+         Set_Corresponding_Entry_Body (Proc_Body, N);
          Reset_Scopes_To (Proc_Body, Protected_Body_Subprogram (Ent));
          return Proc_Body;
       end if;

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -113,6 +113,7 @@  package Gen_IL.Fields is
+      Corresponding_Entry_Body,
@@ -464,7 +465,6 @@  package Gen_IL.Fields is
-      Corresponding_Protected_Entry,

diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -244,7 +244,6 @@  begin -- Gen_IL.Gen.Gen_Entities
         Sm (Scope_Depth_Value, Uint),
         Sm (SPARK_Pragma, Node_Id),
         Sm (SPARK_Pragma_Inherited, Flag),
-        Sm (Corresponding_Protected_Entry, Node_Id), -- setter only
         Sm (Current_Value, Node_Id), -- setter only
         Sm (Has_Predicates, Flag), -- setter only
         Sm (Initialization_Statements, Node_Id), -- setter only
@@ -1245,7 +1244,6 @@  begin -- Gen_IL.Gen.Gen_Entities
    Cc (E_Subprogram_Body, Entity_Kind,
        (Sm (Anonymous_Masters, Elist_Id),
         Sm (Contract, Node_Id),
-        Sm (Corresponding_Protected_Entry, Node_Id),
         Sm (Extra_Formals, Node_Id),
         Sm (First_Entity, Node_Id),
         Sm (Ignore_SPARK_Mode_Pragmas, Flag),

diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -790,6 +790,7 @@  begin -- Gen_IL.Gen.Gen_Nodes
         Sy (Bad_Is_Detected, Flag),
         Sm (Activation_Chain_Entity, Node_Id),
         Sm (Acts_As_Spec, Flag),
+        Sm (Corresponding_Entry_Body, Node_Id),
         Sm (Do_Storage_Check, Flag),
         Sm (Has_Relative_Deadline_Pragma, Flag),
         Sm (Is_Entry_Barrier_Function, Flag),

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -5789,21 +5789,8 @@  package body Sem_Ch6 is
       if Nkind (N) = N_Function_Specification then
          Set_Ekind (Designator, E_Function);
          Set_Mechanism (Designator, Default_Mechanism);
-         case Ekind (Designator) is
-            when E_Subprogram_Body | E_Void =>
-               Reinit_Field_To_Zero
-                 (Designator, Corresponding_Protected_Entry);
-               Set_Ekind (Designator, E_Procedure);
-            when E_Procedure | E_Generic_Procedure =>
-               null;
-            when others =>
-               pragma Assert (False);
-         end case;
+         Set_Ekind (Designator, E_Procedure);
          Set_Etype (Designator, Standard_Void_Type);
       end if;

diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1040,6 +1040,10 @@  package Sinfo is
    --    to the defining entity for the corresponding body (NOT the node for
    --    the body itself).
+   --    Corresponding_Entry_Body
+   --    Defined in N_Subprogram_Body. Set for subprogram bodies that implement
+   --    a protected type entry; points to the body for the entry.
    --  Corresponding_Formal_Spec (Node3-Sem)
    --    This field is set in subprogram renaming declarations, where it points
    --    to the defining entity for a formal subprogram in the case where the