[Ada] Unnesting: add a predicate to help expansion of task and protected types

2018-05-31  Ed Schonberg  <schonberg@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9f47a77104461e4ee4928f1299681ed46e9b86a6..acf2c17bf8cb81b0c42400afbd5f6c576f2675d1 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-05-31  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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  <schonberg@adacore.com>
 
        * exp_ch4.adb (Expand_Modular_Addition, Expand_Modular_Subtraction):

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 6451246210a786869aacb1c6c2c51fc8a5fe5c58..c6d49e08f7d2c66402a36dfec14e43e5c55d9166 100644 (file)
--- 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 20469ce8b5c1f94c65d79346d0d536b3abefbe10..978e3d13af4fa89f4a7bdb981944ccbb34e86516 100644 (file)
--- 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;