Patchwork [Ada] Give full msg for finalize/adjust only if -gnateE.

login
register
mail settings
Submitter Arnaud Charlet
Date May 15, 2012, 9:49 a.m.
Message ID <20120515094905.GA9045@adacore.com>
Download mbox | patch
Permalink /patch/159281/
State New
Headers show

Comments

Arnaud Charlet - May 15, 2012, 9:49 a.m.
The circuitery to save the first exception message (reraised as PE) in
finalize or adjust operations has a distributed code size impact.  This
circuitery is now only enabled when then switch -gnateE is specified.

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

2012-05-15  Tristan Gingold  <gingold@adacore.com>

	* exp_ch7.adb (Build_Exception_Handler): Save current
	occurrence only if -gnateE.
	(Build_Object_Declaration): Declare E_Id only if -gnateE.
	(Build_Raise_Statement): Call Raise_From_Controlled_Operation only if
	-gnateE (else raise PE).
	* s-soflin.adb (Save_Library_Occurrence): Handle null occurrence
	access.
	* a-except-2005.adb (Reraise_Library_Exception_If_Any): Call
	Raise_From_Controlled_Operation only if the saved occurrence is
	not null, otherwise raise PE.

Patch

Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 187513)
+++ exp_ch7.adb	(working copy)
@@ -717,63 +717,95 @@ 
       Actuals      : List_Id;
       Proc_To_Call : Entity_Id;
       Except       : Node_Id;
+      Stmts        : List_Id;
 
    begin
-      pragma Assert (Present (Data.E_Id));
       pragma Assert (Present (Data.Raised_Id));
 
-      --  Generate:
+      if Exception_Extra_Info
+        or else (For_Library and then not Restricted_Profile)
+      then
+         if Exception_Extra_Info then
+            --  Generate:
 
-      --    Get_Current_Excep.all
+            --    Get_Current_Excep.all
 
-      Except :=
-        Make_Function_Call (Data.Loc,
-          Name =>
-            Make_Explicit_Dereference (Data.Loc,
-              Prefix =>
-                New_Reference_To (RTE (RE_Get_Current_Excep), Data.Loc)));
+            Except :=
+              Make_Function_Call (Data.Loc,
+                Name =>
+                  Make_Explicit_Dereference (Data.Loc,
+                    Prefix =>
+                      New_Reference_To (RTE (RE_Get_Current_Excep),
+                                        Data.Loc)));
+         else
+            --  Generate:
 
-      if For_Library and not Restricted_Profile then
-         Proc_To_Call := RTE (RE_Save_Library_Occurrence);
-         Actuals := New_List (Except);
+            --    null
+
+            Except := Make_Null (Data.Loc);
+         end if;
+
+         if For_Library and then not Restricted_Profile then
+            Proc_To_Call := RTE (RE_Save_Library_Occurrence);
+            Actuals := New_List (Except);
+         else
+            Proc_To_Call := RTE (RE_Save_Occurrence);
+
+            --  The dereference occurs only when Exception_Extra_Info is true,
+            --  and therefore Except is not null.
+
+            Actuals := New_List (
+              New_Reference_To (Data.E_Id, Data.Loc),
+              Make_Explicit_Dereference (Data.Loc, Except));
+         end if;
+
+         --  Generate:
+
+         --    when others =>
+         --       if not Raised_Id then
+         --          Raised_Id := True;
+
+         --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
+         --            or
+         --          Save_Library_Occurrence (Get_Current_Excep.all);
+         --       end if;
+
+         Stmts :=
+           New_List (
+             Make_If_Statement (Data.Loc,
+               Condition       =>
+                 Make_Op_Not (Data.Loc,
+                   Right_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc)),
+
+               Then_Statements => New_List (
+                 Make_Assignment_Statement (Data.Loc,
+                   Name       => New_Reference_To (Data.Raised_Id, Data.Loc),
+                   Expression => New_Reference_To (Standard_True, Data.Loc)),
+
+                 Make_Procedure_Call_Statement (Data.Loc,
+                   Name                   =>
+                     New_Reference_To (Proc_To_Call, Data.Loc),
+                   Parameter_Associations => Actuals))));
+
       else
-         Proc_To_Call := RTE (RE_Save_Occurrence);
-         Actuals :=
-           New_List
-             (New_Reference_To (Data.E_Id, Data.Loc),
-              Make_Explicit_Dereference (Data.Loc, Except));
+         --  Generate:
+
+         --    Raised_Id := True;
+
+         Stmts := New_List (
+           Make_Assignment_Statement (Data.Loc,
+             Name       => New_Reference_To (Data.Raised_Id, Data.Loc),
+             Expression => New_Reference_To (Standard_True, Data.Loc)));
       end if;
 
       --  Generate:
 
       --    when others =>
-      --       if not Raised_Id then
-      --          Raised_Id := True;
 
-      --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
-      --            or
-      --          Save_Library_Occurrence (Get_Current_Excep.all);
-      --       end if;
-
       return
         Make_Exception_Handler (Data.Loc,
-          Exception_Choices =>
-            New_List (Make_Others_Choice (Data.Loc)),
-          Statements => New_List (
-            Make_If_Statement (Data.Loc,
-              Condition       =>
-                Make_Op_Not (Data.Loc,
-                  Right_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc)),
-
-              Then_Statements => New_List (
-                Make_Assignment_Statement (Data.Loc,
-                  Name       => New_Reference_To (Data.Raised_Id, Data.Loc),
-                  Expression => New_Reference_To (Standard_True, Data.Loc)),
-
-                Make_Procedure_Call_Statement (Data.Loc,
-                  Name                   =>
-                    New_Reference_To (Proc_To_Call, Data.Loc),
-                  Parameter_Associations => Actuals)))));
+          Exception_Choices => New_List (Make_Others_Choice (Data.Loc)),
+          Statements        => Stmts);
    end Build_Exception_Handler;
 
    -------------------------------
@@ -2998,8 +3030,6 @@ 
          return;
       end if;
 
-      Data.Abort_Id  := Make_Temporary (Loc, 'A');
-      Data.E_Id      := Make_Temporary (Loc, 'E');
       Data.Raised_Id := Make_Temporary (Loc, 'R');
 
       --  In certain scenarios, finalization can be triggered by an abort. If
@@ -3019,35 +3049,44 @@ 
         and then VM_Target = No_VM
         and then not For_Package
       then
+         Data.Abort_Id  := Make_Temporary (Loc, 'A');
+
          A_Expr := New_Reference_To (RTE (RE_Triggered_By_Abort), Loc);
 
-      --  No abort, .NET/JVM or library-level finalizers
+         --  Generate:
+         --    Abort_Id : constant Boolean := <A_Expr>;
 
+         Append_To (Decls,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Data.Abort_Id,
+             Constant_Present    => True,
+             Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
+             Expression          => A_Expr));
+
       else
-         A_Expr := New_Reference_To (Standard_False, Loc);
+         --  No abort, .NET/JVM or library-level finalizers
+
+         Data.Abort_Id  := Empty;
       end if;
 
-      --  Generate:
-      --    Abort_Id : constant Boolean := <A_Expr>;
+      if Exception_Extra_Info then
+         Data.E_Id      := Make_Temporary (Loc, 'E');
 
-      Append_To (Decls,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Data.Abort_Id,
-          Constant_Present    => True,
-          Object_Definition   => New_Reference_To (Standard_Boolean, Loc),
-          Expression          => A_Expr));
+         --  Generate:
+         --    E_Id : Exception_Occurrence;
 
-      --  Generate:
-      --    E_Id : Exception_Occurrence;
+         E_Decl :=
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Data.E_Id,
+             Object_Definition   =>
+               New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
+         Set_No_Initialization (E_Decl);
 
-      E_Decl :=
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Data.E_Id,
-          Object_Definition   =>
-            New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
-      Set_No_Initialization (E_Decl);
+         Append_To (Decls, E_Decl);
 
-      Append_To (Decls, E_Decl);
+      else
+         Data.E_Id      := Empty;
+      end if;
 
       --  Generate:
       --    Raised_Id : Boolean := False;
@@ -3067,12 +3106,15 @@ 
      (Data : Finalization_Exception_Data) return Node_Id
    is
       Stmt : Node_Id;
+      Expr : Node_Id;
 
    begin
       --  Standard run-time and .NET/JVM targets use the specialized routine
       --  Raise_From_Controlled_Operation.
 
-      if RTE_Available (RE_Raise_From_Controlled_Operation) then
+      if Exception_Extra_Info
+        and then RTE_Available (RE_Raise_From_Controlled_Operation)
+      then
          Stmt :=
            Make_Procedure_Call_Statement (Data.Loc,
               Name                   =>
@@ -3092,6 +3134,21 @@ 
       end if;
 
       --  Generate:
+      --    Raised_Id and then not Abort_Id
+      --      <or>
+      --    Raised_Id
+
+      Expr := New_Reference_To (Data.Raised_Id, Data.Loc);
+
+      if Present (Data.Abort_Id) then
+         Expr := Make_And_Then (Data.Loc,
+           Left_Opnd  => Expr,
+           Right_Opnd =>
+             Make_Op_Not (Data.Loc,
+               Right_Opnd => New_Reference_To (Data.Abort_Id, Data.Loc)));
+      end if;
+
+      --  Generate:
       --    if Raised_Id and then not Abort_Id then
       --       Raise_From_Controlled_Operation (E_Id);
       --         <or>
@@ -3100,13 +3157,7 @@ 
 
       return
         Make_If_Statement (Data.Loc,
-          Condition       =>
-            Make_And_Then (Data.Loc,
-              Left_Opnd  => New_Reference_To (Data.Raised_Id, Data.Loc),
-              Right_Opnd =>
-                Make_Op_Not (Data.Loc,
-                  Right_Opnd => New_Reference_To (Data.Abort_Id, Data.Loc))),
-
+          Condition       => Expr,
           Then_Statements => New_List (Stmt));
    end Build_Raise_Statement;
 
Index: s-soflin.adb
===================================================================
--- s-soflin.adb	(revision 187513)
+++ s-soflin.adb	(working copy)
@@ -224,10 +224,13 @@ 
    -----------------------------
 
    procedure Save_Library_Occurrence (E : EOA) is
+      use Ada.Exceptions;
    begin
       if not Library_Exception_Set then
          Library_Exception_Set := True;
-         Ada.Exceptions.Save_Occurrence (Library_Exception, E.all);
+         if E /= null then
+            Ada.Exceptions.Save_Occurrence (Library_Exception, E.all);
+         end if;
       end if;
    end Save_Library_Occurrence;
 
Index: a-except-2005.adb
===================================================================
--- a-except-2005.adb	(revision 187509)
+++ a-except-2005.adb	(working copy)
@@ -1296,7 +1296,13 @@ 
    begin
       if Library_Exception_Set then
          LE := Library_Exception;
-         Raise_From_Controlled_Operation (LE);
+         if LE.Id = Null_Id then
+            Raise_Exception_No_Defer
+              (E       => Program_Error'Identity,
+               Message => "finalize/adjust raised exception");
+         else
+            Raise_From_Controlled_Operation (LE);
+         end if;
       end if;
    end Reraise_Library_Exception_If_Any;