https://gcc.gnu.org/g:3c72be1a96fadb6b0e19444f99a51ef0733347a2
commit r15-2610-g3c72be1a96fadb6b0e19444f99a51ef0733347a2
Author: Arnaud Charlet <char...@adacore.com>
Date: Thu Jun 13 07:20:49 2024 +0000
ada: Remove support for bodies in -gnatceg
The support for generating C for Ada code is moved to GNAT LLVM.
Keep support for generating header files from Ada spec files which
is the remaining usage of -gnatceg.
gcc/ada/
* bindgen.adb, bindusg.adb, debug.adb, einfo.ads,
exp_aggr.adb, exp_attr.adb, exp_ch11.adb, exp_ch3.adb,
exp_ch4.adb, exp_ch6.adb, exp_ch7.adb, exp_ch8.adb, exp_dbug.adb,
exp_dbug.ads, exp_intr.adb, exp_unst.adb, exp_util.adb,
exp_util.ads, freeze.adb, gen_il-fields.ads,
gen_il-gen-gen_entities.adb, gnat1drv.adb, inline.adb, opt.ads,
osint-c.adb, osint-c.ads, sem_attr.adb, sem_ch12.adb, sem_ch3.adb,
sem_ch4.adb, sem_ch6.adb, sem_elab.adb, sem_res.adb, sinfo.ads,
snames.ads-tmpl, switch-b.adb, switch-c.adb: Major
clean up to remove C code generation for bodies.
Diff:
---
gcc/ada/bindgen.adb | 1 -
gcc/ada/bindusg.adb | 5 -
gcc/ada/debug.adb | 11 +-
gcc/ada/einfo.ads | 20 -
gcc/ada/exp_aggr.adb | 203 +-------
gcc/ada/exp_attr.adb | 162 +++----
gcc/ada/exp_ch11.adb | 6 -
gcc/ada/exp_ch3.adb | 14 +-
gcc/ada/exp_ch4.adb | 934 +++++-------------------------------
gcc/ada/exp_ch6.adb | 225 ---------
gcc/ada/exp_ch7.adb | 8 +-
gcc/ada/exp_ch8.adb | 7 +-
gcc/ada/exp_dbug.adb | 40 --
gcc/ada/exp_dbug.ads | 15 -
gcc/ada/exp_intr.adb | 5 -
gcc/ada/exp_unst.adb | 37 +-
gcc/ada/exp_util.adb | 206 +-------
gcc/ada/exp_util.ads | 4 -
gcc/ada/freeze.adb | 12 -
gcc/ada/gen_il-fields.ads | 3 -
gcc/ada/gen_il-gen-gen_entities.adb | 3 -
gcc/ada/gnat1drv.adb | 88 +---
gcc/ada/inline.adb | 117 -----
gcc/ada/opt.ads | 25 +-
gcc/ada/osint-c.adb | 40 --
gcc/ada/osint-c.ads | 22 +-
gcc/ada/sem_attr.adb | 77 +--
gcc/ada/sem_ch12.adb | 4 +-
gcc/ada/sem_ch3.adb | 6 +-
gcc/ada/sem_ch4.adb | 7 -
gcc/ada/sem_ch6.adb | 82 ----
gcc/ada/sem_elab.adb | 15 +-
gcc/ada/sem_res.adb | 23 +-
gcc/ada/sinfo.ads | 57 ---
gcc/ada/snames.ads-tmpl | 3 +-
gcc/ada/switch-b.adb | 6 -
gcc/ada/switch-c.adb | 4 +-
37 files changed, 267 insertions(+), 2230 deletions(-)
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index 89b2b88395bc..cdfaa08d8a6d 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 855fd16c9305..e870c5f0e22a 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 3313c4a408f4..d2546bec1b5f 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 fbe6c8566ecf..0d839b9b6911 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 419a98c681a6..c7730ca754ab 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 627cd7f33929..13c7444ca878 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 678d76cf3eb0..925b164cb2f6 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 70048e683311..1eea062210ab 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 abe76c8767ee..f952005ed755 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 5d808a3402d0..548589284e24 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 16d53853646c..a6912f7ad487 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 011c1feaf331..518ce8b1cc5d 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 e0f0f4f48b7e..64e3871ef828 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 2b892c874d7e..925021736394 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 57f681a84b67..a076eb0eeb6a 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 d3f314480541..19bb8948a890 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 fcb62a64e706..de096ea752a5 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 96d896a0b98a..c772d411bcfd 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 7cf7e8476775..9c5337229854 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 ef37bb20f53c..a3e85ac6531a 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 bdc812026455..80b5925ebb85 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 9743dfd4c4c9..6b6fbf3a1749 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 785ad147755e..519e26ecec80 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 71d031a69dc5..cc3723e1daa5 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 08abbae94649..0fef274217a5 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 6f8fbb851fdb..bde37c727238 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 0b0adac11266..d742e1075c0c 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 127b521e0a56..8714efe14610 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 c0943f973419..8787a904e9f6 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 4e1d1bc7ed76..2281ef9ce71b 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 43aa2e636fa9..9b85d65862b1 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 cebef2ca44f3..a030d6b06f1f 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 72bba1f97af1..19e522606618 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 3696ca4f7b4c..768bcc0de823 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 5be3044158ee..eb4eca0cf7dd 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 2de516dba56b..7cc0b8f0e3dc 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 25cb6f20da61..9b5dde7c8d83 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)
