[COMMITTED,04/30] ada: Remove support for bodies in -gnatceg

Message ID	20240801151738.400796-4-poulhies@adacore.com
State	New
Headers	show Return-Path: <gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org> DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D312D386484B From: =?utf-8?q?Marc_Poulhi=C3=A8s?= <poulhies@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Arnaud Charlet <charlet@adacore.com> Subject: [COMMITTED 04/30] ada: Remove support for bodies in -gnatceg Date: Thu, 1 Aug 2024 17:17:12 +0200 Message-ID: <20240801151738.400796-4-poulhies@adacore.com> In-Reply-To: <20240801151738.400796-1-poulhies@adacore.com> References: <20240801151738.400796-1-poulhies@adacore.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Precedence: list Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org
Series	[COMMITTED,01/30] ada: Remove obsolete workaround \| expand [COMMITTED,01/30] ada: Remove obsolete workaround [COMMITTED,02/30] ada: Couple of cleanups in finalization machinery [COMMITTED,03/30] ada: Allow making empty aggregates positional [COMMITTED,04/30] ada: Remove support for bodies in -gnatceg [COMMITTED,05/30] ada: Fix test for wrapping loop parameter spec [COMMITTED,06/30] ada: Stop ignoring Component_Size attribute in CodePeer_Mode [COMMITTED,07/30] ada: Operator visibility bug in static expression functions [COMMITTED,08/30] ada: Fix internal error on limited aggregate in nested conditional expression [COMMITTED,09/30] ada: Missing adjust of controlled component initialized from container aggregate [COMMITTED,10/30] ada: Followup on previous change for -gnatceg [COMMITTED,11/30] ada: Miscomputed bounds for inner null array aggregates [COMMITTED,12/30] ada: Change "missing overriding indicator" message from error to warning [COMMITTED,13/30] ada: Remove Must_Not_Freeze flags from default value expressions [COMMITTED,14/30] ada: Fix freezing of Default_Value expressions [COMMITTED,15/30] ada: Check default value aspects before resolving their expressions [COMMITTED,16/30] ada: exp_pakd.adb: disable packed expansions in CodePeer_Mode [COMMITTED,17/30] ada: Put back -G for binder [COMMITTED,18/30] ada: Implement full relaxed finalization semantics for controlled objects [COMMITTED,19/30] ada: Define No_Return flag only for subprograms [COMMITTED,20/30] ada: Fix bug in resolution of Ghost_Predicate [COMMITTED,21/30] ada: Fix crash in quantified expression expansion [COMMITTED,22/30] ada: Use ?j? in Output_Obsolescent_Entity_Warnings messages [COMMITTED,23/30] ada: Restrict string interpolation to single string literal [COMMITTED,24/30] ada: Style fixes: remove blank lines following 'begin' keywords [COMMITTED,25/30] ada: Deconstruct workarounds for quantified expressions in contracts [COMMITTED,26/30] ada: Fix oversight in documentation of At_End_Proc [COMMITTED,27/30] ada: Crash on access attribute with overloaded prefix denoting reference object [COMMITTED,28/30] ada: Accept duplicate SPARK_Mode pragmas in configuration files [COMMITTED,29/30] ada: Update contracts on Strings libraries [COMMITTED,30/30] ada: Fix computation of new size when reallocating unbounded string

diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 89b2b88395b..cdfaa08d8a6 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -2113,7 +2113,6 @@ package body Bindgen is if Bind_Main_Program and then not Minimal_Binder and then not CodePeer_Mode - and then not Generate_C_Code then WBI (" Ensure_Reference : aliased System.Address := " & "Ada_Main_Program_Name'Address;"); diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index 855fd16c930..e870c5f0e22 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -133,11 +133,6 @@ package body Bindusg is Write_Line (" -F Force checking of elaboration Flags"); - -- Line for -G switch - - Write_Line - (" -G Generate binder file suitable for CCG"); - -- Line for -h switch Write_Line diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 3313c4a408f..d2546bec1b5 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -105,7 +105,7 @@ package body Debug is -- d.r Disable reordering of components in record types -- d.s Strict secondary stack management -- d.t Disable static allocation of library level dispatch tables - -- d.u Enable Modify_Tree_For_C (update tree for c) + -- d.u -- d.v Enforce SPARK elaboration rules in SPARK code -- d.w Do not check for infinite loops -- d.x No exception handlers @@ -207,7 +207,7 @@ package body Debug is -- d.3 Output debugging information from Exp_Unst -- d.4 Do not delete generated C file in case of errors -- d.5 Do not generate imported subprogram definitions in C code - -- d.6 Do not avoid declaring unreferenced types in C code + -- d.6 -- d.7 Disable unsound heuristics in gnat2scil (for CP as SPARK prover) -- d.8 Disable unconditional inlining of expression functions -- d.9 @@ -797,8 +797,7 @@ package body Debug is -- previous dynamic construction of tables. It is there as a possible -- work around if we run into trouble with the new implementation. - -- d.u Sets Modify_Tree_For_C mode in which tree is modified to make it - -- easier to generate code using a C compiler. + -- d.u -- d.v This flag enforces the elaboration rules defined in the SPARK -- Reference Manual, chapter 7.7, to all SPARK code within a unit. As @@ -1118,10 +1117,6 @@ package body Debug is -- This debug flag disables this generation when generating C code, -- assuming a proper #include will be used instead. - -- d.6 By default the C back-end avoids declaring types that are not - -- referenced by the generated C code. This debug flag restores the - -- output of all the types. - -- d.7 Indicates (to gnat2scil) that CodePeer is being invoked as a -- prover by the SPARK tools and that therefore gnat2scil should -- avoid SCIL generation strategies which can introduce soundness diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index fbe6c8566ec..0d839b9b691 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -748,17 +748,6 @@ package Einfo is -- other function entities, only in implicit inequality routines, -- where Comes_From_Source is always False. --- Corresponding_Function --- Defined on procedures internally built with an extra out parameter --- to return a constrained array type, when Modify_Tree_For_C is set. --- Denotes the function that returns the constrained array type for --- which this procedure was built. - --- Corresponding_Procedure --- Defined on functions that return a constrained array type, when --- Modify_Tree_For_C is set. Denotes the internally built procedure --- with an extra out parameter created for it. - -- Corresponding_Record_Component -- Defined in components of a derived untagged record type, including -- discriminants. For a regular component or a stored discriminant, @@ -4285,12 +4274,6 @@ package Einfo is -- the Bit_Order aspect must be set to the same value (either explicitly -- or as the target default value). --- Rewritten_For_C --- Defined on functions that return a constrained array type, when --- Modify_Tree_For_C is set. Indicates that a procedure with an extra --- out parameter has been created for it, and calls must be rewritten as --- calls to the new procedure. - -- RM_Size -- Defined in all type and subtype entities. Contains the value of -- type'Size as defined in the RM. See also the Esize field and @@ -5522,7 +5505,6 @@ package Einfo is -- Anonymous_Collections (non-generic case only) -- Corresponding_Equality (implicit /= only) -- Thunk_Entity (thunk case only) - -- Corresponding_Procedure (generate C code only) -- Linker_Section_Pragma -- Contract -- Import_Pragma (non-generic case only) @@ -5586,7 +5568,6 @@ package Einfo is -- Requires_Overriding (non-generic case only) -- Return_Present -- Returns_By_Ref - -- Rewritten_For_C (generate C code only) -- Sec_Stack_Needed_For_Return -- SPARK_Pragma_Inherited -- Uses_Sec_Stack @@ -5883,7 +5864,6 @@ package Einfo is -- Anonymous_Collections (non-generic case only) -- Static_Initialization (init_proc only) -- Thunk_Entity (thunk case only) - -- Corresponding_Function (generate C code only) -- Linker_Section_Pragma -- Contract -- Import_Pragma (non-generic case only) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 419a98c681a..c7730ca754a 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -117,10 +117,6 @@ package body Exp_Aggr is -- Comp_Typ of aggregate N. Init_Expr denotes the initialization -- expression of the component. All generated code is added to Stmts. - function Is_CCG_Supported_Aggregate (N : Node_Id) return Boolean; - -- Return True if aggregate N is located in a context supported by the - -- CCG backend; False otherwise. - function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean; -- Returns true if N is an aggregate used to initialize the components -- of a statically allocated dispatch table. @@ -814,10 +810,6 @@ package body Exp_Aggr is -- 10. No controlled actions need to be generated for components - -- 11. When generating C code, N must be part of a N_Object_Declaration - - -- 12. When generating C code, N must not include function calls - function Backend_Processing_Possible (N : Node_Id) return Boolean is Typ : constant Entity_Id := Etype (N); -- Typ is the correct constrained array subtype of the aggregate @@ -833,33 +825,7 @@ package body Exp_Aggr is --------------------- function Component_Check (N : Node_Id; Index : Node_Id) return Boolean is - function Ultimate_Original_Expression (N : Node_Id) return Node_Id; - -- Given a type conversion or an unchecked type conversion N, return - -- its innermost original expression. - - ---------------------------------- - -- Ultimate_Original_Expression -- - ---------------------------------- - - function Ultimate_Original_Expression (N : Node_Id) return Node_Id is - Expr : Node_Id := Original_Node (N); - - begin - while Nkind (Expr) in - N_Type_Conversion | N_Unchecked_Type_Conversion - loop - Expr := Original_Node (Expression (Expr)); - end loop; - - return Expr; - end Ultimate_Original_Expression; - - -- Local variables - Expr : Node_Id; - - -- Start of processing for Component_Check - begin -- Checks 1: (no component associations) @@ -867,13 +833,6 @@ package body Exp_Aggr is return False; end if; - -- Checks 11: The C code generator cannot handle aggregates that are - -- not part of an object declaration. - - if Modify_Tree_For_C and then not Is_CCG_Supported_Aggregate (N) then - return False; - end if; - -- Checks on components -- Recurse to check subaggregates, which may appear in qualified @@ -905,15 +864,6 @@ package body Exp_Aggr is return False; end if; - -- Checks 12: (no function call) - - if Modify_Tree_For_C - and then - Nkind (Ultimate_Original_Expression (Expr)) = N_Function_Call - then - return False; - end if; - -- Recursion to following indexes for multiple dimension case if Present (Next_Index (Index)) @@ -3389,32 +3339,12 @@ package body Exp_Aggr is end if; end if; - if Modify_Tree_For_C - and then Nkind (Expr_Q) = N_Aggregate - and then Is_Array_Type (Etype (Expr_Q)) - and then Present (First_Index (Etype (Expr_Q))) - then - declare - Expr_Q_Type : constant Entity_Id := Etype (Expr_Q); - begin - Append_List_To (L, - Build_Array_Aggr_Code - (N => Expr_Q, - Ctype => Component_Type (Expr_Q_Type), - Index => First_Index (Expr_Q_Type), - Into => Comp_Expr, - Scalar_Comp => - Is_Scalar_Type (Component_Type (Expr_Q_Type)))); - end; - - else - Initialize_Component - (N => N, - Comp => Comp_Expr, - Comp_Typ => Etype (Selector), - Init_Expr => Expr_Q, - Stmts => L); - end if; + Initialize_Component + (N => N, + Comp => Comp_Expr, + Comp_Typ => Etype (Selector), + Init_Expr => Expr_Q, + Stmts => L); end if; -- comment would be good here ??? @@ -3800,7 +3730,6 @@ package body Exp_Aggr is -- reset Set_Expansion_Delayed and do not expand further. if not CodePeer_Mode - and then not Modify_Tree_For_C and then Aggr_Assignment_OK_For_Backend (Aggr) then New_Aggr := New_Copy_Tree (Aggr); @@ -4957,14 +4886,6 @@ package body Exp_Aggr is -- Start of processing for Convert_To_Positional begin - -- Only convert to positional when generating C in case of an - -- object declaration, this is the only case where aggregates are - -- supported in C. - - if Modify_Tree_For_C and then not Is_CCG_Supported_Aggregate (N) then - return; - end if; - -- Ada 2005 (AI-287): Do not convert in case of default initialized -- components because in this case will need to call the corresponding -- IP procedure. @@ -6472,7 +6393,6 @@ package body Exp_Aggr is if (In_Place_Assign_OK_For_Declaration or else Maybe_In_Place_OK) and then not CodePeer_Mode - and then not Modify_Tree_For_C and then not Possible_Bit_Aligned_Component (Target) and then not Is_Possibly_Unaligned_Slice (Target) and then Aggr_Assignment_OK_For_Backend (N) @@ -7955,10 +7875,6 @@ package body Exp_Aggr is (Typ : Entity_Id) return Boolean; -- Determine if some component of Typ is mutably tagged - function Has_Per_Object_Constraint (L : List_Id) return Boolean; - -- Return True if any element of L has Has_Per_Object_Constraint set. - -- L should be the Choices component of an N_Component_Association. - function Has_Visible_Private_Ancestor (Id : E) return Boolean; -- If any ancestor of the current type is private, the aggregate -- cannot be built in place. We cannot rely on Has_Private_Ancestor, @@ -8413,27 +8329,6 @@ package body Exp_Aggr is elsif Possible_Bit_Aligned_Component (Expr_Q) then Static_Components := False; return False; - - elsif Modify_Tree_For_C - and then Nkind (C) = N_Component_Association - and then Has_Per_Object_Constraint (Choices (C)) - then - Static_Components := False; - return False; - - elsif Modify_Tree_For_C - and then Nkind (Expr_Q) = N_Identifier - and then Is_Array_Type (Etype (Expr_Q)) - then - Static_Components := False; - return False; - - elsif Modify_Tree_For_C - and then Nkind (Expr_Q) = N_Type_Conversion - and then Is_Array_Type (Etype (Expr_Q)) - then - Static_Components := False; - return False; end if; if Is_Elementary_Type (Etype (Expr_Q)) then @@ -8481,27 +8376,6 @@ package body Exp_Aggr is return False; end Contains_Mutably_Tagged_Component; - ------------------------------- - -- Has_Per_Object_Constraint -- - ------------------------------- - - function Has_Per_Object_Constraint (L : List_Id) return Boolean is - N : Node_Id := First (L); - begin - while Present (N) loop - if Is_Entity_Name (N) - and then Present (Entity (N)) - and then Has_Per_Object_Constraint (Entity (N)) - then - return True; - end if; - - Next (N); - end loop; - - return False; - end Has_Per_Object_Constraint; - ----------------------------------- -- Has_Visible_Private_Ancestor -- ----------------------------------- @@ -8674,12 +8548,6 @@ package body Exp_Aggr is elsif Type_May_Have_Bit_Aligned_Components (Typ) then Convert_To_Assignments (N, Typ); - -- When generating C, only generate an aggregate when declaring objects - -- since C does not support aggregates in e.g. assignment statements. - - elsif Modify_Tree_For_C and then not Is_CCG_Supported_Aggregate (N) then - Convert_To_Assignments (N, Typ); - -- In all other cases, build a proper aggregate to be handled by gigi else @@ -8948,64 +8816,6 @@ package body Exp_Aggr is and then Expansion_Delayed (Unqual_N); end Is_Delayed_Conditional_Expression; - -------------------------------- - -- Is_CCG_Supported_Aggregate -- - -------------------------------- - - function Is_CCG_Supported_Aggregate - (N : Node_Id) return Boolean - is - P : Node_Id := Parent (N); - - begin - -- Aggregates are not supported for nonstandard rep clauses, since they - -- may lead to extra padding fields in CCG. - - if Is_Record_Type (Etype (N)) - and then Has_Non_Standard_Rep (Etype (N)) - then - return False; - end if; - - while Present (P) and then Nkind (P) = N_Aggregate loop - P := Parent (P); - end loop; - - -- Check cases where aggregates are supported by the CCG backend - - if Nkind (P) = N_Object_Declaration then - declare - P_Typ : constant Entity_Id := Etype (Defining_Identifier (P)); - - begin - if Is_Record_Type (P_Typ) then - return True; - else - return Compile_Time_Known_Bounds (P_Typ); - end if; - end; - - elsif Nkind (P) = N_Qualified_Expression then - if Nkind (Parent (P)) = N_Object_Declaration then - declare - P_Typ : constant Entity_Id := - Etype (Defining_Identifier (Parent (P))); - begin - if Is_Record_Type (P_Typ) then - return True; - else - return Compile_Time_Known_Bounds (P_Typ); - end if; - end; - - elsif Nkind (Parent (P)) = N_Allocator then - return True; - end if; - end if; - - return False; - end Is_CCG_Supported_Aggregate; - ---------------------------------------- -- Is_Static_Dispatch_Table_Aggregate -- ---------------------------------------- @@ -9069,7 +8879,6 @@ package body Exp_Aggr is -- reset Set_Expansion_Delayed and do not expand further. if not CodePeer_Mode - and then not Modify_Tree_For_C and then not Possible_Bit_Aligned_Component (Target) and then not Is_Possibly_Unaligned_Slice (Target) and then Aggr_Assignment_OK_For_Backend (N) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 627cd7f3392..13c7444ca87 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -224,8 +224,7 @@ package body Exp_Attr is -- loop may be converted into a conditional block. See body for details. procedure Expand_Min_Max_Attribute (N : Node_Id); - -- Handle the expansion of attributes 'Max and 'Min, including expanding - -- then out if we are in Modify_Tree_For_C mode. + -- Handle the expansion of attributes 'Max and 'Min procedure Expand_Pred_Succ_Attribute (N : Node_Id); -- Handles expansion of Pred or Succ attributes for case of non-real @@ -5144,19 +5143,6 @@ package body Exp_Attr is use Old_Attr_Util.Conditional_Evaluation; use Old_Attr_Util.Indirect_Temps; begin - -- Generating C code we don't need to expand this attribute when - -- we are analyzing the internally built nested _Wrapped_Statements - -- procedure since it will be expanded inline (and later it will - -- be removed by Expand_N_Subprogram_Body). It this expansion is - -- performed in such case then the compiler generates unreferenced - -- extra temporaries. - - if Modify_Tree_For_C - and then Chars (Current_Scope) = Name_uWrapped_Statements - then - return; - end if; - -- 'Old can only appear in the case where local contract-related -- wrapper has been generated with the purpose of wrapping the -- original declarations and statements. @@ -7546,93 +7532,84 @@ package body Exp_Attr is -- Start of processing for Float_Valid begin - -- The C back end handles Valid for floating-point types - - if Modify_Tree_For_C then - Analyze_And_Resolve (Pref, Ptyp); - Set_Etype (N, Standard_Boolean); - Set_Analyzed (N); - - else - Find_Fat_Info (Ptyp, Ftp, Pkg); - - -- If the prefix is a reverse SSO component, or is possibly - -- unaligned, first create a temporary copy that is in - -- native SSO, and properly aligned. Make it Volatile to - -- prevent folding in the back-end. Note that we use an - -- intermediate constrained string type to initialize the - -- temporary, as the value at hand might be invalid, and in - -- that case it cannot be copied using a floating point - -- register. - - if In_Reverse_Storage_Order_Object (Pref) - or else Is_Possibly_Unaligned_Object (Pref) - then - declare - Temp : constant Entity_Id := - Make_Temporary (Loc, 'F'); + Find_Fat_Info (Ptyp, Ftp, Pkg); + + -- If the prefix is a reverse SSO component, or is possibly + -- unaligned, first create a temporary copy that is in + -- native SSO, and properly aligned. Make it Volatile to + -- prevent folding in the back-end. Note that we use an + -- intermediate constrained string type to initialize the + -- temporary, as the value at hand might be invalid, and in + -- that case it cannot be copied using a floating point + -- register. + + if In_Reverse_Storage_Order_Object (Pref) + or else Is_Possibly_Unaligned_Object (Pref) + then + declare + Temp : constant Entity_Id := + Make_Temporary (Loc, 'F'); - Fat_S : constant Entity_Id := - Get_Fat_Entity (Name_S); - -- Constrained string subtype of appropriate size + Fat_S : constant Entity_Id := + Get_Fat_Entity (Name_S); + -- Constrained string subtype of appropriate size - Fat_P : constant Entity_Id := - Get_Fat_Entity (Name_P); - -- Access to Fat_S + Fat_P : constant Entity_Id := + Get_Fat_Entity (Name_P); + -- Access to Fat_S - Decl : constant Node_Id := - Make_Object_Declaration (Loc, + Decl : constant Node_Id := + Make_Object_Declaration (Loc, Defining_Identifier => Temp, Aliased_Present => True, - Object_Definition => - New_Occurrence_Of (Ptyp, Loc)); + Object_Definition => + New_Occurrence_Of (Ptyp, Loc)); - begin - Set_Aspect_Specifications (Decl, New_List ( - Make_Aspect_Specification (Loc, - Identifier => - Make_Identifier (Loc, Name_Volatile)))); + begin + Set_Aspect_Specifications (Decl, New_List ( + Make_Aspect_Specification (Loc, + Identifier => + Make_Identifier (Loc, Name_Volatile)))); - Insert_Actions (N, - New_List ( - Decl, - - Make_Assignment_Statement (Loc, - Name => - Make_Explicit_Dereference (Loc, - Prefix => - Unchecked_Convert_To (Fat_P, - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Temp, Loc), - Attribute_Name => - Name_Unrestricted_Access))), - Expression => - Unchecked_Convert_To (Fat_S, - Relocate_Node (Pref)))), - - Suppress => All_Checks); - - Rewrite (Pref, New_Occurrence_Of (Temp, Loc)); - end; - end if; + Insert_Actions (N, + New_List ( + Decl, + + Make_Assignment_Statement (Loc, + Name => + Make_Explicit_Dereference (Loc, + Prefix => + Unchecked_Convert_To (Fat_P, + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Temp, Loc), + Attribute_Name => + Name_Unrestricted_Access))), + Expression => + Unchecked_Convert_To (Fat_S, + Relocate_Node (Pref)))), + + Suppress => All_Checks); + + Rewrite (Pref, New_Occurrence_Of (Temp, Loc)); + end; + end if; - -- We now have an object of the proper endianness and - -- alignment, and can construct a Valid attribute. + -- We now have an object of the proper endianness and + -- alignment, and can construct a Valid attribute. - -- We make sure the prefix of this valid attribute is - -- marked as not coming from source, to avoid losing - -- warnings from 'Valid looking like a possible update. + -- We make sure the prefix of this valid attribute is + -- marked as not coming from source, to avoid losing + -- warnings from 'Valid looking like a possible update. - Set_Comes_From_Source (Pref, False); + Set_Comes_From_Source (Pref, False); - Expand_Fpt_Attribute - (N, Pkg, Name_Valid, - New_List ( - Make_Attribute_Reference (Loc, - Prefix => Unchecked_Convert_To (Ftp, Pref), - Attribute_Name => Name_Unrestricted_Access))); - end if; + Expand_Fpt_Attribute + (N, Pkg, Name_Valid, + New_List ( + Make_Attribute_Reference (Loc, + Prefix => Unchecked_Convert_To (Ftp, Pref), + Attribute_Name => Name_Unrestricted_Access))); -- One more task, we still need a range check. Required -- only if we have a constraint, since the Valid routine @@ -9336,8 +9313,7 @@ package body Exp_Attr is function Is_GCC_Target return Boolean is begin - return not CodePeer_Mode - and then not Modify_Tree_For_C; + return not CodePeer_Mode; end Is_GCC_Target; -- Start of processing for Is_Inline_Floating_Point_Attribute diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 678d76cf3eb..925b164cb2f 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1103,12 +1103,6 @@ package body Exp_Ch11 is -- Start of processing for Expand_N_Exception_Declaration begin - -- Nothing to do when generating C code - - if Modify_Tree_For_C then - return; - end if; - -- Definition of the external name: nam : constant String := "A.B.NAME"; Ex_Id := diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 70048e68331..1eea062210a 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4650,14 +4650,6 @@ package body Exp_Ch3 is Set_Is_Inlined (Proc_Id, Inline_Init_Proc (Rec_Type)); - -- 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); @@ -7690,13 +7682,11 @@ package body Exp_Ch3 is -- An aggregate that must be built in place is not resolved and -- expanded until the enclosing construct is expanded. This will -- happen when the aggregate is limited and the declared object - -- has a following address clause; it happens also when generating - -- C code for an aggregate that has an alignment or address clause - -- (see Analyze_Object_Declaration). Resolution is done without + -- has a following address clause. Resolution is done without -- expansion because it will take place when the declaration -- itself is expanded. - if (Is_Limited_Type (Typ) or else Modify_Tree_For_C) + if Is_Limited_Type (Typ) and then not Analyzed (Expr) then Expander_Mode_Save_And_Set (False); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index abe76c8767e..f952005ed75 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -1051,21 +1051,13 @@ package body Exp_Ch4 is Displace_Allocator_Pointer (N); end if; - -- Always force the generation of a temporary for aggregates when - -- generating C code, to simplify the work in the code generator. - - elsif Aggr_In_Place - or else (Modify_Tree_For_C and then Nkind (Exp) = N_Aggregate) - then + elsif Aggr_In_Place then Temp := Make_Temporary (Loc, 'P', N); Build_Aggregate_In_Place (Temp, PtrT); Build_Allocate_Deallocate_Proc (Declaration_Node (Temp), Mark => N); Rewrite (N, New_Occurrence_Of (Temp, Loc)); Analyze_And_Resolve (N, PtrT); - - if Aggr_In_Place then - Apply_Predicate_Check (N, T, Deref => True); - end if; + Apply_Predicate_Check (N, T, Deref => True); -- If the initialization expression is a conditional expression whose -- expansion has been delayed, assign it explicitly to the allocator, @@ -1996,52 +1988,14 @@ package body Exp_Ch4 is Func_Body := Make_Boolean_Array_Op (Etype (L), N); Func_Name := Defining_Unit_Name (Specification (Func_Body)); Insert_Action (N, Func_Body); - - -- Now rewrite the expression with a call - - if Transform_Function_Array then - declare - Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'T'); - Call : Node_Id; - Decl : Node_Id; - - begin - -- Generate: - -- Temp : ...; - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Temp_Id, - Object_Definition => - New_Occurrence_Of (Etype (L), Loc)); - - -- Generate: - -- Proc_Call (L, R, Temp); - - Call := - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Func_Name, Loc), - Parameter_Associations => - New_List ( - L, - Make_Type_Conversion - (Loc, New_Occurrence_Of (Etype (L), Loc), R), - New_Occurrence_Of (Temp_Id, Loc))); - - Insert_Actions (Parent (N), New_List (Decl, Call)); - Rewrite (N, New_Occurrence_Of (Temp_Id, Loc)); - end; - else - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func_Name, Loc), - Parameter_Associations => - New_List ( - L, - Make_Type_Conversion - (Loc, New_Occurrence_Of (Etype (L), Loc), R)))); - end if; - + Rewrite (N, + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func_Name, Loc), + Parameter_Associations => + New_List ( + L, + Make_Type_Conversion + (Loc, New_Occurrence_Of (Etype (L), Loc), R)))); Analyze_And_Resolve (N, Typ); end if; end; @@ -4676,29 +4630,13 @@ package body Exp_Ch4 is if Is_Constrained (Siz_Typ) and then Ekind (Siz_Typ) /= E_String_Literal_Subtype then - -- For CCG targets, the largest array may have up to 2**31-1 - -- components (i.e. 2 gigabytes if each array component is - -- one byte). This ensures that fat pointer fields do not - -- overflow, since they are 32-bit integer types, and also - -- ensures that 'Length can be computed at run time. - - if Modify_Tree_For_C then - Cond := - Make_Op_Gt (Loc, - Left_Opnd => Size_In_Storage_Elements (Siz_Typ), - Right_Opnd => Make_Integer_Literal (Loc, - Uint_2 ** 31 - Uint_1)); - - -- For native targets the largest object is 3.5 gigabytes - - else - Cond := - Make_Op_Gt (Loc, - Left_Opnd => Size_In_Storage_Elements (Siz_Typ), - Right_Opnd => Make_Integer_Literal (Loc, - Uint_7 * (Uint_2 ** 29))); - end if; + -- The largest object is 3.5 gigabytes + Cond := + Make_Op_Gt (Loc, + Left_Opnd => Size_In_Storage_Elements (Siz_Typ), + Right_Opnd => Make_Integer_Literal (Loc, + Uint_7 * (Uint_2 ** 29))); Insert_Action (Ins_Nod, Make_Raise_Storage_Error (Loc, Condition => Cond, @@ -5060,15 +4998,7 @@ package body Exp_Ch4 is function Is_Copy_Type (Typ : Entity_Id) return Boolean is begin - -- If Minimize_Expression_With_Actions is True, we can afford to copy - -- large objects, as long as they are constrained and not limited. - - return - Is_Elementary_Type (Underlying_Type (Typ)) - or else - (Minimize_Expression_With_Actions - and then Is_Constrained (Underlying_Type (Typ)) - and then not Is_Limited_Type (Underlying_Type (Typ))); + return Is_Elementary_Type (Underlying_Type (Typ)); end Is_Copy_Type; -- Local variables @@ -5193,17 +5123,6 @@ package body Exp_Ch4 is -- type Ptr_Typ is access all Typ; else - if Generate_C_Code then - - -- We cannot ensure that correct C code will be generated if any - -- temporary is created down the line (to e.g. handle checks or - -- capture values) since we might end up with dangling references - -- to local variables, so better be safe and reject the construct. - - Error_Msg_N - ("case expression too complex, use case statement instead", N); - end if; - Target_Typ := Make_Temporary (Loc, 'P'); Append_To (Acts, @@ -5653,14 +5572,6 @@ package body Exp_Ch4 is Remove (Expr); if Present (Actions) then - - -- To minimize the use of Expression_With_Actions, just skip - -- the optimization as it is not critical for correctness. - - if Minimize_Expression_With_Actions then - return False; - end if; - Rewrite (N, Make_Expression_With_Actions (Loc, Expression => Relocate_Node (Expr), @@ -5886,7 +5797,6 @@ package body Exp_Ch4 is and then Compile_Time_Known_Bounds (Etype (Prefix (Elsex))) and then OK_For_Single_Subtype (Etype (Thenx), Etype (Prefix (Elsex))))) - and then not Generate_C_Code and then not Unnest_Subprogram_Mode then -- When the "then" or "else" expressions involve controlled function @@ -6133,45 +6043,62 @@ package body Exp_Ch4 is then -- We now wrap the actions into the appropriate expression - if Minimize_Expression_With_Actions - and then (Is_Elementary_Type (Underlying_Type (Typ)) - or else Is_Constrained (Underlying_Type (Typ))) - then - -- When the "then" or "else" expressions involve controlled - -- function calls, generated temporaries are chained on the - -- corresponding list of actions. These temporaries need to - -- be finalized after the if expression is evaluated. + -- We do not need to call Process_Transients_In_Expression on + -- the list of actions in this case, because the expansion of + -- Expression_With_Actions will do it. - Process_Transients_In_Expression (N, Then_Actions (N)); - Process_Transients_In_Expression (N, Else_Actions (N)); + if Present (Then_Actions (N)) then + Rewrite (Thenx, + Make_Expression_With_Actions (Sloc (Thenx), + Actions => Then_Actions (N), + Expression => Relocate_Node (Thenx))); - -- If we can't use N_Expression_With_Actions nodes, then we insert - -- the following sequence of actions (using Insert_Actions): + Set_Then_Actions (N, No_List); + Analyze_And_Resolve (Thenx, Typ); + end if; - -- Cnn : typ; - -- if cond then - -- <<then actions>> - -- Cnn := then-expr; - -- else - -- <<else actions>> - -- Cnn := else-expr - -- end if; + if Present (Else_Actions (N)) then + Rewrite (Elsex, + Make_Expression_With_Actions (Sloc (Elsex), + Actions => Else_Actions (N), + Expression => Relocate_Node (Elsex))); - -- and replace the if expression by a reference to Cnn + Set_Else_Actions (N, No_List); + Analyze_And_Resolve (Elsex, Typ); + end if; - declare - Cnn : constant Node_Id := Make_Temporary (Loc, 'C', N); + -- We must force expansion into an expression with actions when + -- an if expression gets used directly as an actual for an + -- anonymous access type. + if Force_Expand then + declare + Cnn : constant Entity_Id := Make_Temporary (Loc, 'C'); + Acts : List_Id; begin + Acts := New_List; + + -- Generate: + -- Cnn : Ann; + Decl := Make_Object_Declaration (Loc, Defining_Identifier => Cnn, Object_Definition => New_Occurrence_Of (Typ, Loc)); + Append_To (Acts, Decl); + + Set_No_Initialization (Decl); + + -- Generate: + -- if Cond then + -- Cnn := <Thenx>; + -- else + -- Cnn := <Elsex>; + -- end if; New_If := Make_Implicit_If_Statement (N, Condition => Relocate_Node (Cond), - Then_Statements => New_List ( Make_Assignment_Statement (Sloc (Thenx), Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), @@ -6181,99 +6108,23 @@ package body Exp_Ch4 is Make_Assignment_Statement (Sloc (Elsex), Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), Expression => Relocate_Node (Elsex)))); + Append_To (Acts, New_If); - Set_Assignment_OK (Name (First (Then_Statements (New_If)))); - Set_Assignment_OK (Name (First (Else_Statements (New_If)))); + -- Generate: + -- do + -- ... + -- in Cnn end; - New_N := New_Occurrence_Of (Cnn, Loc); + Rewrite (N, + Make_Expression_With_Actions (Loc, + Expression => New_Occurrence_Of (Cnn, Loc), + Actions => Acts)); + Analyze_And_Resolve (N, Typ); end; - - -- Regular path using Expression_With_Actions - - else - -- We do not need to call Process_Transients_In_Expression on - -- the list of actions in this case, because the expansion of - -- Expression_With_Actions will do it. - - if Present (Then_Actions (N)) then - Rewrite (Thenx, - Make_Expression_With_Actions (Sloc (Thenx), - Actions => Then_Actions (N), - Expression => Relocate_Node (Thenx))); - - Set_Then_Actions (N, No_List); - Analyze_And_Resolve (Thenx, Typ); - end if; - - if Present (Else_Actions (N)) then - Rewrite (Elsex, - Make_Expression_With_Actions (Sloc (Elsex), - Actions => Else_Actions (N), - Expression => Relocate_Node (Elsex))); - - Set_Else_Actions (N, No_List); - Analyze_And_Resolve (Elsex, Typ); - end if; - - -- We must force expansion into an expression with actions when - -- an if expression gets used directly as an actual for an - -- anonymous access type. - - if Force_Expand then - declare - Cnn : constant Entity_Id := Make_Temporary (Loc, 'C'); - Acts : List_Id; - begin - Acts := New_List; - - -- Generate: - -- Cnn : Ann; - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cnn, - Object_Definition => New_Occurrence_Of (Typ, Loc)); - Append_To (Acts, Decl); - - Set_No_Initialization (Decl); - - -- Generate: - -- if Cond then - -- Cnn := <Thenx>; - -- else - -- Cnn := <Elsex>; - -- end if; - - New_If := - Make_Implicit_If_Statement (N, - Condition => Relocate_Node (Cond), - Then_Statements => New_List ( - Make_Assignment_Statement (Sloc (Thenx), - Name => New_Occurrence_Of (Cnn, Sloc (Thenx)), - Expression => Relocate_Node (Thenx))), - - Else_Statements => New_List ( - Make_Assignment_Statement (Sloc (Elsex), - Name => New_Occurrence_Of (Cnn, Sloc (Elsex)), - Expression => Relocate_Node (Elsex)))); - Append_To (Acts, New_If); - - -- Generate: - -- do - -- ... - -- in Cnn end; - - Rewrite (N, - Make_Expression_With_Actions (Loc, - Expression => New_Occurrence_Of (Cnn, Loc), - Actions => Acts)); - Analyze_And_Resolve (N, Typ); - end; - end if; - - return; end if; + return; + -- For the sake of GNATcoverage, generate an intermediate temporary in -- the case where the if expression is a condition in an outer decision, -- in order to make sure that no branch is shared between the decisions. @@ -9254,8 +9105,7 @@ package body Exp_Ch4 is -- mod are the same, see (RM 4.5.5(28-30)). We do this since it is quite -- likely that this will improve the quality of code, (the operation now -- corresponds to the hardware remainder), and it does not seem likely - -- that it could be harmful. It also avoids some cases of the elaborate - -- expansion in Modify_Tree_For_C mode below (since Ada rem = C %). + -- that it could be harmful. if (LOK and ROK) and then ((Llo >= 0 and then Rlo >= 0) @@ -9319,104 +9169,6 @@ package body Exp_Ch4 is return; end if; - -- If we still have a mod operator and we are in Modify_Tree_For_C - -- mode, and we have a signed integer type, then here is where we do - -- the rewrite in terms of Rem. Note this rewrite bypasses the need - -- for the special handling of the annoying case of largest negative - -- number mod minus one. - - if Nkind (N) = N_Op_Mod - and then Is_Signed_Integer_Type (Typ) - and then Modify_Tree_For_C - then - -- In the general case, we expand A mod B as - - -- Tnn : constant typ := A rem B; - -- .. - -- (if (A >= 0) = (B >= 0) then Tnn - -- elsif Tnn = 0 then 0 - -- else Tnn + B) - - -- The comparison can be written simply as A >= 0 if we know that - -- B >= 0 which is a very common case. - - -- An important optimization is when B is known at compile time - -- to be 2**K for some constant. In this case we can simply AND - -- the left operand with the bit string 2**K-1 (i.e. K 1-bits) - -- and that works for both the positive and negative cases. - - declare - P2 : constant Nat := Power_Of_Two (Right); - - begin - if P2 /= 0 then - Rewrite (N, - Unchecked_Convert_To (Typ, - Make_Op_And (Loc, - Left_Opnd => - Unchecked_Convert_To - (Corresponding_Unsigned_Type (Typ), Left), - Right_Opnd => - Make_Integer_Literal (Loc, 2 ** P2 - 1)))); - Analyze_And_Resolve (N, Typ); - return; - end if; - end; - - -- Here for the full rewrite - - declare - Tnn : constant Entity_Id := Make_Temporary (Sloc (N), 'T', N); - Cmp : Node_Id; - - begin - Cmp := - Make_Op_Ge (Loc, - Left_Opnd => Duplicate_Subexpr_No_Checks (Left), - Right_Opnd => Make_Integer_Literal (Loc, 0)); - - if not LOK or else Rlo < 0 then - Cmp := - Make_Op_Eq (Loc, - Left_Opnd => Cmp, - Right_Opnd => - Make_Op_Ge (Loc, - Left_Opnd => Duplicate_Subexpr_No_Checks (Right), - Right_Opnd => Make_Integer_Literal (Loc, 0))); - end if; - - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => Tnn, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Typ, Loc), - Expression => - Make_Op_Rem (Loc, - Left_Opnd => Left, - Right_Opnd => Right))); - - Rewrite (N, - Make_If_Expression (Loc, - Expressions => New_List ( - Cmp, - New_Occurrence_Of (Tnn, Loc), - Make_If_Expression (Loc, - Is_Elsif => True, - Expressions => New_List ( - Make_Op_Eq (Loc, - Left_Opnd => New_Occurrence_Of (Tnn, Loc), - Right_Opnd => Make_Integer_Literal (Loc, 0)), - Make_Integer_Literal (Loc, 0), - Make_Op_Add (Loc, - Left_Opnd => New_Occurrence_Of (Tnn, Loc), - Right_Opnd => - Duplicate_Subexpr_No_Checks (Right))))))); - - Analyze_And_Resolve (N, Typ); - return; - end; - end if; - -- Deal with annoying case of largest negative number mod minus one. -- Gigi may not handle this case correctly, because on some targets, -- the mod value is computed using a divide instruction which gives @@ -9825,15 +9577,6 @@ package body Exp_Ch4 is -- return B; -- end Nnnn; - -- or in the case of Transform_Function_Array: - - -- procedure Nnnn (A : arr; RESULT : out arr) is - -- begin - -- for J in a'range loop - -- RESULT (J) := not A (J); - -- end loop; - -- end Nnnn; - -- Here arr is the actual subtype of the parameter (and hence always -- constrained). Then we replace the not with a call to this subprogram. @@ -9935,13 +9678,7 @@ package body Exp_Ch4 is end if; A := Make_Defining_Identifier (Loc, Name_uA); - - if Transform_Function_Array then - B := Make_Defining_Identifier (Loc, Name_UP_RESULT); - else - B := Make_Defining_Identifier (Loc, Name_uB); - end if; - + B := Make_Defining_Identifier (Loc, Name_uB); J := Make_Defining_Identifier (Loc, Name_uJ); A_J := @@ -9976,82 +9713,33 @@ package body Exp_Ch4 is Func_Name := Make_Temporary (Loc, 'N'); Set_Is_Inlined (Func_Name); - if Transform_Function_Array then - Insert_Action (N, - Make_Subprogram_Body (Loc, - Specification => - Make_Procedure_Specification (Loc, - Defining_Unit_Name => Func_Name, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => A, - Parameter_Type => New_Occurrence_Of (Typ, Loc)), - Make_Parameter_Specification (Loc, - Defining_Identifier => B, - Out_Present => True, - Parameter_Type => New_Occurrence_Of (Typ, Loc)))), - - Declarations => New_List, - - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Loop_Statement)))); - - declare - Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'T'); - Call : Node_Id; - Decl : Node_Id; - - begin - -- Generate: - -- Temp : ...; - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Temp_Id, - Object_Definition => New_Occurrence_Of (Typ, Loc)); - - -- Generate: - -- Proc_Call (Opnd, Temp); + Insert_Action (N, + Make_Subprogram_Body (Loc, + Specification => + Make_Function_Specification (Loc, + Defining_Unit_Name => Func_Name, + Parameter_Specifications => New_List ( + Make_Parameter_Specification (Loc, + Defining_Identifier => A, + Parameter_Type => New_Occurrence_Of (Typ, Loc))), + Result_Definition => New_Occurrence_Of (Typ, Loc)), - Call := - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Func_Name, Loc), - Parameter_Associations => - New_List (Opnd, New_Occurrence_Of (Temp_Id, Loc))); + Declarations => New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => B, + Object_Definition => New_Occurrence_Of (Arr, Loc))), - Insert_Actions (Parent (N), New_List (Decl, Call)); - Rewrite (N, New_Occurrence_Of (Temp_Id, Loc)); - end; - else - Insert_Action (N, - Make_Subprogram_Body (Loc, - Specification => - Make_Function_Specification (Loc, - Defining_Unit_Name => Func_Name, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => A, - Parameter_Type => New_Occurrence_Of (Typ, Loc))), - Result_Definition => New_Occurrence_Of (Typ, Loc)), - - Declarations => New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => B, - Object_Definition => New_Occurrence_Of (Arr, Loc))), - - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Loop_Statement, - Make_Simple_Return_Statement (Loc, - Expression => Make_Identifier (Loc, Chars (B))))))); + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Loop_Statement, + Make_Simple_Return_Statement (Loc, + Expression => Make_Identifier (Loc, Chars (B))))))); - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func_Name, Loc), - Parameter_Associations => New_List (Opnd))); - end if; + Rewrite (N, + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func_Name, Loc), + Parameter_Associations => New_List (Opnd))); Analyze_And_Resolve (N, Typ); end Expand_N_Op_Not; @@ -10233,52 +9921,6 @@ package body Exp_Ch4 is procedure Expand_N_Op_Rotate_Left (N : Node_Id) is begin Binary_Op_Validity_Checks (N); - - -- If we are in Modify_Tree_For_C mode, there is no rotate left in C, - -- so we rewrite in terms of logical shifts - - -- Shift_Left (Num, Bits) or Shift_Right (num, Esize - Bits) - - -- where Bits is the shift count mod Esize (the mod operation here - -- deals with ludicrous large shift counts, which are apparently OK). - - if Modify_Tree_For_C then - declare - Loc : constant Source_Ptr := Sloc (N); - Rtp : constant Entity_Id := Etype (Right_Opnd (N)); - Typ : constant Entity_Id := Etype (N); - - begin - -- Sem_Intr should prevent getting there with a non binary modulus - - pragma Assert (not Non_Binary_Modulus (Typ)); - - Rewrite (Right_Opnd (N), - Make_Op_Rem (Loc, - Left_Opnd => Relocate_Node (Right_Opnd (N)), - Right_Opnd => Make_Integer_Literal (Loc, Esize (Typ)))); - - Analyze_And_Resolve (Right_Opnd (N), Rtp); - - Rewrite (N, - Make_Op_Or (Loc, - Left_Opnd => - Make_Op_Shift_Left (Loc, - Left_Opnd => Left_Opnd (N), - Right_Opnd => Right_Opnd (N)), - - Right_Opnd => - Make_Op_Shift_Right (Loc, - Left_Opnd => Duplicate_Subexpr_No_Checks (Left_Opnd (N)), - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => Make_Integer_Literal (Loc, Esize (Typ)), - Right_Opnd => - Duplicate_Subexpr_No_Checks (Right_Opnd (N)))))); - - Analyze_And_Resolve (N, Typ); - end; - end if; end Expand_N_Op_Rotate_Left; ------------------------------ @@ -10288,52 +9930,6 @@ package body Exp_Ch4 is procedure Expand_N_Op_Rotate_Right (N : Node_Id) is begin Binary_Op_Validity_Checks (N); - - -- If we are in Modify_Tree_For_C mode, there is no rotate right in C, - -- so we rewrite in terms of logical shifts - - -- Shift_Right (Num, Bits) or Shift_Left (num, Esize - Bits) - - -- where Bits is the shift count mod Esize (the mod operation here - -- deals with ludicrous large shift counts, which are apparently OK). - - if Modify_Tree_For_C then - declare - Loc : constant Source_Ptr := Sloc (N); - Rtp : constant Entity_Id := Etype (Right_Opnd (N)); - Typ : constant Entity_Id := Etype (N); - - begin - -- Sem_Intr should prevent getting there with a non binary modulus - - pragma Assert (not Non_Binary_Modulus (Typ)); - - Rewrite (Right_Opnd (N), - Make_Op_Rem (Loc, - Left_Opnd => Relocate_Node (Right_Opnd (N)), - Right_Opnd => Make_Integer_Literal (Loc, Esize (Typ)))); - - Analyze_And_Resolve (Right_Opnd (N), Rtp); - - Rewrite (N, - Make_Op_Or (Loc, - Left_Opnd => - Make_Op_Shift_Right (Loc, - Left_Opnd => Left_Opnd (N), - Right_Opnd => Right_Opnd (N)), - - Right_Opnd => - Make_Op_Shift_Left (Loc, - Left_Opnd => Duplicate_Subexpr_No_Checks (Left_Opnd (N)), - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => Make_Integer_Literal (Loc, Esize (Typ)), - Right_Opnd => - Duplicate_Subexpr_No_Checks (Right_Opnd (N)))))); - - Analyze_And_Resolve (N, Typ); - end; - end if; end Expand_N_Op_Rotate_Right; ---------------------------- @@ -10346,62 +9942,6 @@ package body Exp_Ch4 is procedure Expand_N_Op_Shift_Left (N : Node_Id) is begin Binary_Op_Validity_Checks (N); - - -- If we are in Modify_Tree_For_C mode, then ensure that the right - -- operand is not greater than the word size (since that would not - -- be defined properly by the corresponding C shift operator). - - if Modify_Tree_For_C then - declare - Right : constant Node_Id := Right_Opnd (N); - Loc : constant Source_Ptr := Sloc (Right); - Typ : constant Entity_Id := Etype (N); - Siz : constant Uint := Esize (Typ); - Orig : Node_Id; - OK : Boolean; - Lo : Uint; - Hi : Uint; - - begin - -- Sem_Intr should prevent getting there with a non binary modulus - - pragma Assert (not Non_Binary_Modulus (Typ)); - - if Compile_Time_Known_Value (Right) then - if Expr_Value (Right) >= Siz then - Rewrite (N, Make_Integer_Literal (Loc, 0)); - Analyze_And_Resolve (N, Typ); - end if; - - -- Not compile time known, find range - - else - Determine_Range (Right, OK, Lo, Hi, Assume_Valid => True); - - -- Nothing to do if known to be OK range, otherwise expand - - if not OK or else Hi >= Siz then - - -- Prevent recursion on copy of shift node - - Orig := Relocate_Node (N); - Set_Analyzed (Orig); - - -- Now do the rewrite - - Rewrite (N, - Make_If_Expression (Loc, - Expressions => New_List ( - Make_Op_Ge (Loc, - Left_Opnd => Duplicate_Subexpr_Move_Checks (Right), - Right_Opnd => Make_Integer_Literal (Loc, Siz)), - Make_Integer_Literal (Loc, 0), - Orig))); - Analyze_And_Resolve (N, Typ); - end if; - end if; - end; - end if; end Expand_N_Op_Shift_Left; ----------------------------- @@ -10422,89 +9962,6 @@ package body Exp_Ch4 is procedure Expand_N_Op_Shift_Right_Arithmetic (N : Node_Id) is begin Binary_Op_Validity_Checks (N); - - -- If we are in Modify_Tree_For_C mode, there is no shift right - -- arithmetic in C, so we rewrite in terms of logical shifts for - -- modular integers, and keep the Shift_Right intrinsic for signed - -- integers: even though doing a shift on a signed integer is not - -- fully guaranteed by the C standard, this is what C compilers - -- implement in practice. - -- Consider also taking advantage of this for modular integers by first - -- performing an unchecked conversion of the modular integer to a signed - -- integer of the same sign, and then convert back. - - -- Shift_Right (Num, Bits) or - -- (if Num >= Sign - -- then not (Shift_Right (Mask, bits)) - -- else 0) - - -- Here Mask is all 1 bits (2**size - 1), and Sign is 2**(size - 1) - - -- Note: the above works fine for shift counts greater than or equal - -- to the word size, since in this case (not (Shift_Right (Mask, bits))) - -- generates all 1'bits. - - if Modify_Tree_For_C and then Is_Modular_Integer_Type (Etype (N)) then - declare - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Etype (N); - Sign : constant Uint := 2 ** (Esize (Typ) - 1); - Mask : constant Uint := (2 ** Esize (Typ)) - 1; - Left : constant Node_Id := Left_Opnd (N); - Right : constant Node_Id := Right_Opnd (N); - Maskx : Node_Id; - - begin - -- Sem_Intr should prevent getting there with a non binary modulus - - pragma Assert (not Non_Binary_Modulus (Typ)); - - -- Here if not (Shift_Right (Mask, bits)) can be computed at - -- compile time as a single constant. - - if Compile_Time_Known_Value (Right) then - declare - Val : constant Uint := Expr_Value (Right); - - begin - if Val >= Esize (Typ) then - Maskx := Make_Integer_Literal (Loc, Mask); - - else - Maskx := - Make_Integer_Literal (Loc, - Intval => Mask - (Mask / (2 ** Expr_Value (Right)))); - end if; - end; - - else - Maskx := - Make_Op_Not (Loc, - Right_Opnd => - Make_Op_Shift_Right (Loc, - Left_Opnd => Make_Integer_Literal (Loc, Mask), - Right_Opnd => Duplicate_Subexpr_No_Checks (Right))); - end if; - - -- Now do the rewrite - - Rewrite (N, - Make_Op_Or (Loc, - Left_Opnd => - Make_Op_Shift_Right (Loc, - Left_Opnd => Left, - Right_Opnd => Right), - Right_Opnd => - Make_If_Expression (Loc, - Expressions => New_List ( - Make_Op_Ge (Loc, - Left_Opnd => Duplicate_Subexpr_No_Checks (Left), - Right_Opnd => Make_Integer_Literal (Loc, Sign)), - Maskx, - Make_Integer_Literal (Loc, 0))))); - Analyze_And_Resolve (N, Typ); - end; - end if; end Expand_N_Op_Shift_Right_Arithmetic; -------------------------- @@ -11408,14 +10865,6 @@ package body Exp_Ch4 is if Is_Fixed_Point_Type (Etype (Expr)) then Ityp := Small_Integer_Type_For (Esize (Base_Type (Etype (Expr))), Uns => False); - - -- Generate a temporary with the integer type to facilitate in the - -- C backend the code generation for the unchecked conversion. - - if Modify_Tree_For_C then - Generate_Temporary; - end if; - Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr)); end if; @@ -12660,27 +12109,6 @@ package body Exp_Ch4 is return; end if; - -- Generate an extra temporary for cases unsupported by the C backend - - if Modify_Tree_For_C then - declare - Source : constant Node_Id := Unqual_Conv (Expression (N)); - Source_Typ : Entity_Id := Get_Full_View (Etype (Source)); - - begin - if Is_Packed_Array (Source_Typ) then - Source_Typ := Packed_Array_Impl_Type (Source_Typ); - end if; - - if Nkind (Source) = N_Function_Call - and then (Is_Composite_Type (Etype (Source)) - or else Is_Composite_Type (Target_Type)) - then - Force_Evaluation (Source); - end if; - end; - end if; - -- Nothing to do if conversion is safe if Safe_Unchecked_Type_Conversion (N) then @@ -12936,26 +12364,9 @@ package body Exp_Ch4 is Shortcut_Ent : constant Entity_Id := Boolean_Literals (Shortcut_Value); -- If Left = Shortcut_Value then Right need not be evaluated - function Make_Test_Expr (Opnd : Node_Id) return Node_Id; - -- For Opnd a boolean expression, return a Boolean expression equivalent - -- to Opnd /= Shortcut_Value. - function Useful (Actions : List_Id) return Boolean; -- Return True if Actions contains useful nodes to process - -------------------- - -- Make_Test_Expr -- - -------------------- - - function Make_Test_Expr (Opnd : Node_Id) return Node_Id is - begin - if Shortcut_Value then - return Make_Op_Not (Sloc (Opnd), Opnd); - else - return Opnd; - end if; - end Make_Test_Expr; - ------------ -- Useful -- ------------ @@ -12979,12 +12390,6 @@ package body Exp_Ch4 is return False; end Useful; - -- Local variables - - Op_Var : Entity_Id; - -- Entity for a temporary variable holding the value of the operator, - -- used for expansion in the case where actions are present. - -- Start of processing for Expand_Short_Circuit_Operator begin @@ -13041,73 +12446,17 @@ package body Exp_Ch4 is if Useful (Actions (N)) then Actlist := Actions (N); - -- The old approach is to expand: - - -- left AND THEN right + -- Use an Expression_With_Actions node for the right operand of the + -- short-circuit form. Note that this solves traceability problems + -- for coverage analysis at the object level. - -- into - - -- C : Boolean := False; - -- IF left THEN - -- Actions; - -- IF right THEN - -- C := True; - -- END IF; - -- END IF; - - -- and finally rewrite the operator into a reference to C. Similarly - -- for left OR ELSE right, with negated values. Note that this - -- rewrite causes some difficulties for coverage analysis because - -- of the introduction of the new variable C, which obscures the - -- structure of the test. - - -- We use this "old approach" if Minimize_Expression_With_Actions - -- is True. - - if Minimize_Expression_With_Actions then - Op_Var := Make_Temporary (Loc, 'C', Related_Node => N); - - Insert_Action (N, - Make_Object_Declaration (Loc, - Defining_Identifier => Op_Var, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc), - Expression => - New_Occurrence_Of (Shortcut_Ent, Loc))); - - Append_To (Actlist, - Make_Implicit_If_Statement (Right, - Condition => Make_Test_Expr (Right), - Then_Statements => New_List ( - Make_Assignment_Statement (LocR, - Name => New_Occurrence_Of (Op_Var, LocR), - Expression => - New_Occurrence_Of - (Boolean_Literals (not Shortcut_Value), LocR))))); - - Insert_Action (N, - Make_Implicit_If_Statement (Left, - Condition => Make_Test_Expr (Left), - Then_Statements => Actlist)); - - Rewrite (N, New_Occurrence_Of (Op_Var, Loc)); - Analyze_And_Resolve (N, Standard_Boolean); - - -- The new approach (the default) is to use an - -- Expression_With_Actions node for the right operand of the - -- short-circuit form. Note that this solves the traceability - -- problems for coverage analysis. - - else - Rewrite (Right, - Make_Expression_With_Actions (LocR, - Expression => Relocate_Node (Right), - Actions => Actlist)); - - Set_Actions (N, No_List); - Analyze_And_Resolve (Right, Standard_Boolean); - end if; + Rewrite (Right, + Make_Expression_With_Actions (LocR, + Expression => Relocate_Node (Right), + Actions => Actlist)); + Set_Actions (N, No_List); + Analyze_And_Resolve (Right, Standard_Boolean); Adjust_Result_Type (N, Typ); return; end if; @@ -14036,15 +13385,6 @@ package body Exp_Ch4 is -- return C; -- end Annn; - -- or in the case of Transform_Function_Array: - - -- procedure Annn (A : typ; B: typ; RESULT: out typ) is - -- begin - -- for J in A'range loop - -- RESULT (J) := A (J) op B (J); - -- end loop; - -- end Annn; - -- Here typ is the boolean array type function Make_Boolean_Array_Op @@ -14070,11 +13410,7 @@ package body Exp_Ch4 is Loop_Statement : Node_Id; begin - if Transform_Function_Array then - C := Make_Defining_Identifier (Loc, Name_UP_RESULT); - else - C := Make_Defining_Identifier (Loc, Name_uC); - end if; + C := Make_Defining_Identifier (Loc, Name_uC); A_J := Make_Indexed_Component (Loc, @@ -14138,52 +13474,28 @@ package body Exp_Ch4 is Defining_Identifier => B, Parameter_Type => New_Occurrence_Of (Typ, Loc))); - if Transform_Function_Array then - Append_To (Formals, - Make_Parameter_Specification (Loc, - Defining_Identifier => C, - Out_Present => True, - Parameter_Type => New_Occurrence_Of (Typ, Loc))); - end if; - Func_Name := Make_Temporary (Loc, 'A'); Set_Is_Inlined (Func_Name); - if Transform_Function_Array then - Func_Body := - Make_Subprogram_Body (Loc, - Specification => - Make_Procedure_Specification (Loc, - Defining_Unit_Name => Func_Name, - Parameter_Specifications => Formals), - - Declarations => New_List, + Func_Body := + Make_Subprogram_Body (Loc, + Specification => + Make_Function_Specification (Loc, + Defining_Unit_Name => Func_Name, + Parameter_Specifications => Formals, + Result_Definition => New_Occurrence_Of (Typ, Loc)), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Loop_Statement))); + Declarations => New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => C, + Object_Definition => New_Occurrence_Of (Typ, Loc))), - else - Func_Body := - Make_Subprogram_Body (Loc, - Specification => - Make_Function_Specification (Loc, - Defining_Unit_Name => Func_Name, - Parameter_Specifications => Formals, - Result_Definition => New_Occurrence_Of (Typ, Loc)), - - Declarations => New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => C, - Object_Definition => New_Occurrence_Of (Typ, Loc))), - - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List ( - Loop_Statement, - Make_Simple_Return_Statement (Loc, - Expression => New_Occurrence_Of (C, Loc))))); - end if; + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Loop_Statement, + Make_Simple_Return_Statement (Loc, + Expression => New_Occurrence_Of (C, Loc))))); return Func_Body; end Make_Boolean_Array_Op; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 5d808a3402d..548589284e2 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -346,10 +346,6 @@ package body Exp_Ch6 is -- of the return scope's entity list and the list structure would otherwise -- be corrupted. The homonym chain is preserved as well. - procedure Rewrite_Function_Call_For_C (N : Node_Id); - -- When generating C code, replace a call to a function that returns an - -- array into the generated procedure with an additional out parameter. - procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id); -- N is a return statement for a function that returns its result on the -- secondary stack. This sets the Sec_Stack_Needed_For_Return flag on the @@ -4078,73 +4074,6 @@ package body Exp_Ch6 is return; end if; - if Transform_Function_Array - and then Nkind (Call_Node) = N_Function_Call - and then Is_Entity_Name (Name (Call_Node)) - then - declare - Func_Id : constant Entity_Id := - Ultimate_Alias (Entity (Name (Call_Node))); - begin - -- When generating C code, transform a function call that returns - -- a constrained array type into procedure form. - - if Rewritten_For_C (Func_Id) then - - -- For internally generated calls ensure that they reference - -- the entity of the spec of the called function (needed since - -- the expander may generate calls using the entity of their - -- body). - - if not Comes_From_Source (Call_Node) - and then Nkind (Unit_Declaration_Node (Func_Id)) = - N_Subprogram_Body - then - Set_Entity (Name (Call_Node), - Corresponding_Function - (Corresponding_Procedure (Func_Id))); - end if; - - Rewrite_Function_Call_For_C (Call_Node); - return; - - -- Also introduce a temporary for functions that return a record - -- called within another procedure or function call, since records - -- are passed by pointer in the generated C code, and we cannot - -- take a pointer from a subprogram call. - - elsif Modify_Tree_For_C - and then Nkind (Parent (Call_Node)) in N_Subprogram_Call - and then Is_Record_Type (Etype (Func_Id)) - then - declare - Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'T'); - Decl : Node_Id; - - begin - -- Generate: - -- Temp : ... := Func_Call (...); - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Temp_Id, - Object_Definition => - New_Occurrence_Of (Etype (Func_Id), Loc), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Func_Id, Loc), - Parameter_Associations => - Parameter_Associations (Call_Node))); - - Insert_Action (Parent (Call_Node), Decl); - Rewrite (Call_Node, New_Occurrence_Of (Temp_Id, Loc)); - return; - end; - end if; - end; - end if; - -- First step, compute extra actuals, corresponding to any Extra_Formals -- present. Note that we do not access Extra_Formals directly, instead -- we simply note the presence of the extra formals as we process the @@ -4577,17 +4506,6 @@ package body Exp_Ch6 is Add_View_Conversion_Invariants (Formal, Actual); end if; - -- Generating C the initialization of an allocator is performed by - -- means of individual statements, and hence it must be done before - -- the call. - - if Modify_Tree_For_C - and then Nkind (Actual) = N_Allocator - and then Nkind (Expression (Actual)) = N_Qualified_Expression - then - Remove_Side_Effects (Actual); - end if; - -- This label is required when skipping extra actual generation for -- Unchecked_Union parameters. @@ -5262,15 +5180,6 @@ package body Exp_Ch6 is and then In_Package_Body then Must_Inline := not In_Extended_Main_Source_Unit (Subp); - - -- Inline calls to _Wrapped_Statements when generating C - - elsif Modify_Tree_For_C - and then In_Same_Extended_Unit (Sloc (Bod), Loc) - and then Chars (Name (Call_Node)) - = Name_uWrapped_Statements - then - Must_Inline := True; end if; end if; @@ -6173,7 +6082,6 @@ package body Exp_Ch6 is Prot_Bod : Node_Id; Prot_Decl : Node_Id; Prot_Id : Entity_Id; - Typ : Entity_Id; begin -- Deal with case of protected subprogram. Do not generate protected @@ -6239,25 +6147,6 @@ package body Exp_Ch6 is Set_Is_Inlined (Subp, False); end; end if; - - -- When generating C code, transform a function that returns a - -- constrained array type into a procedure with an out parameter - -- that carries the return value. - - -- We skip this transformation for unchecked conversions, since they - -- are not needed by the C generator (and this also produces cleaner - -- output). - - Typ := Get_Fullest_View (Etype (Subp)); - - if Transform_Function_Array - and then Nkind (Specification (N)) = N_Function_Specification - and then Is_Array_Type (Typ) - and then Is_Constrained (Typ) - and then not Is_Unchecked_Conversion_Instance (Subp) - then - Build_Procedure_Form (N); - end if; end Expand_N_Subprogram_Declaration; -------------------------------- @@ -9719,120 +9608,6 @@ package body Exp_Ch6 is Set_Is_Aliased (Orig_Id, Is_Aliased (New_Id)); end Replace_Renaming_Declaration_Id; - --------------------------------- - -- Rewrite_Function_Call_For_C -- - --------------------------------- - - procedure Rewrite_Function_Call_For_C (N : Node_Id) is - Orig_Func : constant Entity_Id := Entity (Name (N)); - Func_Id : constant Entity_Id := Ultimate_Alias (Orig_Func); - Par : constant Node_Id := Parent (N); - Proc_Id : constant Entity_Id := Corresponding_Procedure (Func_Id); - Loc : constant Source_Ptr := Sloc (Par); - Actuals : List_Id; - Last_Actual : Node_Id; - Last_Formal : Entity_Id; - - -- Start of processing for Rewrite_Function_Call_For_C - - begin - -- The actuals may be given by named associations, so the added actual - -- that is the target of the return value of the call must be a named - -- association as well, so we retrieve the name of the generated - -- out_formal. - - Last_Formal := First_Formal (Proc_Id); - while Present (Next_Formal (Last_Formal)) loop - Next_Formal (Last_Formal); - end loop; - - Actuals := Parameter_Associations (N); - - -- The original function may lack parameters - - if No (Actuals) then - Actuals := New_List; - end if; - - -- If the function call is the expression of an assignment statement, - -- transform the assignment into a procedure call. Generate: - - -- LHS := Func_Call (...); - - -- Proc_Call (..., LHS); - - -- If function is inherited, a conversion may be necessary. - - if Nkind (Par) = N_Assignment_Statement then - Last_Actual := Name (Par); - - if not Comes_From_Source (Orig_Func) - and then Etype (Orig_Func) /= Etype (Func_Id) - then - Last_Actual := - Make_Type_Conversion (Loc, - New_Occurrence_Of (Etype (Func_Id), Loc), - Last_Actual); - end if; - - Append_To (Actuals, - Make_Parameter_Association (Loc, - Selector_Name => - Make_Identifier (Loc, Chars (Last_Formal)), - Explicit_Actual_Parameter => Last_Actual)); - - Rewrite (Par, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Proc_Id, Loc), - Parameter_Associations => Actuals)); - Analyze (Par); - - -- Otherwise the context is an expression. Generate a temporary and a - -- procedure call to obtain the function result. Generate: - - -- ... Func_Call (...) ... - - -- Temp : ...; - -- Proc_Call (..., Temp); - -- ... Temp ... - - else - declare - Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'T'); - Call : Node_Id; - Decl : Node_Id; - - begin - -- Generate: - -- Temp : ...; - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Temp_Id, - Object_Definition => - New_Occurrence_Of (Etype (Func_Id), Loc)); - - -- Generate: - -- Proc_Call (..., Temp); - - Append_To (Actuals, - Make_Parameter_Association (Loc, - Selector_Name => - Make_Identifier (Loc, Chars (Last_Formal)), - Explicit_Actual_Parameter => - New_Occurrence_Of (Temp_Id, Loc))); - - Call := - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Proc_Id, Loc), - Parameter_Associations => Actuals); - - Insert_Actions (Par, New_List (Decl, Call)); - Rewrite (N, New_Occurrence_Of (Temp_Id, Loc)); - end; - end if; - end Rewrite_Function_Call_For_C; - ------------------------------------ -- Set_Enclosing_Sec_Stack_Return -- ------------------------------------ diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 16d53853646..a6912f7ad48 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3870,17 +3870,13 @@ package body Exp_Ch7 is end if; end; - elsif Nkind (Decl_Or_Stmt) = N_Package_Declaration - and then not Modify_Tree_For_C - then + elsif Nkind (Decl_Or_Stmt) = N_Package_Declaration then Check_Unnesting_In_Decls_Or_Stmts (Visible_Declarations (Specification (Decl_Or_Stmt))); Check_Unnesting_In_Decls_Or_Stmts (Private_Declarations (Specification (Decl_Or_Stmt))); - elsif Nkind (Decl_Or_Stmt) = N_Package_Body - and then not Modify_Tree_For_C - then + elsif Nkind (Decl_Or_Stmt) = N_Package_Body then Check_Unnesting_In_Decls_Or_Stmts (Declarations (Decl_Or_Stmt)); if Present (Statements (Handled_Statement_Sequence (Decl_Or_Stmt))) diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index 011c1feaf33..518ce8b1cc5 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -113,8 +113,6 @@ package body Exp_Ch8 is -- atomic object. Note that we are only interested in these operations -- if they occur as part of the name itself, subscripts are just values -- that are computed as part of the evaluation, so they are unimportant. - -- In addition, always return True for Modify_Tree_For_C since the - -- code generator doesn't know how to handle renamings. ------------------------- -- Evaluation_Required -- @@ -122,10 +120,7 @@ package body Exp_Ch8 is function Evaluation_Required (Nam : Node_Id) return Boolean is begin - if Modify_Tree_For_C then - return True; - - elsif Nkind (Nam) in N_Indexed_Component | N_Slice then + if Nkind (Nam) in N_Indexed_Component | N_Slice then if Is_Packed (Etype (Prefix (Nam))) then return True; diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index e0f0f4f48b7..64e3871ef82 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -1504,52 +1504,12 @@ package body Exp_Dbug is Name_Len := Full_Qualify_Len; Name_Buffer (1 .. Name_Len) := Full_Qualify_Name (1 .. Name_Len); - -- Qualification needed for enumeration literals when generating C code - -- (to simplify their management in the backend). - - elsif Modify_Tree_For_C - and then Ekind (Ent) = E_Enumeration_Literal - and then Scope (Ultimate_Alias (Ent)) /= Standard_Standard - then - Fully_Qualify_Name (Ent); - Name_Len := Full_Qualify_Len; - Name_Buffer (1 .. Name_Len) := Full_Qualify_Name (1 .. Name_Len); - elsif Qualify_Needed (Scope (Ent)) then Name_Len := 0; Set_Entity_Name (Ent); else Set_Has_Qualified_Name (Ent); - - -- If a variable is hidden by a subsequent loop variable, qualify - -- the name of that loop variable to prevent visibility issues when - -- translating to C. Note that gdb probably never handled properly - -- this accidental hiding, given that loops are not scopes at - -- runtime. We also qualify a name if it hides an outer homonym, - -- and both are declared in blocks. - - if Modify_Tree_For_C and then Ekind (Ent) = E_Variable then - if Present (Hiding_Loop_Variable (Ent)) then - declare - Var : constant Entity_Id := Hiding_Loop_Variable (Ent); - - begin - Set_Entity_Name (Var); - Add_Char_To_Name_Buffer ('L'); - Set_Chars (Var, Name_Enter); - end; - - elsif Present (Homonym (Ent)) - and then Ekind (Scope (Ent)) = E_Block - and then Ekind (Scope (Homonym (Ent))) = E_Block - then - Set_Entity_Name (Ent); - Add_Char_To_Name_Buffer ('B'); - Set_Chars (Ent, Name_Enter); - end if; - end if; - return; end if; diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index 2b892c874d7..92502173639 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -445,21 +445,6 @@ package Exp_Dbug is -- WARNING: There is a matching C declaration of this subprogram in fe.h - ------------------------------------- - -- Encoding for translation into C -- - ------------------------------------- - - -- In Modify_Tree_For_C mode we must add encodings to dismabiguate cases - -- where Ada block structure cannot be directly translated. These cases - -- are as follows: - - -- a) A loop variable may hide a homonym in an enclosing block - -- b) A block-local variable may hide a homonym in an enclosing block - - -- In C these constructs are not scopes and we must distinguish the names - -- explicitly. In the first case we create a qualified name with the suffix - -- 'L', in the second case with a suffix 'B'. - -------------------------------------------- -- Subprograms for Handling Qualification -- -------------------------------------------- diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 57f681a84b6..a076eb0eeb6 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -754,14 +754,9 @@ package body Exp_Intr is Rewrite (N, Snode); Set_Analyzed (N); - -- However, we do call the expander, so that the expansion for - -- rotates and shift_right_arithmetic happens if Modify_Tree_For_C - -- is set. - if Expander_Active then Expand (N); end if; - else -- If the context type is not the type of the operator, it is an -- inherited operator for a derived type. Wrap the node in a diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index d3f31448054..19bb8948a89 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -29,7 +29,6 @@ with Einfo; use Einfo; with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; -with Exp_Util; use Exp_Util; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; @@ -282,13 +281,6 @@ package body Exp_Unst is if E = Sub and then Present (Protected_Body_Subprogram (E)) then E := Protected_Body_Subprogram (E); end if; - - if Ekind (E) = E_Function - and then Rewritten_For_C (E) - and then Present (Corresponding_Procedure (E)) - then - E := Corresponding_Procedure (E); - end if; end if; pragma Assert (Subps_Index (E) /= Uint_0); @@ -786,16 +778,6 @@ package body Exp_Unst is if Caller = Callee then return; - -- Callee may be a function that returns an array, and that has - -- been rewritten as a procedure. If caller is that procedure, - -- nothing to do either. - - elsif Ekind (Callee) = E_Function - and then Rewritten_For_C (Callee) - and then Corresponding_Procedure (Callee) = Caller - then - return; - elsif Ekind (Callee) in E_Entry | E_Entry_Family then return; end if; @@ -2223,13 +2205,15 @@ package body Exp_Unst is -- Also ignore if no reference was specified or if the rewriting -- has already been done (this can happen if the N_Identifier -- occurs more than one time in the tree). Also ignore references - -- when not generating C code (in particular for the case of LLVM, - -- since GNAT-LLVM will handle the processing for up-level refs). + -- with GNAT-LLVM (CCG_Mode), since it will handle the processing + -- for up-level refs). + -- ??? At this stage, only GNAT LLVM uses front-end unnesting, so + -- consider remove the code below. if No (UPJ.Ref) or else not Is_Entity_Name (UPJ.Ref) or else No (Entity (UPJ.Ref)) - or else not Opt.Generate_C_Code + or else Opt.CCG_Mode then goto Continue; end if; @@ -2390,17 +2374,6 @@ package body Exp_Unst is -- expect any exceptions) Analyze_And_Resolve (UPJ.Ref, Typ, Suppress => All_Checks); - - -- Generate an extra temporary to facilitate the C backend - -- processing this dereference - - if Opt.Modify_Tree_For_C - and then Nkind (Parent (UPJ.Ref)) in - N_Type_Conversion | N_Unchecked_Type_Conversion - then - Force_Evaluation (UPJ.Ref, Mode => Strict); - end if; - Pop_Scope; end Rewrite_One_Ref; end; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index fcb62a64e70..de096ea752a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -4061,91 +4061,6 @@ package body Exp_Util is Restore_Ghost_Region (Saved_GM, Saved_IGR); end Build_Invariant_Procedure_Declaration; - -------------------------- - -- Build_Procedure_Form -- - -------------------------- - - procedure Build_Procedure_Form (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Subp : constant Entity_Id := Defining_Entity (N); - - Func_Formal : Entity_Id; - Proc_Formals : List_Id; - Proc_Decl : Node_Id; - - begin - -- No action needed if this transformation was already done, or in case - -- of subprogram renaming declarations. - - if Nkind (Specification (N)) = N_Procedure_Specification - or else Nkind (N) = N_Subprogram_Renaming_Declaration - then - return; - end if; - - -- Ditto when dealing with an expression function, where both the - -- original expression and the generated declaration end up being - -- expanded here. - - if Rewritten_For_C (Subp) then - return; - end if; - - Proc_Formals := New_List; - - -- Create a list of formal parameters with the same types as the - -- function. - - Func_Formal := First_Formal (Subp); - while Present (Func_Formal) loop - Append_To (Proc_Formals, - Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Chars (Func_Formal)), - Parameter_Type => - New_Occurrence_Of (Etype (Func_Formal), Loc))); - - Next_Formal (Func_Formal); - end loop; - - -- Add an extra out parameter to carry the function result - - Append_To (Proc_Formals, - Make_Parameter_Specification (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_UP_RESULT), - Out_Present => True, - Parameter_Type => New_Occurrence_Of (Etype (Subp), Loc))); - - -- The new procedure declaration is inserted before the function - -- declaration. The processing in Build_Procedure_Body_Form relies on - -- this order. Note that we insert before because in the case of a - -- function body with no separate spec, we do not want to insert the - -- new spec after the body which will later get rewritten. - - Proc_Decl := - Make_Subprogram_Declaration (Loc, - Specification => - Make_Procedure_Specification (Loc, - Defining_Unit_Name => - Make_Defining_Identifier (Loc, Chars (Subp)), - Parameter_Specifications => Proc_Formals)); - - Insert_Before_And_Analyze (Unit_Declaration_Node (Subp), Proc_Decl); - - -- Entity of procedure must remain invisible so that it does not - -- overload subsequent references to the original function. - - Set_Is_Immediately_Visible (Defining_Entity (Proc_Decl), False); - - -- Mark the function as having a procedure form and link the function - -- and its internally built procedure. - - Set_Rewritten_For_C (Subp); - Set_Corresponding_Procedure (Subp, Defining_Entity (Proc_Decl)); - Set_Corresponding_Function (Defining_Entity (Proc_Decl), Subp); - end Build_Procedure_Form; - ------------------------ -- Build_Runtime_Call -- ------------------------ @@ -12451,16 +12366,6 @@ package body Exp_Util is and then Side_Effect_Free (Exp, Name_Req, Variable_Ref) then return; - - -- Generating C code we cannot remove side effect of function returning - -- class-wide types since there is no secondary stack (required to use - -- 'reference). - - elsif Modify_Tree_For_C - and then Nkind (Exp) = N_Function_Call - and then Is_Class_Wide_Type (Etype (Exp)) - then - return; end if; -- The remaining processing is done with all checks suppressed @@ -12603,30 +12508,7 @@ package body Exp_Util is and then Etype (Expression (Exp)) /= Universal_Integer then Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref); - - -- Generating C code the type conversion of an access to constrained - -- array type into an access to unconstrained array type involves - -- initializing a fat pointer and the expression must be free of - -- side effects to safely compute its bounds. - - if Modify_Tree_For_C - and then Is_Access_Type (Etype (Exp)) - and then Is_Array_Type (Designated_Type (Etype (Exp))) - and then not Is_Constrained (Designated_Type (Etype (Exp))) - then - Def_Id := Build_Temporary (Loc, 'R', Exp); - Set_Etype (Def_Id, Exp_Type); - Res := New_Occurrence_Of (Def_Id, Loc); - - Insert_Action (Exp, - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Object_Definition => New_Occurrence_Of (Exp_Type, Loc), - Constant_Present => True, - Expression => Relocate_Node (Exp))); - else - goto Leave; - end if; + goto Leave; -- If this is an unchecked conversion that Gigi can't handle, make -- a copy or a use a renaming to capture the value. @@ -12712,30 +12594,6 @@ package body Exp_Util is -- Otherwise we generate a reference to the expression else - -- When generating C code we cannot consider side-effect-free object - -- declarations that have discriminants and are initialized by means - -- of a function call since on this target there is no secondary - -- stack to store the return value and the expander may generate an - -- extra call to the function to compute the discriminant value. In - -- addition, for targets that have secondary stack, the expansion of - -- functions with side effects involves the generation of an access - -- type to capture the return value stored in the secondary stack; - -- by contrast when generating C code such expansion generates an - -- internal object declaration (no access type involved) which must - -- be identified here to avoid entering into a never-ending loop - -- generating internal object declarations. - - if Modify_Tree_For_C - and then Nkind (Parent (Exp)) = N_Object_Declaration - and then - (Nkind (Exp) /= N_Function_Call - or else not Has_Discriminants (Exp_Type) - or else Is_Internal_Name - (Chars (Defining_Identifier (Parent (Exp))))) - then - goto Leave; - end if; - -- Special processing for function calls that return a limited type. -- We need to build a declaration that will enable build-in-place -- expansion of the call. This is not done if the context is already @@ -12774,10 +12632,8 @@ package body Exp_Util is -- the secondary stack. Since SPARK (and why) cannot process access -- types, use a different approach which ignores the secondary stack -- and "copies" the returned object. - -- When generating C code, no need for a 'reference since the - -- secondary stack is not supported. - if GNATprove_Mode or Modify_Tree_For_C then + if GNATprove_Mode then Res := New_Occurrence_Of (Def_Id, Loc); Ref_Type := Exp_Type; @@ -12812,10 +12668,10 @@ package body Exp_Util is else E := Relocate_Node (E); - -- Do not generate a 'reference in SPARK mode or C generation - -- since the access type is not created in the first place. + -- Do not generate a 'reference in SPARK mode since the access + -- type is not created in the first place. - if GNATprove_Mode or Modify_Tree_For_C then + if GNATprove_Mode then New_Exp := E; -- Otherwise generate reference, marking the value as non-null @@ -12875,39 +12731,12 @@ package body Exp_Util is Set_Analyzed (E, False); end if; - -- Generating C code of object declarations that have discriminants - -- and are initialized by means of a function call we propagate the - -- discriminants of the parent type to the internally built object. - -- This is needed to avoid generating an extra call to the called - -- function. - - -- For example, if we generate here the following declaration, it - -- will be expanded later adding an extra call to evaluate the value - -- of the discriminant (needed to compute the size of the object). - -- - -- type Rec (D : Integer) is ... - -- Obj : constant Rec := SomeFunc; - - if Modify_Tree_For_C - and then Nkind (Parent (Exp)) = N_Object_Declaration - and then Has_Discriminants (Exp_Type) - and then Nkind (Exp) = N_Function_Call - then - Insert_Action (Exp, - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Object_Definition => New_Copy_Tree - (Object_Definition (Parent (Exp))), - Constant_Present => True, - Expression => New_Exp)); - else - Insert_Action (Exp, - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Object_Definition => New_Occurrence_Of (Ref_Type, Loc), - Constant_Present => True, - Expression => New_Exp)); - end if; + Insert_Action (Exp, + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Object_Definition => New_Occurrence_Of (Ref_Type, Loc), + Constant_Present => True, + Expression => New_Exp)); end if; -- Preserve the Assignment_OK flag in all copies, since at least one @@ -14306,19 +14135,6 @@ package body Exp_Util is and then Is_Class_Wide_Type (Typ) then return True; - - -- Generating C the type conversion of an access to constrained array - -- type into an access to unconstrained array type involves initializing - -- a fat pointer and the expression cannot be assumed to be free of side - -- effects since it must referenced several times to compute its bounds. - - elsif Modify_Tree_For_C - and then Nkind (N) = N_Type_Conversion - and then Is_Access_Type (Typ) - and then Is_Array_Type (Designated_Type (Typ)) - and then not Is_Constrained (Designated_Type (Typ)) - then - return False; end if; -- For other than entity names and compile time known values, diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 96d896a0b98..c772d411bcf 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -318,10 +318,6 @@ package Exp_Util is -- type Typ at runtime. Flag Partial_Invariant should be set when building -- the invariant procedure for a private type. - procedure Build_Procedure_Form (N : Node_Id); - -- Create a procedure declaration which emulates the behavior of a function - -- that returns an array type, for C-compatible generation. - function Build_Runtime_Call (Loc : Source_Ptr; RE : RE_Id) return Node_Id; -- Build an N_Procedure_Call_Statement calling the given runtime entity. -- The call has no parameters. The first argument provides the location diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 7cf7e847677..9c533722985 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -10314,18 +10314,6 @@ package body Freeze is then Check_Overriding_Indicator (E, Empty, Is_Primitive (E)); end if; - - Retype := Get_Fullest_View (Etype (E)); - - if Transform_Function_Array - and then Nkind (Parent (E)) = N_Function_Specification - and then Is_Array_Type (Retype) - and then Is_Constrained (Retype) - and then not Is_Unchecked_Conversion_Instance (E) - and then not Rewritten_For_C (E) - then - Build_Procedure_Form (Unit_Declaration_Node (E)); - end if; end Freeze_Subprogram; ---------------------- diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index ef37bb20f53..a3e85ac6531 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -473,8 +473,6 @@ package Gen_IL.Fields is Corresponding_Concurrent_Type, Corresponding_Discriminant, Corresponding_Equality, - Corresponding_Function, - Corresponding_Procedure, Corresponding_Record_Component, Corresponding_Record_Type, Corresponding_Remote_Type, @@ -881,7 +879,6 @@ package Gen_IL.Fields is Returns_By_Ref, Reverse_Bit_Order, Reverse_Storage_Order, - Rewritten_For_C, RM_Size, Scalar_Range, Scale_Value, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index bdc81202645..80b5925ebb8 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -997,7 +997,6 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (Anonymous_Collections, Elist_Id), Sm (Corresponding_Equality, Node_Id, Pre => "not Comes_From_Source (N) and then Chars (N) = Name_Op_Ne"), - Sm (Corresponding_Procedure, Node_Id), Sm (DT_Position, Uint, Pre_Get => "Present (DTC_Entity (N))"), Sm (DTC_Entity, Node_Id), @@ -1025,7 +1024,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Protected_Subprogram, Node_Id), Sm (Protection_Object, Node_Id), Sm (Related_Expression, Node_Id), - Sm (Rewritten_For_C, Flag), Sm (Thunk_Entity, Node_Id, Pre => "Is_Thunk (N)"), Sm (Wrapped_Entity, Node_Id, @@ -1045,7 +1043,6 @@ begin -- Gen_IL.Gen.Gen_Entities -- body that acts as its own declaration. (Sm (Anonymous_Collections, Elist_Id), Sm (Associated_Node_For_Itype, Node_Id), - Sm (Corresponding_Function, Node_Id), Sm (DT_Position, Uint, Pre_Get => "Present (DTC_Entity (N))"), Sm (DTC_Entity, Node_Id), diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 9743dfd4c4c..6b6fbf3a174 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -164,11 +164,10 @@ procedure Gnat1drv is Unnest_Subprogram_Mode := True; end if; - -- -gnatd.u enables special C expansion mode + -- Force pseudo code generation with -gnatceg - if Debug_Flag_Dot_U then - Modify_Tree_For_C := True; - Transform_Function_Array := True; + if Generate_C_Header then + Operating_Mode := Generate_Code; end if; -- -gnatd_A disables generation of ALI files @@ -177,29 +176,6 @@ procedure Gnat1drv is Disable_ALI_File := True; end if; - -- Set all flags required when generating C code - - if Generate_C_Code then - CCG_Mode := True; - Modify_Tree_For_C := True; - Transform_Function_Array := True; - Unnest_Subprogram_Mode := True; - Building_Static_Dispatch_Tables := False; - Minimize_Expression_With_Actions := True; - Expand_Nonbinary_Modular_Ops := True; - Back_End_Return_Slot := False; - - -- Set operating mode to Generate_Code to benefit from full front-end - -- expansion (e.g. generics). - - Operating_Mode := Generate_Code; - - -- Suppress alignment checks since we do not have access to alignment - -- info on the target. - - Suppress_Options.Suppress (Alignment_Check) := False; - end if; - -- -gnatd.E sets Error_To_Warning mode, causing selected error messages -- to be treated as warnings instead of errors. @@ -238,16 +214,9 @@ procedure Gnat1drv is Debug_Flag_Dot_PP := True; - -- Turn off C tree generation, not compatible with CodePeer mode. We - -- do not expect this to happen in normal use, since both modes are - -- enabled by special tools, but it is useful to turn off these flags - -- this way when we are doing CodePeer tests on existing test suites - -- that may have -gnateg set, to avoid the need for special casing. + -- Turn off front-end unnesting to be safe - Modify_Tree_For_C := False; - Transform_Function_Array := False; - Generate_C_Code := False; - Unnest_Subprogram_Mode := False; + Unnest_Subprogram_Mode := False; -- Turn off inlining, confuses CodePeer output and gains nothing @@ -457,16 +426,9 @@ procedure Gnat1drv is CodePeer_Mode := False; Generate_SCIL := False; - -- Turn off C tree generation, not compatible with GNATprove mode. We - -- do not expect this to happen in normal use, since both modes are - -- enabled by special tools, but it is useful to turn off these flags - -- this way when we are doing GNATprove tests on existing test suites - -- that may have -gnateg set, to avoid the need for special casing. + -- Turn off front-end unnesting to be safe - Modify_Tree_For_C := False; - Transform_Function_Array := False; - Generate_C_Code := False; - Unnest_Subprogram_Mode := False; + Unnest_Subprogram_Mode := False; -- Turn off inlining, which would confuse formal verification output -- and gain nothing. @@ -726,29 +688,14 @@ procedure Gnat1drv is end if; end if; - -- Treat -gnatn as equivalent to -gnatN for non-GCC targets - - if Inline_Active and not Front_End_Inlining then - - -- We really should have a tag for this, what if we added a new - -- back end some day, it would not be true for this test, but it - -- would be non-GCC, so this is a bit troublesome ??? - - Front_End_Inlining := Generate_C_Code; - end if; - -- Set back-end inlining indication Back_End_Inlining := - -- No back-end inlining available on C generation - - not Generate_C_Code - -- No back-end inlining in GNATprove mode, since it just confuses -- the formal verification process. - and then not GNATprove_Mode + not GNATprove_Mode -- No back-end inlining if front-end inlining explicitly enabled. -- Done to minimize the output differences to customers still using @@ -1234,8 +1181,7 @@ begin -- Ditto for old C files before regenerating new ones - if Generate_C_Code then - Delete_C_File; + if Generate_C_Header then Delete_H_File; end if; @@ -1340,20 +1286,10 @@ begin elsif CodePeer_Mode then Back_End_Mode := Generate_Object; - -- Differentiate use of -gnatceg to generate a C header from an Ada spec - -- to the CCG case (standard.h found) where C code generation should - -- only be performed on full units. - - elsif Generate_C_Code then - Name_Len := 10; - Name_Buffer (1 .. Name_Len) := "standard.h"; + -- Force pseudo code generation with -gnatceg - if Find_File (Name_Find, Osint.Source, Full_Name => True) = No_File - then - Back_End_Mode := Generate_Object; - else - Back_End_Mode := Skip; - end if; + elsif Generate_C_Header then + Back_End_Mode := Generate_Object; -- It is not an error to analyze in GNATprove mode a spec which requires -- a body, when the body is not available. During frame condition diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 785ad147755..519e26ecec8 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -3363,20 +3363,11 @@ package body Inline is Targ1 : Node_Id := Empty; -- A separate target used when the return type is unconstrained - procedure Declare_Postconditions_Result; - -- When generating C code, declare _Result, which may be used in the - -- inlined _Postconditions procedure to verify the return value. - procedure Make_Exit_Label; -- Build declaration for exit label to be used in Return statements, -- sets Exit_Lab (the label node) and Lab_Decl (corresponding implicit -- declaration). Does nothing if Exit_Lab already set. - procedure Make_Loop_Labels_Unique (HSS : Node_Id); - -- When compiling for CCG and performing front-end inlining, replace - -- loop names and references to them so that they do not conflict with - -- homographs in the current subprogram. - function Process_Formals (N : Node_Id) return Traverse_Result; -- Replace occurrence of a formal with the corresponding actual, or the -- thunk generated for it. Replace a return statement with an assignment @@ -3411,45 +3402,6 @@ package body Inline is -- If procedure body has no local variables, inline body without -- creating block, otherwise rewrite call with block. - ----------------------------------- - -- Declare_Postconditions_Result -- - ----------------------------------- - - procedure Declare_Postconditions_Result is - Enclosing_Subp : constant Entity_Id := Scope (Subp); - - begin - pragma Assert - (Modify_Tree_For_C - and then Is_Subprogram (Enclosing_Subp) - and then Present (Wrapped_Statements (Enclosing_Subp))); - - if Ekind (Enclosing_Subp) = E_Function then - if Nkind (First (Parameter_Associations (N))) in - N_Numeric_Or_String_Literal - then - Append_To (Declarations (Blk), - Make_Object_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uResult), - Constant_Present => True, - Object_Definition => - New_Occurrence_Of (Etype (Enclosing_Subp), Loc), - Expression => - New_Copy_Tree (First (Parameter_Associations (N))))); - else - Append_To (Declarations (Blk), - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uResult), - Subtype_Mark => - New_Occurrence_Of (Etype (Enclosing_Subp), Loc), - Name => - New_Copy_Tree (First (Parameter_Associations (N))))); - end if; - end if; - end Declare_Postconditions_Result; - --------------------- -- Make_Exit_Label -- --------------------- @@ -3468,61 +3420,6 @@ package body Inline is end if; end Make_Exit_Label; - ----------------------------- - -- Make_Loop_Labels_Unique -- - ----------------------------- - - procedure Make_Loop_Labels_Unique (HSS : Node_Id) is - function Process_Loop (N : Node_Id) return Traverse_Result; - - ------------------ - -- Process_Loop -- - ------------------ - - function Process_Loop (N : Node_Id) return Traverse_Result is - Id : Entity_Id; - - begin - if Nkind (N) = N_Loop_Statement - and then Present (Identifier (N)) - then - -- Create new external name for loop and update the - -- corresponding entity. - - Id := Entity (Identifier (N)); - Set_Chars (Id, New_External_Name (Chars (Id), 'L', -1)); - Set_Chars (Identifier (N), Chars (Id)); - - elsif Nkind (N) = N_Exit_Statement - and then Present (Name (N)) - then - -- The exit statement must name an enclosing loop, whose name - -- has already been updated. - - Set_Chars (Name (N), Chars (Entity (Name (N)))); - end if; - - return OK; - end Process_Loop; - - procedure Update_Loop_Names is new Traverse_Proc (Process_Loop); - - -- Local variables - - Stmt : Node_Id; - - -- Start of processing for Make_Loop_Labels_Unique - - begin - if Modify_Tree_For_C then - Stmt := First (Statements (HSS)); - while Present (Stmt) loop - Update_Loop_Names (Stmt); - Next (Stmt); - end loop; - end if; - end Make_Loop_Labels_Unique; - --------------------- -- Process_Formals -- --------------------- @@ -3811,8 +3708,6 @@ package body Inline is Fst : constant Node_Id := First (Statements (HSS)); begin - Make_Loop_Labels_Unique (HSS); - -- Optimize simple case: function body is a single return statement, -- which has been expanded into an assignment. @@ -3899,8 +3794,6 @@ package body Inline is HSS : constant Node_Id := Handled_Statement_Sequence (Blk); begin - Make_Loop_Labels_Unique (HSS); - -- If there is a transient scope for N, this will be the scope of the -- actions for N, and the statements in Blk need to be within this -- scope. For example, they need to have visibility on the constant @@ -4005,16 +3898,6 @@ package body Inline is Set_Declarations (Blk, New_List); end if; - -- When generating C code, declare _Result, which may be used to - -- verify the return value. - - if Modify_Tree_For_C - and then Nkind (N) = N_Procedure_Call_Statement - and then Chars (Name (N)) = Name_uWrapped_Statements - then - Declare_Postconditions_Result; - end if; - -- For the unconstrained case, capture the name of the local -- variable that holds the result. This must be the first -- declaration in the block, because its bounds cannot depend diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 71d031a69dc..cc3723e1daa 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -699,10 +699,10 @@ package Opt is -- GNAT -- True if generating assembly instead of an object file, via the -S switch - Generate_C_Code : Boolean := False; - -- GNAT, GNATBIND + Generate_C_Header : Boolean := False; + -- GNAT -- If True, the Cprint circuitry to generate C code output is activated. - -- Set True by use of -gnateg or -gnatd.V for GNAT, and -G for GNATBIND. + -- Set True by use of -gnateg for GNAT. Generate_CodePeer_Messages : Boolean := False; -- GNAT @@ -1054,19 +1054,6 @@ package Opt is -- GNATMAKE -- Set to True if minimal recompilation mode requested - Minimize_Expression_With_Actions : Boolean := False; - -- GNAT - -- If True, minimize the use of N_Expression_With_Actions node. - -- This can be used in particular on some back-ends where this node is - -- difficult to support. - - Modify_Tree_For_C : Boolean := False; - -- GNAT - -- If this switch is set True (currently it is set only by -gnatd.V), then - -- certain meaning-preserving transformations are applied to the tree to - -- make it easier to interface with back ends that implement C semantics. - -- There is a section in Sinfo which describes the transformations made. - Multiple_Unit_Index : Nat := 0; -- GNAT -- This is set non-zero if the current unit is being compiled in multiple @@ -1538,12 +1525,6 @@ package Opt is -- Tolerate time stamp and other consistency errors. If this flag is set to -- True (-t), then inconsistencies result in warnings rather than errors. - Transform_Function_Array : Boolean := False; - -- GNAT - -- If this switch is set True, then functions returning constrained arrays - -- are transformed into a procedure with an out parameter, and all calls - -- are updated accordingly. - Treat_Categorization_Errors_As_Warnings : Boolean := False; -- Normally categorization errors are true illegalities. If this switch -- is set, then such errors result in warning messages rather than error diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 08abbae9464..0fef274217a 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -44,23 +44,6 @@ package body Osint.C is -- output file and Suffix is the desired suffix (dg/rep/xxx for debug/ -- repinfo/list file where xxx is specified extension. - ------------------ - -- Close_C_File -- - ------------------ - - procedure Close_C_File is - Status : Boolean; - - begin - Close (Output_FD, Status); - - if not Status then - Fail - ("error while closing file " - & Get_Name_String (Output_File_Name)); - end if; - end Close_C_File; - ---------------------- -- Close_Debug_File -- ---------------------- @@ -190,18 +173,6 @@ package body Osint.C is return Result; end Create_Auxiliary_File; - ------------------- - -- Create_C_File -- - ------------------- - - procedure Create_C_File is - Dummy : Boolean; - begin - Set_File_Name ("c"); - Delete_File (Name_Buffer (1 .. Name_Len), Dummy); - Create_File_And_Check (Output_FD, Text); - end Create_C_File; - ----------------------- -- Create_Debug_File -- ----------------------- @@ -294,17 +265,6 @@ package body Osint.C is end if; end Debug_File_Eol_Length; - ------------------- - -- Delete_C_File -- - ------------------- - - procedure Delete_C_File is - Dummy : Boolean; - begin - Set_File_Name ("c"); - Delete_File (Name_Buffer (1 .. Name_Len), Dummy); - end Delete_C_File; - ------------------- -- Delete_H_File -- ------------------- diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads index 6f8fbb851fd..bde37c72723 100644 --- a/gcc/ada/osint-c.ads +++ b/gcc/ada/osint-c.ads @@ -160,26 +160,22 @@ package Osint.C is -------------------------- -- These routines are used by the compiler when the C translation option - -- is activated to write *.c or *.h files to the current object directory. - -- Each routine exists in a C and an H form for the two kinds of files. - -- Only one of these files can be written at a time. Note that the files - -- are written via the Output package routines, using Output_FD. + -- is activated to write *.h files to the current object directory. + -- Note that the files are written via the Output package routines, using + -- Output_FD. - procedure Create_C_File; procedure Create_H_File; - -- Creates the *.c or *.h file for the source file which is currently - -- being compiled (i.e. the file which was most recently returned by + -- Creates the *.h file for the source file which is currently being + -- compiled (i.e. the file which was most recently returned by -- Next_Main_Source). - procedure Close_C_File; procedure Close_H_File; - -- Closes the file created by Create_C_File or Create_H file, flushing any - -- buffers etc. from writes by Write_C_File and Write_H_File; + -- Closes the file created by Create_H file, flushing any buffers, etc. + -- from writes by Write_C_File and Write_H_File; - procedure Delete_C_File; procedure Delete_H_File; - -- Deletes the .c or .h file corresponding to the source file which is - -- currently being compiled. + -- Deletes the .h file corresponding to the source file which is currently + -- being compiled. ---------------------- -- List File Output -- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 0b0adac1126..d742e1075c0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1509,25 +1509,15 @@ package body Sem_Attr is -- appear on a subprogram renaming, when the renamed entity is an -- attribute reference. - -- Generating C code the internally built nested _postcondition - -- subprograms are inlined; after expanded, inlined aspects are - -- located in the internal block generated by the frontend. - - if Nkind (Subp_Decl) = N_Block_Statement - and then Modify_Tree_For_C - and then In_Inlined_Body - then - null; - - elsif Nkind (Subp_Decl) not in N_Abstract_Subprogram_Declaration - | N_Entry_Declaration - | N_Expression_Function - | N_Full_Type_Declaration - | N_Generic_Subprogram_Declaration - | N_Subprogram_Body - | N_Subprogram_Body_Stub - | N_Subprogram_Declaration - | N_Subprogram_Renaming_Declaration + if Nkind (Subp_Decl) not in N_Abstract_Subprogram_Declaration + | N_Entry_Declaration + | N_Expression_Function + | N_Full_Type_Declaration + | N_Generic_Subprogram_Declaration + | N_Subprogram_Body + | N_Subprogram_Body_Stub + | N_Subprogram_Declaration + | N_Subprogram_Renaming_Declaration then return; end if; @@ -1536,26 +1526,6 @@ package body Sem_Attr is Legal := True; Spec_Id := Unique_Defining_Entity (Subp_Decl); - - -- When generating C code, nested _postcondition subprograms are - -- inlined by the front end to avoid problems (when unnested) with - -- referenced itypes. Handle that here, since as part of inlining the - -- expander nests subprogram within a dummy procedure named _parent - -- (see Build_Postconditions_Procedure and Build_Body_To_Inline). - -- Hence, in this context, the spec_id of _postconditions is the - -- enclosing scope. - - if Modify_Tree_For_C - and then Chars (Spec_Id) = Name_uParent - and then Chars (Scope (Spec_Id)) = Name_uWrapped_Statements - then - -- This situation occurs only when analyzing the body-to-inline - - pragma Assert (Inside_A_Generic); - - Spec_Id := Scope (Spec_Id); - pragma Assert (Is_Inlined (Spec_Id)); - end if; end Analyze_Attribute_Old_Result; ----------------------------- @@ -5530,16 +5500,7 @@ package body Sem_Attr is -- the case, then the aspect or pragma is illegal. Return as analysis -- cannot be carried out. - -- The exception to this rule is when generating C since in this case - -- postconditions are inlined. - - if No (Spec_Id) - and then Modify_Tree_For_C - and then In_Inlined_Body - then - Spec_Id := Entity (P); - - elsif not Legal then + if not Legal then return; end if; @@ -5987,10 +5948,6 @@ package body Sem_Attr is -- Local variables - In_Inlined_C_Postcondition : constant Boolean := - Modify_Tree_For_C - and then In_Inlined_Body; - Legal : Boolean; Pref_Id : Entity_Id; Spec_Id : Entity_Id; @@ -6021,13 +5978,7 @@ package body Sem_Attr is -- the case, then the aspect or pragma is illegal. Return as analysis -- cannot be carried out. - -- The exception to this rule is when generating C since in this case - -- postconditions are inlined. - - if No (Spec_Id) and then In_Inlined_C_Postcondition then - Spec_Id := Entity (P); - - elsif not Legal then + if not Legal then Error_Attr ("prefix of % attribute must be a function", P); end if; @@ -6037,11 +5988,7 @@ package body Sem_Attr is -- Instead, rewrite the attribute as a reference to formal parameter -- _Result of the _Wrapped_Statements procedure. - if Chars (Spec_Id) = Name_uWrapped_Statements - or else - (In_Inlined_C_Postcondition - and then Nkind (Parent (Spec_Id)) = N_Block_Statement) - then + if Chars (Spec_Id) = Name_uWrapped_Statements then Rewrite (N, Make_Identifier (Loc, Name_uResult)); -- The type of formal parameter _Result is that of the function diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 127b521e0a5..8714efe1461 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -8965,9 +8965,7 @@ package body Sem_Ch12 is -- are inlined by the front end, and the front-end inlining machinery -- relies on this routine to perform inlining. - elsif From_Aspect_Specification (N) - and then not Modify_Tree_For_C - then + elsif From_Aspect_Specification (N) then New_N := Make_Null_Statement (Sloc (N)); else diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c0943f97341..8787a904e9f 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4551,11 +4551,7 @@ package body Sem_Ch3 is -- If the aggregate is limited it will be built in place, and its -- expansion is deferred until the object declaration is expanded. - -- This is also required when generating C code to ensure that an - -- object with an alignment or address clause can be initialized - -- by means of component by component assignments. - - if Is_Limited_Type (T) or else Modify_Tree_For_C then + if Is_Limited_Type (T) then Set_Expansion_Delayed (E); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4e1d1bc7ed7..2281ef9ce71 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4709,13 +4709,6 @@ package body Sem_Ch4 is begin if Warn_On_Suspicious_Contract and then not Is_Internal_Name (Chars (Loop_Id)) - - -- Generating C, this check causes spurious warnings on inlined - -- postconditions; we can safely disable it because this check - -- was previously performed when analyzing the internally built - -- postconditions procedure. - - and then not (Modify_Tree_For_C and In_Inlined_Body) then if not Referenced (Loop_Id, Cond) then Error_Msg_N ("?.t?unused variable &", Loop_Id); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 43aa2e636fa..9b85d65862b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2686,22 +2686,6 @@ package body Sem_Ch6 is Analyze (Subp_Decl); - -- Propagate the attributes Rewritten_For_C and Corresponding_Proc to - -- the body since the expander may generate calls using that entity. - -- Required to ensure that Expand_Call rewrites calls to this - -- function by calls to the built procedure. - - if Transform_Function_Array - and then Nkind (Body_Spec) = N_Function_Specification - and then - Rewritten_For_C (Defining_Entity (Specification (Subp_Decl))) - then - Set_Rewritten_For_C (Defining_Entity (Body_Spec)); - Set_Corresponding_Procedure (Defining_Entity (Body_Spec), - Corresponding_Procedure - (Defining_Entity (Specification (Subp_Decl)))); - end if; - -- Analyze any relocated source pragmas or pragmas created for aspect -- specifications. @@ -3740,18 +3724,6 @@ package body Sem_Ch6 is and then not Inside_A_Generic then Build_Subprogram_Declaration; - - -- If this is a function that returns a constrained array, and - -- Transform_Function_Array is set, create subprogram - -- declaration to simplify e.g. subsequent C generation. - - elsif No (Spec_Id) - and then Transform_Function_Array - and then Nkind (Body_Spec) = N_Function_Specification - and then Is_Array_Type (Etype (Body_Id)) - and then Is_Constrained (Etype (Body_Id)) - then - Build_Subprogram_Declaration; end if; end if; @@ -3830,60 +3802,6 @@ package body Sem_Ch6 is Spec_Id := Build_Internal_Protected_Declaration (N); end if; - -- If Transform_Function_Array is set and this is a function returning a - -- constrained array type for which we must create a procedure with an - -- extra out parameter, build and analyze the body now. The procedure - -- declaration has already been created. We reuse the source body of the - -- function, because in an instance it may contain global references - -- that cannot be reanalyzed. The source function itself is not used any - -- further, so we mark it as having a completion. If the subprogram is a - -- stub the transformation is done later, when the proper body is - -- analyzed. - - if Expander_Active - and then Transform_Function_Array - and then Nkind (N) /= N_Subprogram_Body_Stub - then - declare - S : constant Entity_Id := - (if Present (Spec_Id) - then Spec_Id - else Defining_Unit_Name (Specification (N))); - Proc_Body : Node_Id; - - begin - if Ekind (S) = E_Function and then Rewritten_For_C (S) then - Set_Has_Completion (S); - Proc_Body := Build_Procedure_Body_Form (S, N); - - if Present (Spec_Id) then - Rewrite (N, Proc_Body); - Analyze (N); - - -- The entity for the created procedure must remain - -- invisible, so it does not participate in resolution of - -- subsequent references to the function. - - Set_Is_Immediately_Visible (Corresponding_Spec (N), False); - - -- If we do not have a separate spec for N, build one and - -- insert the new body right after. - - else - Rewrite (N, - Make_Subprogram_Declaration (Loc, - Specification => Relocate_Node (Specification (N)))); - Analyze (N); - Insert_After_And_Analyze (N, Proc_Body); - Set_Is_Immediately_Visible - (Corresponding_Spec (Proc_Body), False); - end if; - - goto Leave; - end if; - end; - end if; - -- If a separate spec is present, then deal with freezing issues if Present (Spec_Id) then diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index cebef2ca44f..a030d6b06f1 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -10881,20 +10881,7 @@ package body Sem_Elab is Spec_Id : Entity_Id; begin - Spec_Id := Subp_Id; - - -- The elaboration target denotes an internal function that returns a - -- constrained array type in a SPARK-to-C compilation. In this case - -- the function receives a corresponding procedure which has an out - -- parameter. The proper body for ABE checks and diagnostics is that - -- of the procedure. - - if Ekind (Spec_Id) = E_Function - and then Rewritten_For_C (Spec_Id) - then - Spec_Id := Corresponding_Procedure (Spec_Id); - end if; - + Spec_Id := Subp_Id; Rec.Kind := Subprogram_Target; Spec_And_Body_From_Entity diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 72bba1f97af..19e52260661 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -11479,10 +11479,10 @@ package body Sem_Res is -- Ensure all actions associated with the left operand (e.g. -- finalization of transient objects) are fully evaluated locally within -- an expression with actions. This is particularly helpful for coverage - -- analysis. However this should not happen in generics or if option - -- Minimize_Expression_With_Actions is set. + -- analysis at the object level. However this should not happen in + -- generics. - if Expander_Active and not Minimize_Expression_With_Actions then + if Expander_Active then declare Reloc_L : constant Node_Id := Relocate_Node (L); begin @@ -12514,23 +12514,6 @@ package body Sem_Res is then Set_Do_Range_Check (Operand); end if; - - -- Generating C code a type conversion of an access to constrained - -- array type to access to unconstrained array type involves building - -- a fat pointer which in general cannot be generated on the fly. We - -- remove side effects in order to store the result of the conversion - -- into a temporary. - - if Modify_Tree_For_C - and then Nkind (N) = N_Type_Conversion - and then Nkind (Parent (N)) /= N_Object_Declaration - and then Is_Access_Type (Etype (N)) - and then Is_Array_Type (Designated_Type (Etype (N))) - and then not Is_Constrained (Designated_Type (Etype (N))) - and then Is_Constrained (Designated_Type (Etype (Expression (N)))) - then - Remove_Side_Effects (N); - end if; end Resolve_Type_Conversion; ---------------------- diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 3696ca4f7b4..768bcc0de82 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -727,46 +727,6 @@ package Sinfo is -- refers to a node or is posted on its source location, and has the -- effect of inhibiting further messages involving this same node. - ----------------------- - -- Modify_Tree_For_C -- - ----------------------- - - -- If the flag Opt.Modify_Tree_For_C is set True, then the tree is modified - -- in ways that help match the semantics better with C, easing the task of - -- interfacing to C code generators (other than GCC, where the work is done - -- in gigi, and there is no point in changing that), and also making life - -- easier for Cprint in generating C source code. - - -- The current modifications implemented are as follows: - - -- N_Op_Rotate_Left, N_Op_Rotate_Right, N_Shift_Right_Arithmetic nodes - -- are eliminated from the tree (since these operations do not exist in - -- C), and the operations are rewritten in terms of logical shifts and - -- other logical operations that do exist in C. See Exp_Ch4 expansion - -- routines for these operators for details of the transformations made. - - -- The right operand of N_Op_Shift_Right and N_Op_Shift_Left is always - -- less than the word size (since other values are not well-defined in - -- C). This is done using an explicit test if necessary. - - -- Min and Max attributes are expanded into equivalent if expressions, - -- dealing properly with side effect issues. - - -- Mod for signed integer types is expanded into equivalent expressions - -- using Rem (which is % in C) and other C-available operators. - - -- Functions returning bounded arrays are transformed into procedures - -- with an extra out parameter, and the calls updated accordingly. - - -- Aggregates are only kept unexpanded for object declarations, otherwise - -- they are systematically expanded into loops (for arrays) and - -- individual assignments (for records). - - -- Unconstrained array types are handled by means of fat pointers. - - -- Postconditions are inlined by the frontend since their body may have - -- references to itypes defined in the enclosing subprogram. - ------------------------------------ -- Description of Semantic Fields -- ------------------------------------ @@ -4020,9 +3980,6 @@ package Sinfo is -- Must_Be_Byte_Aligned -- plus fields for expression - -- Note: in Modify_Tree_For_C mode, Max and Min attributes are expanded - -- into equivalent if expressions, properly taking care of side effects. - --------------------------------- -- 4.1.4 Attribute Designator -- --------------------------------- @@ -4630,11 +4587,6 @@ package Sinfo is -- and we are running in ELIMINATED mode, the operator node will be -- changed to be a call to the appropriate routine in System.Bignums. - -- Note: In Modify_Tree_For_C mode, we do not generate an N_Op_Mod node - -- for signed integer types (since there is no equivalent operator in - -- C). Instead we rewrite such an operation in terms of REM (which is - -- % in C) and other C-available operators. - ------------------------------------ -- 4.5.7 Conditional Expressions -- ------------------------------------ @@ -7798,12 +7750,6 @@ package Sinfo is -- plus fields for expression -- Shift_Count_OK - -- Note: N_Op_Rotate_Left, N_Op_Rotate_Right, N_Shift_Right_Arithmetic - -- never appear in the expanded tree if Modify_Tree_For_C mode is set. - - -- Note: For N_Op_Shift_Left and N_Op_Shift_Right, the right operand is - -- always less than the word size if Modify_Tree_For_C mode is set. - -------------------------- -- Obsolescent Features -- -------------------------- @@ -8113,9 +8059,6 @@ package Sinfo is -- the expression of the node is fully analyzed and expanded, at which -- point it is safe to remove it, since no more actions can be inserted. - -- Note: In Modify_Tree_For_C, we never generate any declarations in - -- the action list, which can contain only non-declarative statements. - -------------------- -- Free Statement -- -------------------- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 5be3044158e..eb4eca0cf7d 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1376,9 +1376,8 @@ package Snames is -- Other miscellaneous names used in front end -- Note that the UP_ prefix means use the rest of the name in uppercase, - -- e.g. Name_UP_RESULT corresponds to the name "RESULT". + -- e.g. Name_UP_RESULT maps to "RESULT". - Name_UP_RESULT : constant Name_Id := N + $; Name_Synchronous_Task_Control : constant Name_Id := N + $; -- Names used to implement iterators over predefined containers diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index 2de516dba56..7cc0b8f0e3d 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -362,12 +362,6 @@ package body Switch.B is Debugger_Level := 2; end if; - -- Processing for G switch - - when 'G' => - Ptr := Ptr + 1; - Generate_C_Code := True; - -- Processing for h switch when 'h' => diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 25cb6f20da6..9b5dde7c8d8 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -616,7 +616,7 @@ package body Switch.C is Ptr := Ptr + 1; Check_Float_Overflow := not Machine_Overflows_On_Target; - -- -gnateg (generate C code) + -- -gnateg (generate C header) when 'g' => -- Special check, -gnateg must occur after -gnatc @@ -626,7 +626,7 @@ package body Switch.C is ("gnateg requires previous occurrence of -gnatc"); end if; - Generate_C_Code := True; + Generate_C_Header := True; Ptr := Ptr + 1; -- -gnateG (save preprocessor output)

[COMMITTED,04/30] ada: Remove support for bodies in -gnatceg

Commit Message

Patch