From ade649b2bfd24a1adcc28d96fa4b81878efe1c0b Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 31 May 2018 10:44:51 +0000 Subject: [PATCH] [Ada] Unnesting: add a predicate to help expansion of task and protected types 2018-05-31 Ed Schonberg gcc/ada/ * exp_unst.ads, exp_unst.adb (In_Synchronized_Unit): New predicate to mark subprograms that cannot be eliminated because they must be treated as reachable from outside the current unit. This includes entry bodies and protected operations. From-SVN: r260994 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_unst.adb | 27 +++++++++++++++++++++++++++ gcc/ada/exp_unst.ads | 8 +++++++- 3 files changed, 41 insertions(+), 1 deletion(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9f47a771044..acf2c17bf8c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-05-31 Ed Schonberg + + * exp_unst.ads, exp_unst.adb (In_Synchronized_Unit): New predicate to + mark subprograms that cannot be eliminated because they must be treated + as reachable from outside the current unit. This includes entry bodies + and protected operations. + 2018-05-31 Ed Schonberg * exp_ch4.adb (Expand_Modular_Addition, Expand_Modular_Subtraction): diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 6451246210a..c6d49e08f7d 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -43,6 +43,7 @@ with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Sinput; use Sinput; with Snames; use Snames; +with Stand; use Stand; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -172,6 +173,25 @@ package body Exp_Unst is end loop; end Get_Level; + -------------------------- + -- In_Synchronized_Unit -- + -------------------------- + + function In_Synchronized_Unit (Subp : Entity_Id) return Boolean is + S : Entity_Id := Scope (Subp); + + begin + while Present (S) and then S /= Standard_Standard loop + if Is_Concurrent_Type (S) then + return True; + end if; + + S := Scope (S); + end loop; + + return False; + end In_Synchronized_Unit; + ---------------- -- Subp_Index -- ---------------- @@ -1160,6 +1180,13 @@ package body Exp_Unst is Decl : Node_Id; begin + -- Subprograms declared in tasks and protected types + -- are reachable and cannot be eliminated. + + if In_Synchronized_Unit (STJ.Ent) then + STJ.Reachable := True; + end if; + -- Subprogram is reachable, copy and reset index if STJ.Reachable then diff --git a/gcc/ada/exp_unst.ads b/gcc/ada/exp_unst.ads index 20469ce8b5c..978e3d13af4 100644 --- a/gcc/ada/exp_unst.ads +++ b/gcc/ada/exp_unst.ads @@ -683,12 +683,18 @@ package Exp_Unst is -- function returns the level of nesting (Subp = 1, subprograms that -- are immediately nested within Subp = 2, etc.). + function In_Synchronized_Unit (Subp : Entity_Id) return Boolean; + -- Predicate to identify subprograms declared in task and protected types. + -- These subprograms are called from outside the compilation and therefore + -- must be considered reachable (and cannot be eliminated) because we must + -- generate code for them. + function Subp_Index (Sub : Entity_Id) return SI_Type; -- Given the entity for a subprogram, return corresponding Subp's index procedure Unnest_Subprograms (N : Node_Id); -- Called to unnest subprograms. If we are in unnest subprogram mode, this - -- is the call that traverses the tree N and locates all the library level + -- is the call that traverses the tree N and locates all the library-level -- subprograms with nested subprograms to process them. end Exp_Unst; -- 2.30.2