[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 26 Oct 2015 10:54:01 +0000 (11:54 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 26 Oct 2015 10:54:01 +0000 (11:54 +0100)
2015-10-26  Gary Dismukes  <dismukes@adacore.com>

* sem_ch13.adb: Minor reformatting.

2015-10-26  Steve Baird  <baird@adacore.com>

* exp_disp.adb: Omit most dispatch table initialization code
if Generate_SCIL is true.

2015-10-26  Arnaud Charlet  <charlet@adacore.com>

* sinfo.ads, exp_ch3.adb: Revert previous change.
(Build_Record_Init_Proc): Do not build an aggregate if
Modify_Tree_For_C.

From-SVN: r229327

gcc/ada/ChangeLog
gcc/ada/exp_ch3.adb
gcc/ada/exp_disp.adb
gcc/ada/sem_ch13.adb
gcc/ada/sinfo.ads

index 442dafe0853e8d6c3f1f7c9b3b58359e2fb89ef4..1e7dfdbeff7fe6246a260681569a4e7ab211e3ae 100644 (file)
@@ -1,3 +1,18 @@
+2015-10-26  Gary Dismukes  <dismukes@adacore.com>
+
+       * sem_ch13.adb: Minor reformatting.
+
+2015-10-26  Steve Baird  <baird@adacore.com>
+
+       * exp_disp.adb: Omit most dispatch table initialization code
+       if Generate_SCIL is true.
+
+2015-10-26  Arnaud Charlet  <charlet@adacore.com>
+
+       * sinfo.ads, exp_ch3.adb: Revert previous change.
+       (Build_Record_Init_Proc): Do not build an aggregate if
+       Modify_Tree_For_C.
+
 2015-10-26  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch6.adb (Find_Corresponding_Spec): Reject a subprogram
index 04d1fc821f9c7d6835e2d84b3ebc4ba21ad5773b..6fb3a5983517844c04f342f284ac8726b129dbd3 100644 (file)
@@ -760,10 +760,8 @@ package body Exp_Ch3 is
          --  want to inline, because nested stuff may cause difficulties in
          --  inter-unit inlining, and furthermore there is in any case no
          --  point in inlining such complex init procs.
-         --  Also do not inline in case of Modify_Tree_For_C where front-end
-         --  inlining is used and may not always play well with init procs.
 
-         if not Has_Task (Proc_Id) and then not Modify_Tree_For_C then
+         if not Has_Task (Proc_Id) then
             Set_Is_Inlined (Proc_Id);
          end if;
 
@@ -3600,12 +3598,9 @@ package body Exp_Ch3 is
          --  In addition, when compiled for another unit for inlining purposes,
          --  it may make reference to entities that have not been elaborated
          --  yet. Similar considerations apply to task types.
-         --  Also do not inline in case of Modify_Tree_For_C where front-end
-         --  inlining is used and may not always play well with init procs.
 
          if not Is_Concurrent_Type (Rec_Type)
            and then not Has_Task (Rec_Type)
-           and then not Modify_Tree_For_C
          then
             Set_Is_Inlined  (Proc_Id);
          end if;
@@ -3617,6 +3612,14 @@ package body Exp_Ch3 is
             Set_Debug_Info_Off (Proc_Id);
          end if;
 
+         --  Do not build an aggregate if Modify_Tree_For_C, this isn't
+         --  needed and may generate early references to non frozen types
+         --  since we expand aggregate much more systematically.
+
+         if Modify_Tree_For_C then
+            return;
+         end if;
+
          declare
             Agg : constant Node_Id :=
                     Build_Equivalent_Record_Aggregate (Rec_Type);
index d8ad4f8fd8cffaa8bb91e97b3bedc04b58588a8c..7abc0b543a5a65051ddd5b7d1d4aac18b57daca9 100644 (file)
@@ -3903,6 +3903,10 @@ package body Exp_Disp is
             end loop;
          end if;
 
+         if Generate_SCIL then
+            Nb_Predef_Prims := 0;
+         end if;
+
          --  Stage 2: Create the thunks associated with the predefined
          --  primitives and save their entity to fill the aggregate.
 
@@ -3924,6 +3928,7 @@ package body Exp_Disp is
                   if Is_Predefined_Dispatching_Operation (Prim)
                     and then not Is_Abstract_Subprogram (Prim)
                     and then not Is_Eliminated (Prim)
+                    and then not Generate_SCIL
                     and then not Present (Prim_Table
                                            (UI_To_Int (DT_Position (Prim))))
                   then
@@ -4620,6 +4625,10 @@ package body Exp_Disp is
       DT_Ptr  := Node (First_Elmt (Access_Disp_Table (Typ)));
       Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ)));
 
+      if Generate_SCIL then
+         Nb_Prim := 0;
+      end if;
+
       Set_Is_Statically_Allocated (DT,  Is_Library_Level_Tagged_Type (Typ));
       Set_Is_Statically_Allocated (SSD, Is_Library_Level_Tagged_Type (Typ));
       Set_Is_Statically_Allocated (TSD, Is_Library_Level_Tagged_Type (Typ));
@@ -4685,6 +4694,14 @@ package body Exp_Disp is
                  Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result)));
                Set_SCIL_Entity (New_Node, Typ);
                Set_SCIL_Node (Last (Result), New_Node);
+
+               goto Early_Exit_For_SCIL;
+
+               --  Gnat2scil has its own implementation of dispatch tables,
+               --  different than what is being implemented here. Generating
+               --  further dispatch table initialization code would just
+               --  cause gnat2scil to generate useless Scil which CodePeer
+               --  would waste time and space analyzing, so we skip it.
             end if;
 
          --  Generate:
@@ -4754,6 +4771,14 @@ package body Exp_Disp is
                  Make_SCIL_Dispatch_Table_Tag_Init (Sloc (Last (Result)));
                Set_SCIL_Entity (New_Node, Typ);
                Set_SCIL_Node (Last (Result), New_Node);
+
+               goto Early_Exit_For_SCIL;
+
+               --  Gnat2scil has its own implementation of dispatch tables,
+               --  different than what is being implemented here. Generating
+               --  further dispatch table initialization code would just
+               --  cause gnat2scil to generate useless Scil which CodePeer
+               --  would waste time and space analyzing, so we skip it.
             end if;
 
             Append_To (Result,
@@ -6213,6 +6238,8 @@ package body Exp_Disp is
          end;
       end if;
 
+      <<Early_Exit_For_SCIL>>
+
       --  Register the tagged type in the call graph nodes table
 
       Register_CG_Node (Typ);
@@ -7087,6 +7114,7 @@ package body Exp_Disp is
 
       if not RTE_Available (RE_Tag)
         or else Is_Eliminated (Ultimate_Alias (Prim))
+        or else Generate_SCIL
       then
          return L;
       end if;
index 9ef6263846f3bec94c2906c1a160791301ce8456..93da0497f37ee2a3153daaafe3069848d6236845 100644 (file)
@@ -4003,14 +4003,14 @@ package body Sem_Ch13 is
                if Debug_Flag_Dot_XX then
                   null;
 
-               --  OK if current attribute_definition_clause is expansion
-               --  of inherited aspect.
+               --  OK if current attribute_definition_clause is expansion of
+               --  inherited aspect.
 
                elsif Aspect_Rep_Item (Inherited) = N then
                   null;
 
-               --  Indicate the operation that must be overridden, rather
-               --  than redefining the indexing aspect
+               --  Indicate the operation that must be overridden, rather than
+               --  redefining the indexing aspect.
 
                else
                   Illegal_Indexing
index 3528f9fbd1243ae63ebb2f7aaa904f68b08d6401..5f2f0920eaff1258f436a63c0ff962f431cc8f19 100644 (file)
@@ -735,9 +735,6 @@ package Sinfo is
    --    they are systematically expanded into loops (for arrays) and
    --    individual assignments (for records).
 
-   --    Initialization procedures (init procs) for records and arrays are
-   --    not inlined.
-
    ------------------------------------
    -- Description of Semantic Fields --
    ------------------------------------