procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cgraphunit.c (cgraph_finalize_compilation_unit): Call finalize_size_functions before further processing.

Browse source 
* cgraphunit.c (cgraph_finalize_compilation_unit): Call
	finalize_size_functions before further processing.
	* stor-layout.c: Include cgraph.h, tree-inline.h and tree-dump.h.
	(variable_size): Call self_referential_size on size expressions
	that contain a PLACEHOLDER_EXPR.
	(size_functions): New static variable.
	(copy_self_referential_tree_r): New static function.
	(self_referential_size): Likewise.
	(finalize_size_functions): New global function.
	* tree.c: Include tree-inline.h.
	(push_without_duplicates): New static function.
	(find_placeholder_in_expr): New global function.
	(substitute_in_expr) <tcc_declaration>: Return the replacement object
	on equality.
	<tcc_expression>: Likewise.
	<tcc_vl_exp>: If the replacement object is a constant, try to inline
	the call in the expression.
	* tree.h (finalize_size_functions): Declare.
	(find_placeholder_in_expr): Likewise.
	(FIND_PLACEHOLDER_IN_EXPR): New macro.
	(substitute_placeholder_in_expr): Update comment.
	* tree-inline.c (remap_decl): Do not unshare trees if do_not_unshare
	is true.
	(copy_tree_body_r): Likewise.
	(copy_tree_body): New static function.
	(maybe_inline_call_in_expr): New global function.
	* tree-inline.h (struct copy_body_data): Add do_not_unshare field.
	(maybe_inline_call_in_expr): Declare.
	* Makefile.in (tree.o): Depend on TREE_INLINE_H.
	(stor-layout.o): Depend on CGRAPH_H, TREE_INLINE_H, TREE_DUMP_H and
	GIMPLE_H.
ada/
	* gcc-interface/decl.c: Include tree-inline.h.
	(annotate_value) <CALL_EXPR>: Try to inline the call in the expression.
	* gcc-interface/utils.c (max_size) <CALL_EXPR>: Likewise.
	* gcc-interface/utils2.c: Include tree-inline.
	(known_alignment) <CALL_EXPR>: Likewise.

From-SVN: r149112
This commit is contained in:
Eric Botcazou 2009-06-30 17:26:32 +00:00 • committed by Eric Botcazou
parent c1a5cfab17
commit f82a627cf5
28 changed files with 856 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
gcc/ChangeLog
View file

@ -1,3 +1,37 @@
2009-06-30 Eric Botcazou <ebotcazou@adacore.com>
* cgraphunit.c (cgraph_finalize_compilation_unit): Call
finalize_size_functions before further processing.
* stor-layout.c: Include cgraph.h, tree-inline.h and tree-dump.h.
(variable_size): Call self_referential_size on size expressions
that contain a PLACEHOLDER_EXPR.
(size_functions): New static variable.
(copy_self_referential_tree_r): New static function.
(self_referential_size): Likewise.
(finalize_size_functions): New global function.
* tree.c: Include tree-inline.h.
(push_without_duplicates): New static function.
(find_placeholder_in_expr): New global function.
(substitute_in_expr) <tcc_declaration>: Return the replacement object
on equality.
<tcc_expression>: Likewise.
<tcc_vl_exp>: If the replacement object is a constant, try to inline
the call in the expression.
* tree.h (finalize_size_functions): Declare.
(find_placeholder_in_expr): Likewise.
(FIND_PLACEHOLDER_IN_EXPR): New macro.
(substitute_placeholder_in_expr): Update comment.
* tree-inline.c (remap_decl): Do not unshare trees if do_not_unshare
is true.
(copy_tree_body_r): Likewise.
(copy_tree_body): New static function.
(maybe_inline_call_in_expr): New global function.
* tree-inline.h (struct copy_body_data): Add do_not_unshare field.
(maybe_inline_call_in_expr): Declare.
* Makefile.in (tree.o): Depend on TREE_INLINE_H.
(stor-layout.o): Depend on CGRAPH_H, TREE_INLINE_H, TREE_DUMP_H and
GIMPLE_H.
2009-06-30 Richard Guenther <rguenther@suse.de>
* tree-ssa-dce.c (mark_all_reaching_defs_necessary_1): Always

6
gcc/Makefile.in
View file

@ -2127,8 +2127,8 @@ langhooks.o : langhooks.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
tree.o : tree.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H) \
all-tree.def $(FLAGS_H) $(FUNCTION_H) $(PARAMS_H) \
$(TOPLEV_H) $(GGC_H) $(HASHTAB_H) $(TARGET_H) output.h $(TM_P_H) langhooks.h \
$(REAL_H) gt-tree.h tree-iterator.h $(BASIC_BLOCK_H) $(TREE_FLOW_H) \
$(OBSTACK_H) pointer-set.h fixed-value.h
$(REAL_H) gt-tree.h $(TREE_INLINE_H) tree-iterator.h $(BASIC_BLOCK_H) \
$(TREE_FLOW_H) $(OBSTACK_H) pointer-set.h fixed-value.h
tree-dump.o: tree-dump.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
$(TREE_H) langhooks.h $(TOPLEV_H) $(SPLAY_TREE_H) $(TREE_DUMP_H) \
tree-iterator.h $(TREE_PASS_H) $(DIAGNOSTIC_H) $(REAL_H) fixed-value.h
@ -2144,7 +2144,7 @@ print-tree.o : print-tree.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) $(TREE_H
stor-layout.o : stor-layout.c $(CONFIG_H) $(SYSTEM_H) coretypes.h $(TM_H) \
$(TREE_H) $(PARAMS_H) $(FLAGS_H) $(FUNCTION_H) $(EXPR_H) output.h $(RTL_H) \
$(GGC_H) $(TM_P_H) $(TARGET_H) langhooks.h $(REGS_H) gt-stor-layout.h \
$(TOPLEV_H)
$(TOPLEV_H) $(CGRAPH_H) $(TREE_INLINE_H) $(TREE_DUMP_H) $(GIMPLE_H)
tree-ssa-structalias.o: tree-ssa-structalias.c \
$(SYSTEM_H) $(CONFIG_H) coretypes.h $(TM_H) $(GGC_H) $(OBSTACK_H) $(BITMAP_H) \
$(FLAGS_H) $(RTL_H) $(TM_P_H) hard-reg-set.h $(BASIC_BLOCK_H) output.h \

8
gcc/ada/ChangeLog
View file

@ -1,3 +1,11 @@
2009-06-30 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c: Include tree-inline.h.
(annotate_value) <CALL_EXPR>: Try to inline the call in the expression.
* gcc-interface/utils.c (max_size) <CALL_EXPR>: Likewise.
* gcc-interface/utils2.c: Include tree-inline.
(known_alignment) <CALL_EXPR>: Likewise.
2009-06-30 Eric Botcazou <ebotcazou@adacore.com>
* raise-gcc.c: Include dwarf2.h conditionally.

10
gcc/ada/gcc-interface/decl.c
View file

@ -33,6 +33,7 @@
#include "ggc.h"
#include "target.h"
#include "expr.h"
#include "tree-inline.h"
#include "ada.h"
#include "types.h"
@ -7190,6 +7191,15 @@ annotate_value (tree gnu_size)
case EQ_EXPR: tcode = Eq_Expr; break;
case NE_EXPR: tcode = Ne_Expr; break;
case CALL_EXPR:
{
tree t = maybe_inline_call_in_expr (gnu_size);
if (t)
return annotate_value (t);
}
/* Fall through... */
default:
return No_Uint;
}

11
gcc/ada/gcc-interface/utils.c
View file

@ -2333,10 +2333,15 @@ max_size (tree exp, bool max_p)
case tcc_vl_exp:
if (code == CALL_EXPR)
{
tree *argarray;
int i, n = call_expr_nargs (exp);
gcc_assert (n > 0);
tree t, *argarray;
int n, i;
t = maybe_inline_call_in_expr (exp);
if (t)
return max_size (t, max_p);
n = call_expr_nargs (exp);
gcc_assert (n > 0);
argarray = (tree *) alloca (n * sizeof (tree));
for (i = 0; i < n; i++)
argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p);

10
gcc/ada/gcc-interface/utils2.c
View file

@ -31,6 +31,7 @@
#include "ggc.h"
#include "flags.h"
#include "output.h"
#include "tree-inline.h"
#include "ada.h"
#include "types.h"
@ -215,6 +216,15 @@ known_alignment (tree exp)
this_alignment = expr_align (TREE_OPERAND (exp, 0));
break;
case CALL_EXPR:
{
tree t = maybe_inline_call_in_expr (exp);
if (t)
return known_alignment (t);
}
/* Fall through... */
default:
/* For other pointer expressions, we assume that the pointed-to object
is at least as aligned as the pointed-to type. Beware that we can

1
gcc/cgraphunit.c
View file

@ -1012,6 +1012,7 @@ cgraph_finalize_compilation_unit (void)
if (errorcount || sorrycount)
return;
finalize_size_functions ();
finish_aliases_1 ();
if (!quiet_flag)

221
gcc/stor-layout.c
View file

@ -37,6 +37,10 @@ along with GCC; see the file COPYING3. If not see
#include "langhooks.h"
#include "regs.h"
#include "params.h"
#include "cgraph.h"
#include "tree-inline.h"
#include "tree-dump.h"
#include "gimple.h"
/* Data type for the expressions representing sizes of data types.
It is the first integer type laid out. */
@ -53,6 +57,7 @@ unsigned int initial_max_fld_align = TARGET_DEFAULT_PACK_STRUCT;
called only by a front end. */
static int reference_types_internal = 0;
static tree self_referential_size (tree);
static void finalize_record_size (record_layout_info);
static void finalize_type_size (tree);
static void place_union_field (record_layout_info, tree);
@ -117,13 +122,19 @@ variable_size (tree size)
{
tree save;
/* Obviously. */
if (TREE_CONSTANT (size))
return size;
/* If the size is self-referential, we can't make a SAVE_EXPR (see
save_expr for the rationale). But we can do something else. */
if (CONTAINS_PLACEHOLDER_P (size))
return self_referential_size (size);
/* If the language-processor is to take responsibility for variable-sized
items (e.g., languages which have elaboration procedures like Ada),
just return SIZE unchanged. Likewise for self-referential sizes and
constant sizes. */
if (TREE_CONSTANT (size)
|| lang_hooks.decls.global_bindings_p () < 0
|| CONTAINS_PLACEHOLDER_P (size))
just return SIZE unchanged. */
if (lang_hooks.decls.global_bindings_p () < 0)
return size;
size = save_expr (size);
@ -157,6 +168,206 @@ variable_size (tree size)
return size;
}
/* An array of functions used for self-referential size computation. */
static GTY(()) VEC (tree, gc) *size_functions;
/* Similar to copy_tree_r but do not copy component references involving
PLACEHOLDER_EXPRs. These nodes are spotted in find_placeholder_in_expr
and substituted in substitute_in_expr. */
static tree
copy_self_referential_tree_r (tree *tp, int *walk_subtrees, void *data)
{
enum tree_code code = TREE_CODE (*tp);
/* Stop at types, decls, constants like copy_tree_r. */
if (TREE_CODE_CLASS (code) == tcc_type
|| TREE_CODE_CLASS (code) == tcc_declaration
|| TREE_CODE_CLASS (code) == tcc_constant)
{
*walk_subtrees = 0;
return NULL_TREE;
}
/* This is the pattern built in ada/make_aligning_type. */
else if (code == ADDR_EXPR
&& TREE_CODE (TREE_OPERAND (*tp, 0)) == PLACEHOLDER_EXPR)
{
*walk_subtrees = 0;
return NULL_TREE;
}
/* Default case: the component reference. */
else if (code == COMPONENT_REF)
{
tree inner;
for (inner = TREE_OPERAND (*tp, 0);
REFERENCE_CLASS_P (inner);
inner = TREE_OPERAND (inner, 0))
;
if (TREE_CODE (inner) == PLACEHOLDER_EXPR)
{
*walk_subtrees = 0;
return NULL_TREE;
}
}
/* We're not supposed to have them in self-referential size trees
because we wouldn't properly control when they are evaluated.
However, not creating superfluous SAVE_EXPRs requires accurate
tracking of readonly-ness all the way down to here, which we
cannot always guarantee in practice. So punt in this case. */
else if (code == SAVE_EXPR)
return error_mark_node;
return copy_tree_r (tp, walk_subtrees, data);
}
/* Given a SIZE expression that is self-referential, return an equivalent
expression to serve as the actual size expression for a type. */
static tree
self_referential_size (tree size)
{
static unsigned HOST_WIDE_INT fnno = 0;
VEC (tree, heap) *self_refs = NULL;
tree param_type_list = NULL, param_decl_list = NULL, arg_list = NULL;
tree t, ref, return_type, fntype, fnname, fndecl;
unsigned int i;
char buf[128];
/* Do not factor out simple operations. */
t = skip_simple_arithmetic (size);
if (TREE_CODE (t) == CALL_EXPR)
return size;
/* Collect the list of self-references in the expression. */
find_placeholder_in_expr (size, &self_refs);
gcc_assert (VEC_length (tree, self_refs) > 0);
/* Obtain a private copy of the expression. */
t = size;
if (walk_tree (&t, copy_self_referential_tree_r, NULL, NULL) != NULL_TREE)
return size;
size = t;
/* Build the parameter and argument lists in parallel; also
substitute the former for the latter in the expression. */
for (i = 0; VEC_iterate (tree, self_refs, i, ref); i++)
{
tree subst, param_name, param_type, param_decl;
if (DECL_P (ref))
{
/* We shouldn't have true variables here. */
gcc_assert (TREE_READONLY (ref));
subst = ref;
}
/* This is the pattern built in ada/make_aligning_type. */
else if (TREE_CODE (ref) == ADDR_EXPR)
subst = ref;
/* Default case: the component reference. */
else
subst = TREE_OPERAND (ref, 1);
sprintf (buf, "p%d", i);
param_name = get_identifier (buf);
param_type = TREE_TYPE (ref);
param_decl
= build_decl (input_location, PARM_DECL, param_name, param_type);
if (targetm.calls.promote_prototypes (NULL_TREE)
&& INTEGRAL_TYPE_P (param_type)
&& TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
DECL_ARG_TYPE (param_decl) = integer_type_node;
else
DECL_ARG_TYPE (param_decl) = param_type;
DECL_ARTIFICIAL (param_decl) = 1;
TREE_READONLY (param_decl) = 1;
size = substitute_in_expr (size, subst, param_decl);
param_type_list = tree_cons (NULL_TREE, param_type, param_type_list);
param_decl_list = chainon (param_decl, param_decl_list);
arg_list = tree_cons (NULL_TREE, ref, arg_list);
}
VEC_free (tree, heap, self_refs);
/* Append 'void' to indicate that the number of parameters is fixed. */
param_type_list = tree_cons (NULL_TREE, void_type_node, param_type_list);
/* The 3 lists have been created in reverse order. */
param_type_list = nreverse (param_type_list);
param_decl_list = nreverse (param_decl_list);
arg_list = nreverse (arg_list);
/* Build the function type. */
return_type = TREE_TYPE (size);
fntype = build_function_type (return_type, param_type_list);
/* Build the function declaration. */
sprintf (buf, "SZ"HOST_WIDE_INT_PRINT_UNSIGNED, fnno++);
fnname = get_file_function_name (buf);
fndecl = build_decl (input_location, FUNCTION_DECL, fnname, fntype);
for (t = param_decl_list; t; t = TREE_CHAIN (t))
DECL_CONTEXT (t) = fndecl;
DECL_ARGUMENTS (fndecl) = param_decl_list;
DECL_RESULT (fndecl)
= build_decl (input_location, RESULT_DECL, 0, return_type);
DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
/* The function has been created by the compiler and we don't
want to emit debug info for it. */
DECL_ARTIFICIAL (fndecl) = 1;
DECL_IGNORED_P (fndecl) = 1;
/* It is supposed to be "const" and never throw. */
TREE_READONLY (fndecl) = 1;
TREE_NOTHROW (fndecl) = 1;
/* We want it to be inlined when this is deemed profitable, as
well as discarded if every call has been integrated. */
DECL_DECLARED_INLINE_P (fndecl) = 1;
/* It is made up of a unique return statement. */
DECL_INITIAL (fndecl) = make_node (BLOCK);
BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
t = build2 (MODIFY_EXPR, return_type, DECL_RESULT (fndecl), size);
DECL_SAVED_TREE (fndecl) = build1 (RETURN_EXPR, void_type_node, t);
TREE_STATIC (fndecl) = 1;
/* Put it onto the list of size functions. */
VEC_safe_push (tree, gc, size_functions, fndecl);
/* Replace the original expression with a call to the size function. */
return build_function_call_expr (fndecl, arg_list);
}
/* Take, queue and compile all the size functions. It is essential that
the size functions be gimplified at the very end of the compilation
in order to guarantee transparent handling of self-referential sizes.
Otherwise the GENERIC inliner would not be able to inline them back
at each of their call sites, thus creating artificial non-constant
size expressions which would trigger nasty problems later on. */
void
finalize_size_functions (void)
{
unsigned int i;
tree fndecl;
for (i = 0; VEC_iterate(tree, size_functions, i, fndecl); i++)
{
dump_function (TDI_original, fndecl);
gimplify_function_tree (fndecl);
dump_function (TDI_generic, fndecl);
cgraph_finalize_function (fndecl, false);
}
VEC_free (tree, gc, size_functions);
}
#ifndef MAX_FIXED_MODE_SIZE
#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)

17
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,20 @@
2009-06-30 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr12.adb: New test.
* gnat.dg/discr12_pkg.ads: New helper.
* gnat.dg/discr13.adb: New test.
* gnat.dg/discr14.ad[sb]: Likewise.
* gnat.dg/discr15.adb: Likewise.
* gnat.dg/discr15_pkg.ads: New helper.
* gnat.dg/discr16.adb: New test.
* gnat.dg/discr16_g.ads: New helper.
* gnat.dg/discr16_pkg.ads: Likewise.
* gnat.dg/discr16_cont.ads: Likewise.
* gnat.dg/discr17.adb: New test.
* gnat.dg/discr18.adb: Likewise.
* gnat.dg/discr18_pkg.ads: New helper.
* gnat.dg/discr19.adb: New test.
2009-06-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/40576

35
gcc/testsuite/gnat.dg/discr12.adb Normal file
View file

@ -0,0 +1,35 @@
-- { dg-do compile }
with Discr12_Pkg; use Discr12_Pkg;
procedure Discr12 is
subtype Small_Int is Integer range 1..10;
package P is
type PT_W_Disc (D : Small_Int) is private;
type Rec_W_Private (D1 : Integer) is
record
C : PT_W_Disc (D1);
end record;
type Rec_01 (D3 : Integer) is
record
C1 : Rec_W_Private (D3);
end record;
type Arr is array (1 .. 5) of Rec_01(Dummy(0));
private
type PT_W_Disc (D : Small_Int) is
record
Str : String (1 .. D);
end record;
end P;
begin
Null;
end;

5
gcc/testsuite/gnat.dg/discr12_pkg.ads Normal file
View file

@ -0,0 +1,5 @@
package Discr12_Pkg is
function Dummy (I : Integer) return Integer;
end Discr12_Pkg;

30
gcc/testsuite/gnat.dg/discr13.adb Normal file
View file

@ -0,0 +1,30 @@
-- { dg-do compile }
with Discr12_Pkg; use Discr12_Pkg;
procedure Discr13 is
function F1 return Integer is
begin
return Dummy (1);
end F1;
protected type Poe (D3 : Integer := F1) is
entry E (D3 .. F1); -- F1 evaluated
function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer) return Boolean;
end Poe;
protected body Poe is
entry E (for I in D3 .. F1) when True is
begin
null;
end E;
function Is_Ok (D3 : Integer; E_First : Integer; E_Last : Integer) return Boolean is
begin
return False;
end Is_Ok;
end Poe;
begin
null;
end;

11
gcc/testsuite/gnat.dg/discr14.adb Normal file
View file

@ -0,0 +1,11 @@
-- { dg-do compile }
package body Discr14 is
procedure ASSIGN( TARGET : in out SW_TYPE_INFO ;
SOURCE : in SW_TYPE_INFO ) is
begin
TARGET := new T_SW_TYPE_DESCRIPTOR( SOURCE.SW_TYPE, SOURCE.DIMENSION );
end ASSIGN;
end Discr14;

42
gcc/testsuite/gnat.dg/discr14.ads Normal file
View file

@ -0,0 +1,42 @@
package Discr14 is
type COMPLETION_CODE is (SUCCESS, FAILURE, NONE);
type T_SW_TYPE is (NONE, COMPLETION_CODE_TYPE);
type T_COMPLETION_CODE_RANGE (CONSTRAINED: BOOLEAN := FALSE) is
record
case CONSTRAINED is
when TRUE =>
FIRST : COMPLETION_CODE := SUCCESS;
LAST : COMPLETION_CODE := FAILURE;
when FALSE =>
null;
end case;
end record;
type T_SW_DIMENSIONS is range 0 .. 3;
type T_SW_INDEX_LIST is array (T_SW_DIMENSIONS range <>) of POSITIVE;
type T_SW_TYPE_DESCRIPTOR (SW_TYPE : T_SW_TYPE := NONE;
DIMENSION : T_SW_DIMENSIONS := 0) is
record
BOUNDS : T_SW_INDEX_LIST (1 .. DIMENSION);
case SW_TYPE is
when COMPLETION_CODE_TYPE =>
COMPLETION_CODE_RANGE : T_COMPLETION_CODE_RANGE;
when OTHERS =>
null;
end case;
end record;
type SW_TYPE_INFO is access T_SW_TYPE_DESCRIPTOR;
procedure ASSIGN(TARGET : in out SW_TYPE_INFO; SOURCE : in SW_TYPE_INFO) ;
end Discr14;

14
gcc/testsuite/gnat.dg/discr15.adb Normal file
View file

@ -0,0 +1,14 @@
-- { dg-do compile }
-- { dg-options "-gnatws" }
with Discr15_Pkg; use Discr15_Pkg;
procedure Discr15 (History : in Rec_Multi_Moment_History) is
Sub: constant Rec_Multi_Moment_History := Sub_History_Of (History);
subtype Vec is String(0..Sub.Last);
Mmts : array(1..Sub.Size) of Vec;
begin
null;
end;

16
gcc/testsuite/gnat.dg/discr15_pkg.ads Normal file
View file

@ -0,0 +1,16 @@
package Discr15_Pkg is
type Moment is new Positive;
type Multi_Moment_History is array (Natural range <>, Moment range <>) of Float;
type Rec_Multi_Moment_History (Len : Natural; Size : Moment) is
record
Moments : Multi_Moment_History(0..Len, 1..Size);
Last : Natural;
end record;
function Sub_History_Of (History : Rec_Multi_Moment_History)
return Rec_Multi_Moment_History;
end Discr15_Pkg;

23
gcc/testsuite/gnat.dg/discr16.adb Normal file
View file

@ -0,0 +1,23 @@
-- { dg-do compile }
with Discr16_G;
with Discr16_Cont; use Discr16_Cont;
procedure Discr16 is
generic
type T is (<>);
function MAX_ADD_G(X : T; I : INTEGER) return T;
function MAX_ADD_G(X : T; I : INTEGER) return T is
begin
return T'val(T'pos(X) + LONG_INTEGER(I));
end;
function MAX_ADD is new MAX_ADD_G(ES6A);
package P is new Discr16_G(ES6A, MAX_ADD);
begin
null;
end;

7
gcc/testsuite/gnat.dg/discr16_cont.ads Normal file
View file

@ -0,0 +1,7 @@
with Discr16_Pkg; use Discr16_Pkg;
package Discr16_Cont is
type ES6a is new ET3a range E2..E4;
end;

18
gcc/testsuite/gnat.dg/discr16_g.ads Normal file
View file

@ -0,0 +1,18 @@
generic
type T is (<>);
with function MAX_ADD(X : T; I : INTEGER) return T;
package Discr16_G is
LO : T := T'val(T'pos(T'first));
HI : T := T'val(T'pos(MAX_ADD(LO, 15)));
type A2 is array(T range <>) of T;
type R2(D : T) is
record
C : A2(LO..D);
end record;
end;

7
gcc/testsuite/gnat.dg/discr16_pkg.ads Normal file
View file

@ -0,0 +1,7 @@
package Discr16_Pkg is
type ET3a is (E1, E2, E3, E4, E5);
for ET3a use (E1=> 32_001, E2=> 32_002, E3=> 32_003,
E4=> 32_004, E5=> 32_005);
end;

66
gcc/testsuite/gnat.dg/discr17.adb Normal file
View file

@ -0,0 +1,66 @@
-- { dg-do compile }
-- { dg-options "-gnatws" }
procedure Discr17 is
F1_Poe : Integer := 18;
function F1 return Integer is
begin
F1_Poe := F1_Poe - 1;
return F1_Poe;
end F1;
generic
type T is limited private;
with function Is_Ok (X : T) return Boolean;
procedure Check;
procedure Check is
begin
declare
type Poe is new T;
X : Poe;
Y : Poe;
begin
null;
end;
declare
type Poe is new T;
type Arr is array (1 .. 2) of Poe;
X : Arr;
B : Boolean := Is_Ok (T (X (1)));
begin
null;
end;
end;
protected type Poe (D3 : Integer := F1) is
entry E (D3 .. F1); -- F1 evaluated
function Is_Ok return Boolean;
end Poe;
protected body Poe is
entry E (for I in D3 .. F1) when True is
begin
null;
end E;
function Is_Ok return Boolean is
begin
return False;
end Is_Ok;
end Poe;
function Is_Ok (C : Poe) return Boolean is
begin
return C.Is_Ok;
end Is_Ok;
procedure Chk is new Check (Poe, Is_Ok);
begin
Chk;
end;

19
gcc/testsuite/gnat.dg/discr18.adb Normal file
View file

@ -0,0 +1,19 @@
-- { dg-do compile }
with Discr18_Pkg; use Discr18_Pkg;
procedure Discr18 is
String_10 : String (1..10) := "1234567890";
MD : Multiple_Discriminants (A => 10, B => 10) :=
Multiple_Discriminants'(A => 10,
B => 10,
S1 => String_10,
S2 => String_10);
MDE : Multiple_Discriminant_Extension (C => 10) :=
(MD with C => 10, S3 => String_10);
begin
Do_Something(MDE);
end;

19
gcc/testsuite/gnat.dg/discr18_pkg.ads Normal file
View file

@ -0,0 +1,19 @@
package Discr18_Pkg is
subtype Length is Natural range 0..256;
type Multiple_Discriminants (A, B : Length) is tagged
record
S1 : String (1..A);
S2 : String (1..B);
end record;
procedure Do_Something (Rec : in out Multiple_Discriminants);
type Multiple_Discriminant_Extension (C : Length) is
new Multiple_Discriminants (A => C, B => C)
with record
S3 : String (1..C);
end record;
end Discr18_Pkg;

16
gcc/testsuite/gnat.dg/discr19.adb Normal file
View file

@ -0,0 +1,16 @@
-- { dg-do compile }
procedure Discr19 is
type Arr_Int_T is array (Integer range <>) of Integer;
type Abs_Tag_Rec_T (N : Integer; M : Integer) is abstract tagged record
Arr_Int : Arr_Int_T (1..M);
end record;
type Tag_Rec_T (M : Integer)
is new Abs_Tag_Rec_T (N => 1, M => M) with null record;
begin
null;
end;

78
gcc/tree-inline.c
View file

@ -287,7 +287,10 @@ remap_decl (tree decl, copy_body_data *id)
return t;
}
return unshare_expr (*n);
if (id->do_not_unshare)
return *n;
else
return unshare_expr (*n);
}
static tree
@ -997,7 +1000,10 @@ copy_tree_body_r (tree *tp, int *walk_subtrees, void *data)
but we absolutely rely on that. As fold_indirect_ref
does other useful transformations, try that first, though. */
tree type = TREE_TYPE (TREE_TYPE (*n));
new_tree = unshare_expr (*n);
if (id->do_not_unshare)
new_tree = *n;
else
new_tree = unshare_expr (*n);
old = *tp;
*tp = gimple_fold_indirect_ref (new_tree);
if (! *tp)
@ -1993,6 +1999,20 @@ copy_cfg_body (copy_body_data * id, gcov_type count, int frequency,
return new_fndecl;
}
/* Make a copy of the body of SRC_FN so that it can be inserted inline in
another function. */
static tree
copy_tree_body (copy_body_data *id)
{
tree fndecl = id->src_fn;
tree body = DECL_SAVED_TREE (fndecl);
walk_tree (&body, copy_tree_body_r, id, NULL);
return body;
}
static tree
copy_body (copy_body_data *id, gcov_type count, int frequency,
basic_block entry_block_map, basic_block exit_block_map)
@ -4605,6 +4625,60 @@ tree_function_versioning (tree old_decl, tree new_decl,
return;
}
/* EXP is CALL_EXPR present in a GENERIC expression tree. Try to integrate
the callee and return the inlined body on success. */
tree
maybe_inline_call_in_expr (tree exp)
{
tree fn = get_callee_fndecl (exp);
/* We can only try to inline "const" functions. */
if (fn && TREE_READONLY (fn) && DECL_SAVED_TREE (fn))
{
struct pointer_map_t *decl_map = pointer_map_create ();
call_expr_arg_iterator iter;
copy_body_data id;
tree param, arg, t;
/* Remap the parameters. */
for (param = DECL_ARGUMENTS (fn), arg = first_call_expr_arg (exp, &iter);
param;
param = TREE_CHAIN (param), arg = next_call_expr_arg (&iter))
*pointer_map_insert (decl_map, param) = arg;
memset (&id, 0, sizeof (id));
id.src_fn = fn;
id.dst_fn = current_function_decl;
id.src_cfun = DECL_STRUCT_FUNCTION (fn);
id.decl_map = decl_map;
id.copy_decl = copy_decl_no_change;
id.transform_call_graph_edges = CB_CGE_DUPLICATE;
id.transform_new_cfg = false;
id.transform_return_to_modify = true;
id.transform_lang_insert_block = false;
/* Make sure not to unshare trees behind the front-end's back
since front-end specific mechanisms may rely on sharing. */
id.regimplify = false;
id.do_not_unshare = true;
/* We're not inside any EH region. */
id.eh_region = -1;
t = copy_tree_body (&id);
pointer_map_destroy (decl_map);
/* We can only return something suitable for use in a GENERIC
expression tree. */
if (TREE_CODE (t) == MODIFY_EXPR)
return TREE_OPERAND (t, 1);
}
return NULL_TREE;
}
/* Duplicate a type, fields and all. */
tree

4
gcc/tree-inline.h
View file

@ -102,6 +102,9 @@ typedef struct copy_body_data
/* True if this statement will need to be regimplified. */
bool regimplify;
/* True if trees should not be unshared. */
bool do_not_unshare;
/* > 0 if we are remapping a type currently. */
int remapping_type_depth;
@ -157,6 +160,7 @@ extern tree copy_tree_body_r (tree *, int *, void *);
extern void insert_decl_map (copy_body_data *, tree, tree);
unsigned int optimize_inline_calls (tree);
tree maybe_inline_call_in_expr (tree);
bool tree_inlinable_function_p (tree);
tree copy_tree_r (tree *, int *, void *);
tree copy_decl_no_change (tree decl, copy_body_data *id);

123
gcc/tree.c
View file

@ -45,6 +45,7 @@ along with GCC; see the file COPYING3. If not see
#include "output.h"
#include "target.h"
#include "langhooks.h"
#include "tree-inline.h"
#include "tree-iterator.h"
#include "basic-block.h"
#include "tree-flow.h"
@ -2678,11 +2679,102 @@ type_contains_placeholder_p (tree type)
return result;
}
/* Push tree EXP onto vector QUEUE if it is not already present. */
static void
push_without_duplicates (tree exp, VEC (tree, heap) **queue)
{
unsigned int i;
tree iter;
for (i = 0; VEC_iterate (tree, *queue, i, iter); i++)
if (simple_cst_equal (iter, exp) == 1)
break;
if (!iter)
VEC_safe_push (tree, heap, *queue, exp);
}
/* Given a tree EXP, find all occurences of references to fields
in a PLACEHOLDER_EXPR and place them in vector REFS without
duplicates. Also record VAR_DECLs and CONST_DECLs. Note that
we assume here that EXP contains only arithmetic expressions
or CALL_EXPRs with PLACEHOLDER_EXPRs occurring only in their
argument list. */
void
find_placeholder_in_expr (tree exp, VEC (tree, heap) **refs)
{
enum tree_code code = TREE_CODE (exp);
tree inner;
int i;
/* We handle TREE_LIST and COMPONENT_REF separately. */
if (code == TREE_LIST)
{
FIND_PLACEHOLDER_IN_EXPR (TREE_CHAIN (exp), refs);
FIND_PLACEHOLDER_IN_EXPR (TREE_VALUE (exp), refs);
}
else if (code == COMPONENT_REF)
{
for (inner = TREE_OPERAND (exp, 0);
REFERENCE_CLASS_P (inner);
inner = TREE_OPERAND (inner, 0))
;
if (TREE_CODE (inner) == PLACEHOLDER_EXPR)
push_without_duplicates (exp, refs);
else
FIND_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, 0), refs);
}
else
switch (TREE_CODE_CLASS (code))
{
case tcc_constant:
break;
case tcc_declaration:
/* Variables allocated to static storage can stay. */
if (!TREE_STATIC (exp))
push_without_duplicates (exp, refs);
break;
case tcc_expression:
/* This is the pattern built in ada/make_aligning_type. */
if (code == ADDR_EXPR
&& TREE_CODE (TREE_OPERAND (exp, 0)) == PLACEHOLDER_EXPR)
{
push_without_duplicates (exp, refs);
break;
}
/* Fall through... */
case tcc_exceptional:
case tcc_unary:
case tcc_binary:
case tcc_comparison:
case tcc_reference:
for (i = 0; i < TREE_CODE_LENGTH (code); i++)
FIND_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, i), refs);
break;
case tcc_vl_exp:
for (i = 1; i < TREE_OPERAND_LENGTH (exp); i++)
FIND_PLACEHOLDER_IN_EXPR (TREE_OPERAND (exp, i), refs);
break;
default:
gcc_unreachable ();
}
}
/* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
return a tree with all occurrences of references to F in a
PLACEHOLDER_EXPR replaced by R. Note that we assume here that EXP
contains only arithmetic expressions or a CALL_EXPR with a
PLACEHOLDER_EXPR occurring only in its arglist. */
PLACEHOLDER_EXPR replaced by R. Also handle VAR_DECLs and
CONST_DECLs. Note that we assume here that EXP contains only
arithmetic expressions or CALL_EXPRs with PLACEHOLDER_EXPRs
occurring only in their argument list. */
tree
substitute_in_expr (tree exp, tree f, tree r)
@ -2733,14 +2825,24 @@ substitute_in_expr (tree exp, tree f, tree r)
switch (TREE_CODE_CLASS (code))
{
case tcc_constant:
case tcc_declaration:
return exp;
case tcc_declaration:
if (exp == f)
return r;
else
return exp;
case tcc_expression:
if (exp == f)
return r;
/* Fall through... */
case tcc_exceptional:
case tcc_unary:
case tcc_binary:
case tcc_comparison:
case tcc_expression:
case tcc_reference:
switch (TREE_CODE_LENGTH (code))
{
@ -2803,6 +2905,17 @@ substitute_in_expr (tree exp, tree f, tree r)
new_tree = NULL_TREE;
/* If we are trying to replace F with a constant, inline back
functions which do nothing else than computing a value from
the arguments they are passed. This makes it possible to
fold partially or entirely the replacement expression. */
if (CONSTANT_CLASS_P (r) && code == CALL_EXPR)
{
tree t = maybe_inline_call_in_expr (exp);
if (t)
return SUBSTITUTE_IN_EXPR (t, f, r);
}
for (i = 1; i < TREE_OPERAND_LENGTH (exp); i++)
{
tree op = TREE_OPERAND (exp, i);

25
gcc/tree.h
View file

@ -4216,6 +4216,7 @@ extern tree round_down (tree, int);
extern tree get_pending_sizes (void);
extern void put_pending_size (tree);
extern void put_pending_sizes (tree);
extern void finalize_size_functions (void);
/* Type for sizes of data-type. */
@ -4361,10 +4362,30 @@ extern bool contains_placeholder_p (const_tree);
extern bool type_contains_placeholder_p (tree);
/* Given a tree EXP, find all occurences of references to fields
in a PLACEHOLDER_EXPR and place them in vector REFS without
duplicates. Also record VAR_DECLs and CONST_DECLs. Note that
we assume here that EXP contains only arithmetic expressions
or CALL_EXPRs with PLACEHOLDER_EXPRs occurring only in their
argument list. */
extern void find_placeholder_in_expr (tree, VEC (tree, heap) **);
/* This macro calls the above function but short-circuits the common
case of a constant to save time and also checks for NULL. */
#define FIND_PLACEHOLDER_IN_EXPR(EXP, V) \
do { \
if((EXP) && !TREE_CONSTANT (EXP)) \
find_placeholder_in_expr (EXP, V); \
} while (0)
/* Given a tree EXP, a FIELD_DECL F, and a replacement value R,
return a tree with all occurrences of references to F in a
PLACEHOLDER_EXPR replaced by R. Note that we assume here that EXP
contains only arithmetic expressions. */
PLACEHOLDER_EXPR replaced by R. Also handle VAR_DECLs and
CONST_DECLs. Note that we assume here that EXP contains only
arithmetic expressions or CALL_EXPRs with PLACEHOLDER_EXPRs
occurring only in their argument list. */
extern tree substitute_in_expr (tree, tree, tree);