+2016-07-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_aggr.adb (Ctrl_Init_Expression): New routine.
+ (Gen_Assign): Code cleanup. Perform in-place side effect removal when
+ the expression denotes a controlled function call.
+ * exp_util.adb (Remove_Side_Effects): Do not remove side effects
+ on a function call which has this behavior suppressed.
+ * sem_aggr.adb Code cleanup.
+ * sinfo.adb (No_Side_Effect_Removal): New routine.
+ (Set_Side_Effect_Removal): New routine.
+ * sinfo.ads New attribute No_Side_Effect_Removal along with
+ occurences in nodes.
+ (No_Side_Effect_Removal): New routine along with pragma Inline.
+ (Set_Side_Effect_Removal): New routine along with pragma Inline.
+
+2016-07-04 Arnaud Charlet <charlet@adacore.com>
+
+ * opt.ads, sem_prag.adb (Universal_Addressing_On_AAMP): Removed.
+ Remove support for pragma No_Run_Time. Update comments.
+
+2016-07-04 Pascal Obry <obry@adacore.com>
+
+ * g-forstr.ads: More documentation for the Formatted_String
+ support.
+
+2016-07-04 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case
+ 'Address): If the address comes from an aspect specification
+ and not a source attribute definition clause, do not remove
+ side effects from the expression, because the expression must
+ be elaborated at the freeze point of the object and not at the
+ object declaration, because of the delayed analysis of aspect
+ specifications.
+
2016-06-29 Eric Botcazou <ebotcazou@adacore.com>
PR ada/48835
----------------
function Gen_Assign (Ind : Node_Id; Expr : Node_Id) return List_Id is
- L : constant List_Id := New_List;
- A : Node_Id;
-
- New_Indexes : List_Id;
- Indexed_Comp : Node_Id;
- Expr_Q : Node_Id;
- Comp_Type : Entity_Id := Empty;
-
function Add_Loop_Actions (Lis : List_Id) return List_Id;
-- Collect insert_actions generated in the construction of a
-- loop, and prepend them to the sequence of assignments to
-- complete the eventual body of the loop.
+ function Ctrl_Init_Expression
+ (Comp_Typ : Entity_Id;
+ Stmts : List_Id) return Node_Id;
+ -- Perform in-place side effect removal if expression Expr denotes a
+ -- controlled function call. Return a reference to the entity which
+ -- captures the result of the call. Comp_Typ is the expected type of
+ -- the component. Stmts is the list of initialization statmenets. Any
+ -- generated code is added to Stmts.
+
----------------------
-- Add_Loop_Actions --
----------------------
end if;
end Add_Loop_Actions;
+ --------------------------
+ -- Ctrl_Init_Expression --
+ --------------------------
+
+ function Ctrl_Init_Expression
+ (Comp_Typ : Entity_Id;
+ Stmts : List_Id) return Node_Id
+ is
+ Init_Expr : Node_Id;
+ Obj_Id : Entity_Id;
+ Ptr_Typ : Entity_Id;
+
+ begin
+ Init_Expr := New_Copy_Tree (Expr);
+
+ -- Perform a preliminary analysis and resolution to determine
+ -- what the expression denotes. Note that a function call may
+ -- appear as an identifier or an indexed component.
+
+ Preanalyze_And_Resolve (Init_Expr, Comp_Typ);
+
+ -- The initialization expression is a controlled function call.
+ -- Perform in-place removal of side effects to avoid creating a
+ -- transient scope. In the end the temporary function result is
+ -- finalized by the general finalization machinery.
+
+ if Nkind (Init_Expr) = N_Function_Call then
+
+ -- Suppress the removal of side effects by generatal analysis
+ -- because this behavior is emulated here.
+
+ Set_No_Side_Effect_Removal (Init_Expr);
+
+ -- Generate:
+ -- type Ptr_Typ is access all Comp_Typ;
+
+ Ptr_Typ := Make_Temporary (Loc, 'A');
+
+ Append_To (Stmts,
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Ptr_Typ,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ All_Present => True,
+ Subtype_Indication =>
+ New_Occurrence_Of (Comp_Typ, Loc))));
+
+ -- Generate:
+ -- Obj : constant Ptr_Typ := Init_Expr'Reference;
+
+ Obj_Id := Make_Temporary (Loc, 'R');
+
+ Append_To (Stmts,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Obj_Id,
+ Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc),
+ Expression => Make_Reference (Loc, Init_Expr)));
+
+ -- Generate:
+ -- Obj.all;
+
+ return
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Occurrence_Of (Obj_Id, Loc));
+
+ -- Otherwise the initialization expression denotes a controlled
+ -- object. There is nothing special to be done here as there is
+ -- no possible transient scope involvement.
+
+ else
+ return Init_Expr;
+ end if;
+ end Ctrl_Init_Expression;
+
+ -- Local variables
+
+ Stmts : constant List_Id := New_List;
+
+ Comp_Typ : Entity_Id := Empty;
+ Expr_Q : Node_Id;
+ Indexed_Comp : Node_Id;
+ New_Indexes : List_Id;
+ Stmt : Node_Id;
+ Stmt_Expr : Node_Id;
+
-- Start of processing for Gen_Assign
begin
end if;
if Present (Etype (N)) and then Etype (N) /= Any_Composite then
- Comp_Type := Component_Type (Etype (N));
- pragma Assert (Comp_Type = Ctype); -- AI-287
+ Comp_Typ := Component_Type (Etype (N));
+ pragma Assert (Comp_Typ = Ctype); -- AI-287
elsif Present (Next (First (New_Indexes))) then
if Nkind (P) = N_Aggregate
and then Present (Etype (P))
then
- Comp_Type := Component_Type (Etype (P));
+ Comp_Typ := Component_Type (Etype (P));
exit;
else
end if;
end loop;
- pragma Assert (Comp_Type = Ctype); -- AI-287
+ pragma Assert (Comp_Typ = Ctype); -- AI-287
end;
end if;
end if;
-- the analysis of non-array aggregates now in order to get the
-- value of Expansion_Delayed flag for the inner aggregate ???
- if Present (Comp_Type) and then not Is_Array_Type (Comp_Type) then
- Analyze_And_Resolve (Expr_Q, Comp_Type);
+ if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) then
+ Analyze_And_Resolve (Expr_Q, Comp_Typ);
end if;
if Is_Delayed_Aggregate (Expr_Q) then
-- generated in the usual fashion, and sliding will take place.
if Nkind (Parent (N)) = N_Assignment_Statement
- and then Is_Array_Type (Comp_Type)
+ and then Is_Array_Type (Comp_Typ)
and then Present (Component_Associations (Expr_Q))
- and then Must_Slide (Comp_Type, Etype (Expr_Q))
+ and then Must_Slide (Comp_Typ, Etype (Expr_Q))
then
Set_Expansion_Delayed (Expr_Q, False);
Set_Analyzed (Expr_Q, False);
if Present (Base_Init_Proc (Base_Type (Ctype)))
or else Has_Task (Base_Type (Ctype))
then
- Append_List_To (L,
+ Append_List_To (Stmts,
Build_Initialization_Call (Loc,
Id_Ref => Indexed_Comp,
Typ => Ctype,
if Has_Invariants (Ctype) then
Set_Etype (Indexed_Comp, Ctype);
- Append_To (L, Make_Invariant_Call (Indexed_Comp));
+ Append_To (Stmts, Make_Invariant_Call (Indexed_Comp));
end if;
elsif Is_Access_Type (Ctype) then
- Append_To (L,
+ Append_To (Stmts,
Make_Assignment_Statement (Loc,
- Name => Indexed_Comp,
+ Name => New_Copy_Tree (Indexed_Comp),
Expression => Make_Null (Loc)));
end if;
if Needs_Finalization (Ctype) then
- Append_To (L,
+ Append_To (Stmts,
Make_Init_Call
(Obj_Ref => New_Copy_Tree (Indexed_Comp),
Typ => Ctype));
end if;
else
- A :=
+ -- Handle an initialization expression of a controlled type in
+ -- case it denotes a function call. In general such a scenario
+ -- will produce a transient scope, but this will lead to wrong
+ -- order of initialization, adjustment, and finalization in the
+ -- context of aggregates.
+
+ -- Arr_Comp (1) := Ctrl_Func_Call;
+
+ -- begin -- transient scope
+ -- Trans_Obj : ... := Ctrl_Func_Call; -- transient object
+ -- Arr_Comp (1) := Trans_Obj;
+ -- Finalize (Trans_Obj);
+ -- end;
+ -- Arr_Comp (1)._tag := ...;
+ -- Adjust (Arr_Comp (1));
+
+ -- In the example above, the call to Finalize occurs too early
+ -- and as a result it may leave the array component in a bad
+ -- state. Finalization of the transient object should really
+ -- happen after adjustment.
+
+ -- To avoid this scenario, perform in-place side effect removal
+ -- of the function call. This eliminates the transient property
+ -- of the function result and ensures correct order of actions.
+ -- Note that the function result behaves as a source controlled
+ -- object and is finalized by the general finalization mechanism.
+
+ -- begin
+ -- Res : ... := Ctrl_Func_Call;
+ -- Arr_Comp (1) := Res;
+ -- Arr_Comp (1)._tag := ...;
+ -- Adjust (Arr_Comp (1));
+ -- at end
+ -- Finalize (Res);
+ -- end;
+
+ -- There is no need to perform this kind of light expansion when
+ -- the component type is limited controlled because everything is
+ -- already done in place.
+
+ if Present (Comp_Typ)
+ and then Needs_Finalization (Comp_Typ)
+ and then not Is_Limited_Type (Comp_Typ)
+ and then Nkind (Expr) /= N_Aggregate
+ then
+ Stmt_Expr := Ctrl_Init_Expression (Comp_Typ, Stmts);
+
+ -- Otherwise use the initialization expression directly
+
+ else
+ Stmt_Expr := New_Copy_Tree (Expr);
+ end if;
+
+ Stmt :=
Make_OK_Assignment_Statement (Loc,
- Name => Indexed_Comp,
- Expression => New_Copy_Tree (Expr));
+ Name => New_Copy_Tree (Indexed_Comp),
+ Expression => Stmt_Expr);
-- The target of the assignment may not have been initialized,
-- so it is not possible to call Finalize as expected in normal
-- actions are done manually with the proper finalization list
-- coming from the context.
- Set_No_Ctrl_Actions (A);
+ Set_No_Ctrl_Actions (Stmt);
-- If this is an aggregate for an array of arrays, each
-- subaggregate will be expanded as well, and even with
-- that finalization takes place for each subaggregate we wrap the
-- assignment in a block.
- if Present (Comp_Type)
- and then Needs_Finalization (Comp_Type)
- and then Is_Array_Type (Comp_Type)
+ if Present (Comp_Typ)
+ and then Needs_Finalization (Comp_Typ)
+ and then Is_Array_Type (Comp_Typ)
and then Present (Expr)
then
- A :=
+ Stmt :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
- Statements => New_List (A)));
+ Statements => New_List (Stmt)));
end if;
- Append_To (L, A);
+ Append_To (Stmts, Stmt);
- -- Adjust the tag if tagged (because of possible view
- -- conversions), unless compiling for a VM where tags
- -- are implicit.
+ -- Adjust the tag due to a possible view conversion
- if Present (Comp_Type)
- and then Is_Tagged_Type (Comp_Type)
+ if Present (Comp_Typ)
+ and then Is_Tagged_Type (Comp_Typ)
and then Tagged_Type_Expansion
then
declare
- Full_Typ : constant Entity_Id := Underlying_Type (Comp_Type);
+ Full_Typ : constant Entity_Id := Underlying_Type (Comp_Typ);
begin
- A :=
+ Append_To (Stmts,
Make_OK_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
Unchecked_Convert_To (RTE (RE_Tag),
New_Occurrence_Of
(Node (First_Elmt (Access_Disp_Table (Full_Typ))),
- Loc)));
-
- Append_To (L, A);
+ Loc))));
end;
end if;
-- (see comments above, concerning the creation of a block to hold
-- inner finalization actions).
- if Present (Comp_Type)
- and then Needs_Finalization (Comp_Type)
- and then not Is_Limited_Type (Comp_Type)
+ if Present (Comp_Typ)
+ and then Needs_Finalization (Comp_Typ)
+ and then not Is_Limited_Type (Comp_Typ)
and then not
- (Is_Array_Type (Comp_Type)
- and then Is_Controlled (Component_Type (Comp_Type))
+ (Is_Array_Type (Comp_Typ)
+ and then Is_Controlled (Component_Type (Comp_Typ))
and then Nkind (Expr) = N_Aggregate)
then
- Append_To (L,
+ Append_To (Stmts,
Make_Adjust_Call
(Obj_Ref => New_Copy_Tree (Indexed_Comp),
- Typ => Comp_Type));
+ Typ => Comp_Typ));
end if;
end if;
- return Add_Loop_Actions (L);
+ return Add_Loop_Actions (Stmts);
end Gen_Assign;
--------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- has a delayed freeze, but the address expression itself
-- must be elaborated at the point it appears. If the object
-- is controlled, additional checks apply elsewhere.
+ -- If the attribute comes from an aspect specification it
+ -- is being elaborated at the freeze point and side effects
+ -- need not be removed (and shouldn't, if the expression
+ -- depends on other entities that have delayed freeze).
+ -- This is another consequence of the delayed analysis of
+ -- aspects, and a real semantic difference.
elsif Nkind (Decl) = N_Object_Declaration
and then not Needs_Constant_Address (Decl, Typ)
+ and then not From_Aspect_Specification (N)
then
Remove_Side_Effects (Exp);
end if;
and (Inside_A_Generic or not Full_Analysis or not GNATprove_Mode)
then
return;
- end if;
-- Cannot generate temporaries if the invocation to remove side effects
-- was issued too early and the type of the expression is not resolved
-- (this happens because routines Duplicate_Subexpr_XX implicitly invoke
-- Remove_Side_Effects).
- if No (Exp_Type) or else Ekind (Exp_Type) = E_Access_Attribute_Type then
+ elsif No (Exp_Type)
+ or else Ekind (Exp_Type) = E_Access_Attribute_Type
+ then
+ return;
+
+ -- Nothing to do if prior expansion determined that a function call does
+ -- not require side effect removal.
+
+ elsif Nkind (Exp) = N_Function_Call
+ and then No_Side_Effect_Removal (Exp)
+ then
return;
-- No action needed for side-effect free expressions
-- --
-- S p e c --
-- --
--- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2014-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
--- This package add support for formatted string as supported by C printf().
+-- This package add support for formatted string as supported by C printf()
-- A simple usage is:
-
+--
+-- Put_Line (-(+"%s" & "a string"));
+--
+-- or with a constant for the format:
+--
+-- declare
+-- Format : constant Formatted_String := +"%s";
+-- begin
+-- Put_Line (-(Format & "a string"));
+-- end;
+--
+-- Finally a more complex example:
+--
-- declare
-- F : Formatted_String := +"['%c' ; %10d]";
-- C : Character := 'v';
GNAT_Encodings : Int;
pragma Import (C, GNAT_Encodings, "gnat_encodings");
-- Constant controlling the balance between GNAT encodings and standard
- -- DWARF to emit in the debug information. See aamissing.c for definitions
- -- for the GNAAMP back end. It accepts the following values.
+ -- DWARF to emit in the debug information. It accepts the following values.
DWARF_GNAT_Encodings_All : constant Int := 0;
DWARF_GNAT_Encodings_GDB : constant Int := 1;
Optimization_Level : Int;
pragma Import (C, Optimization_Level, "optimize");
-- Constant reflecting the optimization level (0,1,2,3 for -O0,-O1,-O2,-O3)
- -- See e.g. aamissing.c for definitions for the GNAAMP back end.
Optimize_Size : Int;
pragma Import (C, Optimize_Size, "optimize_size");
-- Constant reflecting setting of -Os (optimize for size). Set to nonzero
- -- in -Os mode and set to zero otherwise. See aamissing.c for definition
- -- of "optimize_size" for the GNAAMP backend.
+ -- in -Os mode and set to zero otherwise.
Output_File_Name_Present : Boolean := False;
-- GNATBIND, GNAT, GNATMAKE
-- If true, activates the circuitry for unnesting subprograms (see the spec
-- of Exp_Unst for full details). Currently set only by use of -gnatd.1.
- Universal_Addressing_On_AAMP : Boolean := False;
- -- GNAAMP
- -- Indicates if library-level objects should be accessed and updated using
- -- universal addressing instructions on the AAMP architecture. This flag is
- -- set to True when pragma Universal_Data is given as a configuration
- -- pragma.
-
Unreserve_All_Interrupts : Boolean := False;
-- GNAT, GNATBIND
-- Normally set False, set True if a valid Unreserve_All_Interrupts pragma
end if;
Step_2 : declare
+ function Empty_Range (A : Node_Id) return Boolean;
+ -- If an association covers an empty range, some warnings on the
+ -- expression of the association can be disabled.
+
+ -----------------
+ -- Empty_Range --
+ -----------------
+
+ function Empty_Range (A : Node_Id) return Boolean is
+ R : constant Node_Id := First (Choices (A));
+ begin
+ return No (Next (R))
+ and then Nkind (R) = N_Range
+ and then Compile_Time_Compare
+ (Low_Bound (R), High_Bound (R), False) = GT;
+ end Empty_Range;
+
+ -- Local variables
+
Low : Node_Id;
High : Node_Id;
-- Denote the lowest and highest values in an aggregate choice
Errors_Posted_On_Choices : Boolean := False;
-- Keeps track of whether any choices have semantic errors
- function Empty_Range (A : Node_Id) return Boolean;
- -- If an association covers an empty range, some warnings on the
- -- expression of the association can be disabled.
-
- -----------------
- -- Empty_Range --
- -----------------
-
- function Empty_Range (A : Node_Id) return Boolean is
- R : constant Node_Id := First (Choices (A));
- begin
- return No (Next (R))
- and then Nkind (R) = N_Range
- and then Compile_Time_Compare
- (Low_Bound (R), High_Bound (R), False) = GT;
- end Empty_Range;
-
-- Start of processing for Step_2
begin
-----------------------
procedure Resolve_Aggr_Expr (Expr : Node_Id; Component : Node_Id) is
- Expr_Type : Entity_Id := Empty;
- New_C : Entity_Id := Component;
- New_Expr : Node_Id;
-
function Has_Expansion_Delayed (Expr : Node_Id) return Boolean;
-- If the expression is an aggregate (possibly qualified) then its
-- expansion is delayed until the enclosing aggregate is expanded
-- dynamic-sized aggregate in the code, something that gigi cannot
-- handle.
- Relocate : Boolean;
- -- Set to True if the resolved Expr node needs to be relocated when
- -- attached to the newly created association list. This node need not
- -- be relocated if its parent pointer is not set. In fact in this
- -- case Expr is the output of a New_Copy_Tree call. If Relocate is
- -- True then we have analyzed the expression node in the original
- -- aggregate and hence it needs to be relocated when moved over to
- -- the new association list.
-
---------------------------
-- Has_Expansion_Delayed --
---------------------------
and then Has_Expansion_Delayed (Expression (Expr)));
end Has_Expansion_Delayed;
+ -- Local variables
+
+ Expr_Type : Entity_Id := Empty;
+ New_C : Entity_Id := Component;
+ New_Expr : Node_Id;
+
+ Relocate : Boolean;
+ -- Set to True if the resolved Expr node needs to be relocated when
+ -- attached to the newly created association list. This node need not
+ -- be relocated if its parent pointer is not set. In fact in this
+ -- case Expr is the output of a New_Copy_Tree call. If Relocate is
+ -- True then we have analyzed the expression node in the original
+ -- aggregate and hence it needs to be relocated when moved over to
+ -- the new association list.
+
-- Start of processing for Resolve_Aggr_Expr
begin
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Ghost; use Ghost;
+with Gnatvsn; use Gnatvsn;
with Lib; use Lib;
with Lib.Writ; use Lib.Writ;
with Lib.Xref; use Lib.Xref;
Check_Valid_Configuration_Pragma;
Check_Arg_Count (0);
- No_Run_Time_Mode := True;
- Configurable_Run_Time_Mode := True;
+ -- Remove backward compatibility if Build_Type is FSF or GPL and
+ -- generate a warning.
- -- Set Duration to 32 bits if word size is 32
+ declare
+ Ignore : constant Boolean := Build_Type in FSF .. GPL;
+ begin
+ if Ignore then
+ Error_Pragma ("pragma% is ignored, has no effect??");
+ else
+ No_Run_Time_Mode := True;
+ Configurable_Run_Time_Mode := True;
- if Ttypes.System_Word_Size = 32 then
- Duration_32_Bits_On_Target := True;
- end if;
+ -- Set Duration to 32 bits if word size is 32
+
+ if Ttypes.System_Word_Size = 32 then
+ Duration_32_Bits_On_Target := True;
+ end if;
- -- Set appropriate restrictions
+ -- Set appropriate restrictions
- Set_Restriction (No_Finalization, N);
- Set_Restriction (No_Exception_Handlers, N);
- Set_Restriction (Max_Tasks, N, 0);
- Set_Restriction (No_Tasking, N);
+ Set_Restriction (No_Finalization, N);
+ Set_Restriction (No_Exception_Handlers, N);
+ Set_Restriction (Max_Tasks, N, 0);
+ Set_Restriction (No_Tasking, N);
+ end if;
+ end;
- -----------------------
- -- No_Tagged_Streams --
- -----------------------
+ -----------------------
+ -- No_Tagged_Streams --
+ -----------------------
- -- pragma No_Tagged_Streams;
- -- pragma No_Tagged_Streams ([Entity => ]tagged_type_local_NAME);
+ -- pragma No_Tagged_Streams [([Entity => ]tagged_type_local_NAME)];
when Pragma_No_Tagged_Streams => No_Tagged_Strms : declare
E : Entity_Id;
when Pragma_Universal_Data =>
GNAT_Pragma;
-
- -- If this is a configuration pragma, then set the universal
- -- addressing option, otherwise confirm that the pragma satisfies
- -- the requirements of library unit pragma placement and leave it
- -- to the GNAAMP back end to detect the pragma (avoids transitive
- -- setting of the option due to withed units).
-
- if Is_Configuration_Pragma then
- Universal_Addressing_On_AAMP := True;
- else
- Check_Valid_Library_Unit_Pragma;
- end if;
-
- if not AAMP_On_Target then
- Error_Pragma ("??pragma% ignored (applies only to AAMP)");
- end if;
+ Error_Pragma ("??pragma% ignored (applies only to AAMP)");
----------------
-- Unmodified --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
return Flag17 (N);
end No_Minimize_Eliminate;
+ function No_Side_Effect_Removal
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Function_Call);
+ return Flag1 (N);
+ end No_Side_Effect_Removal;
+
function No_Truncation
(N : Node_Id) return Boolean is
begin
Set_Flag17 (N, Val);
end Set_No_Minimize_Eliminate;
+ procedure Set_No_Side_Effect_Removal
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Function_Call);
+ Set_Flag1 (N, Val);
+ end Set_No_Side_Effect_Removal;
+
procedure Set_No_Truncation
(N : Node_Id; Val : Boolean := True) is
begin
-- It is used to indicate that processing for extended overflow checking
-- modes is not required (this is used to prevent infinite recursion).
+ -- No_Side_Effect_Removal (Flag1-Sem)
+ -- Present in N_Function_Call nodes. Set when a function call does not
+ -- require side effect removal. This attribute suppresses the generation
+ -- of a temporary to capture the result of the function which eventually
+ -- replaces the function call.
+
-- No_Truncation (Flag17-Sem)
-- Present in N_Unchecked_Type_Conversion node. This flag has an effect
-- only if the RM_Size of the source is greater than the RM_Size of the
-- actual parameter part)
-- First_Named_Actual (Node4-Sem)
-- Controlling_Argument (Node1-Sem) (set to Empty if not dispatching)
+ -- No_Side_Effect_Removal (Flag1-Sem)
-- Is_Expanded_Build_In_Place_Call (Flag11-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- No_Elaboration_Check (Flag14-Sem)
function No_Minimize_Eliminate
(N : Node_Id) return Boolean; -- Flag17
+ function No_Side_Effect_Removal
+ (N : Node_Id) return Boolean; -- Flag1
+
function No_Truncation
(N : Node_Id) return Boolean; -- Flag17
procedure Set_No_Minimize_Eliminate
(N : Node_Id; Val : Boolean := True); -- Flag17
+ procedure Set_No_Side_Effect_Removal
+ (N : Node_Id; Val : Boolean := True); -- Flag1
+
procedure Set_No_Truncation
(N : Node_Id; Val : Boolean := True); -- Flag17
pragma Inline (No_Entities_Ref_In_Spec);
pragma Inline (No_Initialization);
pragma Inline (No_Minimize_Eliminate);
+ pragma Inline (No_Side_Effect_Removal);
pragma Inline (No_Truncation);
pragma Inline (Non_Aliased_Prefix);
pragma Inline (Null_Present);
pragma Inline (Set_No_Entities_Ref_In_Spec);
pragma Inline (Set_No_Initialization);
pragma Inline (Set_No_Minimize_Eliminate);
+ pragma Inline (Set_No_Side_Effect_Removal);
pragma Inline (Set_No_Truncation);
pragma Inline (Set_Non_Aliased_Prefix);
pragma Inline (Set_Null_Excluding_Subtype);
projects / gcc.git / commitdiff