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 <ging...@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.
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;