From: Arnaud Charlet Date: Thu, 4 Aug 2011 08:30:00 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7efc3f2d9ed7370243b867ab34038a239e6ead3d;p=gcc.git [multiple changes] 2011-08-04 Ed Schonberg * exp_ch4.adb (Expand_Composite_Equality): code cleanup: use component type in all cases to compute list of primitive operations, because full view may be an itype that is not attached to the list of declarations. 2011-08-04 Eric Botcazou * bindgen.adb (Gen_Adafinal_Ada): Generate an early return if the library has already been finalized. (Gen_Adafinal_C): Likewise. (Gen_Adainit_Ada): Generate an early return if the library has already been elaborated. (Gen_Adainit_C): Likewise. (Gen_Output_File_Ada): Generate an elaboration flag. (Gen_Output_File_C): Likewise. From-SVN: r177331 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e922351eaf8..2e2afc9ebfa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2011-08-04 Ed Schonberg + + * exp_ch4.adb (Expand_Composite_Equality): code cleanup: use component + type in all cases to compute list of primitive operations, because full + view may be an itype that is not attached to the list of declarations. + +2011-08-04 Eric Botcazou + + * bindgen.adb (Gen_Adafinal_Ada): Generate an early return if the + library has already been finalized. + (Gen_Adafinal_C): Likewise. + (Gen_Adainit_Ada): Generate an early return if the library has + already been elaborated. + (Gen_Adainit_C): Likewise. + (Gen_Output_File_Ada): Generate an elaboration flag. + (Gen_Output_File_C): Likewise. + 2011-08-04 Hristian Kirtchev * exp_ch4.adb (Expand_Allocator_Expression): Disable the generation of diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 5aac5c237d2..353e91da584 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -428,8 +428,20 @@ package body Bindgen is begin WBI (" procedure " & Ada_Final_Name.all & " is"); + if Bind_Main_Program and then VM_Target = No_VM then + WBI (" procedure s_stalib_adafinal;"); + Set_String (" pragma Import (C, s_stalib_adafinal, "); + Set_String ("""system__standard_library__adafinal"");"); + Write_Statement_Buffer; + end if; + + WBI (" begin"); + WBI (" if not Is_Elaborated then"); + WBI (" return;"); + WBI (" end if;"); + WBI (" Is_Elaborated := False;"); + if not Bind_Main_Program then - WBI (" begin"); if Lib_Final_Built then WBI (" finalize_library;"); else @@ -439,17 +451,12 @@ package body Bindgen is -- Main program case elsif VM_Target = No_VM then - WBI (" procedure s_stalib_adafinal;"); - WBI (" pragma Import (C, s_stalib_adafinal, " & - """system__standard_library__adafinal"");"); - WBI (" begin"); WBI (" s_stalib_adafinal;"); -- Pragma Import C cannot be used on virtual machine targets, therefore -- call the runtime finalization routine directly. else - WBI (" begin"); WBI (" System.Standard_Library.Adafinal;"); end if; @@ -465,6 +472,10 @@ package body Bindgen is begin WBI ("void " & Ada_Final_Name.all & " (void) {"); + WBI (" if (!is_elaborated)"); + WBI (" return;"); + WBI (" is_elaborated = 0;"); + if not Bind_Main_Program then if Lib_Final_Built then WBI (" finalize_library ();"); @@ -685,6 +696,11 @@ package body Bindgen is WBI (" begin"); + WBI (" if Is_Elaborated then"); + WBI (" return;"); + WBI (" end if;"); + WBI (" Is_Elaborated := True;"); + Set_String (" Main_Priority := "); Set_Int (Main_Priority); Set_Char (';'); @@ -941,6 +957,10 @@ package body Bindgen is WBI ("void " & Ada_Init_Name.all & " (void)"); WBI ("{"); + WBI (" if (is_elaborated)"); + WBI (" return;"); + WBI (" is_elaborated = 1;"); + -- Standard library suppressed if Suppress_Standard_Library_On_Target then @@ -3077,6 +3097,9 @@ package body Bindgen is WBI (""); end if; + WBI (" Is_Elaborated : Boolean := False;"); + WBI (""); + -- Generate the adafinal routine unless there is no finalization to do if not Cumulative_Restrictions.Set (No_Finalization) then @@ -3300,6 +3323,9 @@ package body Bindgen is WBI (""); end if; + WBI ("static char is_elaborated = 0;"); + WBI (""); + -- Generate the adafinal routine unless there is no finalization to do if not Cumulative_Restrictions.Set (No_Finalization) then diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7f9fdb23c37..506ec40a8a6 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2103,6 +2103,54 @@ package body Exp_Ch4 is Prim : Elmt_Id; Eq_Op : Entity_Id; + function Find_Primitive_Eq return Node_Id; + -- AI05-0123: Locate primitive equality for type if it exists, and + -- build the corresponding call. If operation is abstract, replace + -- call with an explicit raise. Return Empty if there is no primitive. + + ----------------------- + -- Find_Primitive_Eq -- + ----------------------- + + function Find_Primitive_Eq return Node_Id is + Prim_E : Elmt_Id; + Prim : Node_Id; + + begin + Prim_E := First_Elmt (Collect_Primitive_Operations (Typ)); + while Present (Prim_E) loop + Prim := Node (Prim_E); + + -- Locate primitive equality with the right signature + + if Chars (Prim) = Name_Op_Eq + and then Etype (First_Formal (Prim)) = + Etype (Next_Formal (First_Formal (Prim))) + and then Etype (Prim) = Standard_Boolean + then + if Is_Abstract_Subprogram (Prim) then + return + Make_Raise_Program_Error (Loc, + Reason => PE_Explicit_Raise); + + else + return + Make_Function_Call (Loc, + Name => New_Reference_To (Prim, Loc), + Parameter_Associations => New_List (Lhs, Rhs)); + end if; + end if; + + Next_Elmt (Prim_E); + end loop; + + -- If not found, predefined operation will be used + + return Empty; + end Find_Primitive_Eq; + + -- Start of processing for Expand_Composite_Equality + begin if Is_Private_Type (Typ) then Full_Type := Underlying_Type (Typ); @@ -2324,43 +2372,22 @@ package body Exp_Ch4 is elsif Ada_Version >= Ada_2012 then -- if no TSS has been created for the type, check whether there is - -- a primitive equality declared for it. If it is abstract replace - -- the call with an explicit raise (AI05-0123). + -- a primitive equality declared for it. declare - Prim : Elmt_Id; + Ada_2012_Op : constant Node_Id := Find_Primitive_Eq; begin - Prim := First_Elmt (Collect_Primitive_Operations (Full_Type)); - while Present (Prim) loop + if Present (Ada_2012_Op) then + return Ada_2012_Op; + else - -- Locate primitive equality with the right signature + -- Use predefined equality if no user-defined primitive exists - if Chars (Node (Prim)) = Name_Op_Eq - and then Etype (First_Formal (Node (Prim))) = - Etype (Next_Formal (First_Formal (Node (Prim)))) - and then Etype (Node (Prim)) = Standard_Boolean - then - if Is_Abstract_Subprogram (Node (Prim)) then - return - Make_Raise_Program_Error (Loc, - Reason => PE_Explicit_Raise); - else - return - Make_Function_Call (Loc, - Name => New_Reference_To (Node (Prim), Loc), - Parameter_Associations => New_List (Lhs, Rhs)); - end if; - end if; - - Next_Elmt (Prim); - end loop; + return Make_Op_Eq (Loc, Lhs, Rhs); + end if; end; - -- Use predefined equality iff no user-defined primitive exists - - return Make_Op_Eq (Loc, Lhs, Rhs); - else return Expand_Record_Equality (Nod, Full_Type, Lhs, Rhs, Bodies); end if;