+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
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
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 \
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.
2009-06-29 Tom Tromey <tromey@redhat.com>
#include "ggc.h"
#include "target.h"
#include "expr.h"
+#include "tree-inline.h"
#include "ada.h"
#include "types.h"
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;
}
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);
#include "ggc.h"
#include "flags.h"
#include "output.h"
+#include "tree-inline.h"
#include "ada.h"
#include "types.h"
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
if (errorcount || sorrycount)
return;
+ finalize_size_functions ();
finish_aliases_1 ();
if (!quiet_flag)
#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. */
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);
{
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);
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);
+}
\f
#ifndef MAX_FIXED_MODE_SIZE
#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
+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
--- /dev/null
+-- { 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;
--- /dev/null
+package Discr12_Pkg is
+
+ function Dummy (I : Integer) return Integer;
+
+end Discr12_Pkg;
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+-- { 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;
--- /dev/null
+with Discr16_Pkg; use Discr16_Pkg;
+
+package Discr16_Cont is
+
+ type ES6a is new ET3a range E2..E4;
+
+end;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+-- { 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;
return t;
}
- return unshare_expr (*n);
+ if (id->do_not_unshare)
+ return *n;
+ else
+ return unshare_expr (*n);
}
static tree
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)
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)
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
/* 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;
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);
#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"
return result;
}
\f
+/* 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)
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))
{
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);
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. */
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);
projects / platform / upstream / linaro-gcc.git / commitdiff