===================================================================
@@ -76,7 +76,7 @@ package body Debug is
-- dJ Output debugging trace info for JGNAT (Java VM version of GNAT)
-- dK Kill all error messages
-- dL Output trace information on elaboration checking
- -- dM Asssume all variables are modified (no current values)
+ -- dM Assume all variables are modified (no current values)
-- dN No file name information in exception messages
-- dO Output immediate error messages
-- dP Do not check for controlled objects in preelaborable packages
@@ -129,7 +129,7 @@ package body Debug is
-- d.I SCIL generation mode
-- d.J Parallel SCIL generation mode
-- d.K
- -- d.L
+ -- d.L Depend on back end for limited types in conditional expressions
-- d.M
-- d.N
-- d.O Dump internal SCO tables
@@ -567,6 +567,11 @@ package body Debug is
-- This means in particular not writing the same files under the
-- same directory.
+ -- d.L Normally the front end generates special expansion for conditional
+ -- expressions of a limited type. This debug flag removes this special
+ -- case expansion, leaving it up to the back end to handle conditional
+ -- expressions correctly.
+
-- d.O Dump internal SCO tables. Before outputting the SCO information to
-- the ALI file, the internal SCO tables (SCO_Table/SCO_Unit_Table)
-- are dumped for debugging purposes.
===================================================================
@@ -359,6 +359,30 @@ procedure Gnat1drv is
else
Use_Expression_With_Actions := False;
end if;
+
+ -- Set switch indicating if back end can handle limited types, and
+ -- guarantee that no incorrect copies are made (e.g. in the context
+ -- of a conditional expression).
+
+ -- Debug flag -gnatd.L decisively sets usage on
+
+ if Debug_Flag_Dot_XX then
+ Back_End_Handles_Limited_Types := True;
+
+ -- If no debug flag, usage off for AAMP, VM, SCIL cases
+
+ elsif AAMP_On_Target
+ or else VM_Target /= No_VM
+ or else Generate_SCIL
+ then
+ Back_End_Handles_Limited_Types := False;
+
+ -- Otherwise normal gcc back end, for now still turn flag off by
+ -- default, since we have not verified proper back end handling.
+
+ else
+ Back_End_Handles_Limited_Types := False;
+ end if;
end Adjust_Global_Switches;
--------------------
===================================================================
@@ -3882,7 +3882,7 @@ package body Exp_Ch4 is
-- Expand_N_Conditional_Expression --
-------------------------------------
- -- Expand into expression actions if then/else actions present
+ -- Deal with limited types and expression actions
procedure Expand_N_Conditional_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
@@ -3898,26 +3898,11 @@ package body Exp_Ch4 is
P_Decl : Node_Id;
begin
- -- If either then or else actions are present, then given:
+ -- If the type is limited or unconstrained, we expand as follows to
+ -- avoid any possibility of improper copies.
- -- if cond then then-expr else else-expr end
-
- -- we insert the following sequence of actions (using Insert_Actions):
-
- -- Cnn : typ;
- -- if cond then
- -- <<then actions>>
- -- Cnn := then-expr;
- -- else
- -- <<else actions>>
- -- Cnn := else-expr
- -- end if;
-
- -- and replace the conditional expression by a reference to Cnn
-
- -- If the type is limited or unconstrained, the above expansion is
- -- not legal, because it involves either an uninitialized object
- -- or an illegal assignment. Instead, we generate:
+ -- Note: it may be possible to avoid this special processing if the
+ -- back end uses its own mechanisms for handling by-reference types ???
-- type Ptr is access all Typ;
-- Cnn : Ptr;
@@ -3931,7 +3916,12 @@ package body Exp_Ch4 is
-- and replace the conditional expresion by a reference to Cnn.all.
- if Is_By_Reference_Type (Typ) then
+ -- This special case can be skipped if the back end handles limited
+ -- types properly and ensures that no incorrect copies are made.
+
+ if Is_By_Reference_Type (Typ)
+ and then not Back_End_Handles_Limited_Types
+ then
Cnn := Make_Temporary (Loc, 'C', N);
P_Decl :=
@@ -3979,40 +3969,82 @@ package body Exp_Ch4 is
-- associated with either branch.
elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
- Cnn := Make_Temporary (Loc, 'C', N);
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Cnn,
- Object_Definition => New_Occurrence_Of (Typ, Loc));
+ -- We have two approaches to handling this. If we are allowed to use
+ -- N_Expression_With_Actions, then we can just wrap the actions into
+ -- the appropriate expression.
+
+ if Use_Expression_With_Actions then
+ if Present (Then_Actions (N)) then
+ Rewrite (Thenx,
+ Make_Expression_With_Actions (Sloc (Thenx),
+ Actions => Then_Actions (N),
+ Expression => Relocate_Node (Thenx)));
+ Analyze_And_Resolve (Thenx, Typ);
+ end if;
- New_If :=
- Make_Implicit_If_Statement (N,
- Condition => Relocate_Node (Cond),
+ if Present (Else_Actions (N)) then
+ Rewrite (Elsex,
+ Make_Expression_With_Actions (Sloc (Elsex),
+ Actions => Else_Actions (N),
+ Expression => Relocate_Node (Elsex)));
+ Analyze_And_Resolve (Elsex, Typ);
+ end if;
- Then_Statements => New_List (
- Make_Assignment_Statement (Sloc (Thenx),
- Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
- Expression => Relocate_Node (Thenx))),
+ return;
- Else_Statements => New_List (
- Make_Assignment_Statement (Sloc (Elsex),
- Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
- Expression => Relocate_Node (Elsex))));
+ -- if we can't use N_Expression_With_Actions nodes, then we insert
+ -- the following sequence of actions (using Insert_Actions):
- Set_Assignment_OK (Name (First (Then_Statements (New_If))));
- Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+ -- Cnn : typ;
+ -- if cond then
+ -- <<then actions>>
+ -- Cnn := then-expr;
+ -- else
+ -- <<else actions>>
+ -- Cnn := else-expr
+ -- end if;
- New_N := New_Occurrence_Of (Cnn, Loc);
+ -- and replace the conditional expression by a reference to Cnn
- else
- -- No expansion needed, gigi handles it like a C conditional
- -- expression.
+ else
+ Cnn := Make_Temporary (Loc, 'C', N);
+
+ Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Cnn,
+ Object_Definition => New_Occurrence_Of (Typ, Loc));
+ 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))));
+
+ Set_Assignment_OK (Name (First (Then_Statements (New_If))));
+ Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+
+ New_N := New_Occurrence_Of (Cnn, Loc);
+ end if;
+
+ -- If no actions then no expansion needed, gigi will handle it using
+ -- the same approach as a C conditional expression.
+
+ else
return;
end if;
- -- Move the SLOC of the parent If statement to the newly created one and
+ -- Fall through here for either the limited expansion, or the case of
+ -- inserting actions for non-limited types. In both these cases, we must
+ -- move the SLOC of the parent If statement to the newly created one and
-- change it to the SLOC of the expression which, after expansion, will
-- correspond to what is being evaluated.
===================================================================
@@ -172,6 +172,15 @@ package Opt is
-- also set true if certain Unchecked_Conversion instantiations require
-- checking based on annotated values.
+ Back_End_Handles_Limited_Types : Boolean;
+ -- This flag is set true if the back end can properly handle limited or
+ -- other by reference types, and avoid copies. If this flag is False, then
+ -- the front end does special expansion for conditional expressions to make
+ -- sure that no copy occurs. If the flag is True, then the expansion for
+ -- conditional expressions relies on the back end properly handling things.
+ -- Currently the default is False for all cases (set in gnat1drv). The
+ -- default can be modified using -gnatd.L (sets the flag True).
+
Bind_Alternate_Main_Name : Boolean := False;
-- GNATBIND
-- True if main should be called Alternate_Main_Name.all.
@@ -1239,12 +1248,12 @@ package Opt is
-- Set to True if -h (-gnath for the compiler) switch encountered
-- requesting usage information
- Use_Expression_With_Actions : Boolean := False;
+ Use_Expression_With_Actions : Boolean;
-- The N_Expression_With_Actions node has been introduced relatively
-- recently, and not all back ends are prepared to handle it yet. So
-- we use this flag to suppress its use during a transitional period.
- -- Currently the default is False for all cases except the standard
- -- GCC back end. The default can be modified using -gnatd.X/-gnatd.Y.
+ -- Currently the default is False for all cases (set in gnat1drv).
+ -- The default can be modified using -gnatd.X/-gnatd.Y.
Use_Pragma_Linker_Constructor : Boolean := False;
-- GNATBIND
This patch does two things. First, if Use_Expressions_With_Actions is set, then the normal case expansion of conditional actions is simplified by using this node. Second if Back_End_Handles_Limited_Types is set, then the special case expansion for limited types is eliminated. The following test: function EA_Cond_Expr (a, b, c : Integer; s : String) return Boolean is begin return (if b <= c then s (a .. b) = s (b .. c) else s (a .. b) = s (c .. b)); end; compiled with -gnatd.X to force use of Expression_With_Actions (and also -gnatX -gnatpG) generates the following -gnatG output: function ea_cond_expr (a : integer; b : integer; c : integer; s : string) return boolean is subtype ea_cond_expr__S1b is string (s'first(1) .. s'last(1)); begin return (if b <= c then do [subtype ea_cond_expr__T3b is integer range a .. b] [subtype ea_cond_expr__T4b is string (ea_cond_expr__T3b)] reference ea_cond_expr__T4b [subtype ea_cond_expr__T5b is integer range b .. c] [subtype ea_cond_expr__T6b is string (ea_cond_expr__T5b)] reference ea_cond_expr__T6b in s (a .. b) = s (b .. c) end else do [subtype ea_cond_expr__T7b is integer range a .. b] [subtype ea_cond_expr__T8b is string (ea_cond_expr__T7b)] reference ea_cond_expr__T8b [subtype ea_cond_expr__T9b is integer range c .. b] [subtype ea_cond_expr__T10b is string (ea_cond_expr__T9b)] reference ea_cond_expr__T10b in s (a .. b) = s (c .. b) end ); end ea_cond_expr; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-18 Robert Dewar <dewar@adacore.com> * debug.adb: New debug flag -gnatd.L to control Back_End_Handles_Limited_Types. * exp_ch4.adb (Expand_N_Conditional_Expression): Let back end handle limited case if Back_End_Handles_Limited_Types is True. (Expand_N_Conditional_Expression): Use N_Expression_With_Actions to simplify expansion if Use_Expression_With_Actions is True. * gnat1drv.adb (Adjust_Global_Switches): Set Back_End_Handles_Limited_Types. * opt.ads (Back_End_Handles_Limited_Types): New flag.