static tree
handle_sentinel_attribute (tree *node, tree ARG_UNUSED (name), tree args,
int ARG_UNUSED (flags),
bool * ARG_UNUSED (no_add_attrs))
{
gcc_assert (stdarg_p (*node));
if (args)
{
tree position = TREE_VALUE (args);
gcc_assert (TREE_CODE (position) == INTEGER_CST);
if (tree_int_cst_lt (position, integer_zero_node))
gcc_unreachable ();
}
return NULL_TREE;
}
static tree
build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
{
gfc_symbol *common_sym;
tree decl;
/* Create a namespace to store symbols for common blocks. */
if (gfc_common_ns == NULL)
gfc_common_ns = gfc_get_namespace (NULL, 0);
gfc_get_symbol (com->name, gfc_common_ns, &common_sym);
decl = common_sym->backend_decl;
/* Update the size of this common block as needed. */
if (decl != NULL_TREE)
{
tree size = TYPE_SIZE_UNIT (union_type);
/* Named common blocks of the same name shall be of the same size
in all scoping units of a program in which they appear, but
blank common blocks may be of different sizes. */
if (!tree_int_cst_equal (DECL_SIZE_UNIT (decl), size)
&& strcmp (com->name, BLANK_COMMON_NAME))
gfc_warning ("Named COMMON block '%s' at %L shall be of the "
"same size as elsewhere (%lu vs %lu bytes)", com->name,
&com->where,
(unsigned long) TREE_INT_CST_LOW (size),
(unsigned long) TREE_INT_CST_LOW (DECL_SIZE_UNIT (decl)));
if (tree_int_cst_lt (DECL_SIZE_UNIT (decl), size))
{
DECL_SIZE (decl) = TYPE_SIZE (union_type);
DECL_SIZE_UNIT (decl) = size;
DECL_MODE (decl) = TYPE_MODE (union_type);
TREE_TYPE (decl) = union_type;
layout_decl (decl, 0);
}
}
/* If this common block has been declared in a previous program unit,
and either it is already initialized or there is no new initialization
for it, just return. */
if ((decl != NULL_TREE) && (!is_init || DECL_INITIAL (decl)))
return decl;
/* If there is no backend_decl for the common block, build it. */
if (decl == NULL_TREE)
{
decl = build_decl (input_location,
VAR_DECL, get_identifier (com->name), union_type);
gfc_set_decl_assembler_name (decl, gfc_sym_mangled_common_id (com));
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
DECL_IGNORED_P (decl) = 1;
if (!com->is_bind_c)
DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
else
{
/* Do not set the alignment for bind(c) common blocks to
BIGGEST_ALIGNMENT because that won't match what C does. Also,
for common blocks with one element, the alignment must be
that of the field within the common block in order to match
what C will do. */
tree field = NULL_TREE;
field = TYPE_FIELDS (TREE_TYPE (decl));
if (DECL_CHAIN (field) == NULL_TREE)
DECL_ALIGN (decl) = TYPE_ALIGN (TREE_TYPE (field));
}
DECL_USER_ALIGN (decl) = 0;
GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
gfc_set_decl_location (decl, &com->where);
if (com->threadprivate)
DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
/* Place the back end declaration for this common block in
GLOBAL_BINDING_LEVEL. */
common_sym->backend_decl = pushdecl_top_level (decl);
}
/* Has no initial values. */
if (!is_init)
{
DECL_INITIAL (decl) = NULL_TREE;
DECL_COMMON (decl) = 1;
DECL_DEFER_OUTPUT (decl) = 1;
}
else
{
DECL_INITIAL (decl) = error_mark_node;
DECL_COMMON (decl) = 0;
DECL_DEFER_OUTPUT (decl) = 0;
}
return decl;
}
static unsigned HOST_WIDE_INT
addr_object_size (tree ptr, int object_size_type)
{
tree pt_var;
gcc_assert (TREE_CODE (ptr) == ADDR_EXPR);
pt_var = TREE_OPERAND (ptr, 0);
if (REFERENCE_CLASS_P (pt_var))
pt_var = get_base_address (pt_var);
if (pt_var
&& (SSA_VAR_P (pt_var) || TREE_CODE (pt_var) == STRING_CST)
&& TYPE_SIZE_UNIT (TREE_TYPE (pt_var))
&& host_integerp (TYPE_SIZE_UNIT (TREE_TYPE (pt_var)), 1)
&& (unsigned HOST_WIDE_INT)
tree_low_cst (TYPE_SIZE_UNIT (TREE_TYPE (pt_var)), 1) < offset_limit)
{
tree bytes;
if (pt_var != TREE_OPERAND (ptr, 0))
{
tree var;
if (object_size_type & 1)
{
var = TREE_OPERAND (ptr, 0);
while (var != pt_var
&& TREE_CODE (var) != BIT_FIELD_REF
&& TREE_CODE (var) != COMPONENT_REF
&& TREE_CODE (var) != ARRAY_REF
&& TREE_CODE (var) != ARRAY_RANGE_REF
&& TREE_CODE (var) != REALPART_EXPR
&& TREE_CODE (var) != IMAGPART_EXPR)
var = TREE_OPERAND (var, 0);
if (var != pt_var && TREE_CODE (var) == ARRAY_REF)
var = TREE_OPERAND (var, 0);
if (! TYPE_SIZE_UNIT (TREE_TYPE (var))
|| ! host_integerp (TYPE_SIZE_UNIT (TREE_TYPE (var)), 1)
|| tree_int_cst_lt (TYPE_SIZE_UNIT (TREE_TYPE (pt_var)),
TYPE_SIZE_UNIT (TREE_TYPE (var))))
var = pt_var;
}
else
var = pt_var;
bytes = compute_object_offset (TREE_OPERAND (ptr, 0), var);
if (bytes != error_mark_node)
{
if (TREE_CODE (bytes) == INTEGER_CST
&& tree_int_cst_lt (TYPE_SIZE_UNIT (TREE_TYPE (var)), bytes))
bytes = size_zero_node;
else
bytes = size_binop (MINUS_EXPR,
TYPE_SIZE_UNIT (TREE_TYPE (var)), bytes);
}
}
else
bytes = TYPE_SIZE_UNIT (TREE_TYPE (pt_var));
if (host_integerp (bytes, 1))
return tree_low_cst (bytes, 1);
}
return unknown[object_size_type];
}
static symtab_node
lto_symtab_resolve_symbols (symtab_node first)
{
symtab_node e;
symtab_node prevailing = NULL;
/* Always set e->node so that edges are updated to reflect decl merging. */
for (e = first; e; e = e->symbol.next_sharing_asm_name)
if (lto_symtab_symbol_p (e)
&& (e->symbol.resolution == LDPR_PREVAILING_DEF_IRONLY
|| e->symbol.resolution == LDPR_PREVAILING_DEF_IRONLY_EXP
|| e->symbol.resolution == LDPR_PREVAILING_DEF))
{
prevailing = e;
break;
}
/* If the chain is already resolved there is nothing else to do. */
if (prevailing)
{
/* Assert it's the only one. */
for (e = prevailing->symbol.next_sharing_asm_name; e; e = e->symbol.next_sharing_asm_name)
if (lto_symtab_symbol_p (e)
&& (e->symbol.resolution == LDPR_PREVAILING_DEF_IRONLY
|| e->symbol.resolution == LDPR_PREVAILING_DEF_IRONLY_EXP
|| e->symbol.resolution == LDPR_PREVAILING_DEF))
fatal_error ("multiple prevailing defs for %qE",
DECL_NAME (prevailing->symbol.decl));
return prevailing;
}
/* Find the single non-replaceable prevailing symbol and
diagnose ODR violations. */
for (e = first; e; e = e->symbol.next_sharing_asm_name)
{
if (!lto_symtab_resolve_can_prevail_p (e))
continue;
/* If we have a non-replaceable definition it prevails. */
if (!lto_symtab_resolve_replaceable_p (e))
{
if (prevailing)
{
error_at (DECL_SOURCE_LOCATION (e->symbol.decl),
"%qD has already been defined", e->symbol.decl);
inform (DECL_SOURCE_LOCATION (prevailing->symbol.decl),
"previously defined here");
}
prevailing = e;
}
}
if (prevailing)
return prevailing;
/* Do a second round choosing one from the replaceable prevailing decls. */
for (e = first; e; e = e->symbol.next_sharing_asm_name)
{
if (!lto_symtab_resolve_can_prevail_p (e))
continue;
/* Choose the first function that can prevail as prevailing. */
if (TREE_CODE (e->symbol.decl) == FUNCTION_DECL)
{
prevailing = e;
break;
}
/* From variables that can prevail choose the largest one. */
if (!prevailing
|| tree_int_cst_lt (DECL_SIZE (prevailing->symbol.decl),
DECL_SIZE (e->symbol.decl))
/* When variables are equivalent try to chose one that has useful
DECL_INITIAL. This makes sense for keyed vtables that are
DECL_EXTERNAL but initialized. In units that do not need them
we replace the initializer by error_mark_node to conserve
memory.
We know that the vtable is keyed outside the LTO unit - otherwise
the keyed instance would prevail. We still can preserve useful
info in the initializer. */
|| (DECL_SIZE (prevailing->symbol.decl) == DECL_SIZE (e->symbol.decl)
&& (DECL_INITIAL (e->symbol.decl)
&& DECL_INITIAL (e->symbol.decl) != error_mark_node)
&& (!DECL_INITIAL (prevailing->symbol.decl)
|| DECL_INITIAL (prevailing->symbol.decl) == error_mark_node)))
prevailing = e;
}
return prevailing;
}
static unsigned HOST_WIDE_INT
addr_object_size (struct object_size_info *osi, const_tree ptr,
int object_size_type)
{
tree pt_var, pt_var_size = NULL_TREE, var_size, bytes;
gcc_assert (TREE_CODE (ptr) == ADDR_EXPR);
pt_var = TREE_OPERAND (ptr, 0);
while (handled_component_p (pt_var))
pt_var = TREE_OPERAND (pt_var, 0);
if (pt_var
&& TREE_CODE (pt_var) == MEM_REF)
{
unsigned HOST_WIDE_INT sz;
if (!osi || (object_size_type & 1) != 0
|| TREE_CODE (TREE_OPERAND (pt_var, 0)) != SSA_NAME)
{
sz = compute_builtin_object_size (TREE_OPERAND (pt_var, 0),
object_size_type & ~1);
}
else
{
tree var = TREE_OPERAND (pt_var, 0);
if (osi->pass == 0)
collect_object_sizes_for (osi, var);
if (bitmap_bit_p (computed[object_size_type],
SSA_NAME_VERSION (var)))
sz = object_sizes[object_size_type][SSA_NAME_VERSION (var)];
else
sz = unknown[object_size_type];
}
if (sz != unknown[object_size_type])
{
double_int dsz = double_int::from_uhwi (sz) - mem_ref_offset (pt_var);
if (dsz.is_negative ())
sz = 0;
else if (dsz.fits_uhwi ())
sz = dsz.to_uhwi ();
else
sz = unknown[object_size_type];
}
if (sz != unknown[object_size_type] && sz < offset_limit)
pt_var_size = size_int (sz);
}
else if (pt_var
&& DECL_P (pt_var)
&& host_integerp (DECL_SIZE_UNIT (pt_var), 1)
&& (unsigned HOST_WIDE_INT)
tree_low_cst (DECL_SIZE_UNIT (pt_var), 1) < offset_limit)
pt_var_size = DECL_SIZE_UNIT (pt_var);
else if (pt_var
&& TREE_CODE (pt_var) == STRING_CST
&& TYPE_SIZE_UNIT (TREE_TYPE (pt_var))
&& host_integerp (TYPE_SIZE_UNIT (TREE_TYPE (pt_var)), 1)
&& (unsigned HOST_WIDE_INT)
tree_low_cst (TYPE_SIZE_UNIT (TREE_TYPE (pt_var)), 1)
< offset_limit)
pt_var_size = TYPE_SIZE_UNIT (TREE_TYPE (pt_var));
else
return unknown[object_size_type];
if (pt_var != TREE_OPERAND (ptr, 0))
{
tree var;
if (object_size_type & 1)
{
var = TREE_OPERAND (ptr, 0);
while (var != pt_var
&& TREE_CODE (var) != BIT_FIELD_REF
&& TREE_CODE (var) != COMPONENT_REF
&& TREE_CODE (var) != ARRAY_REF
&& TREE_CODE (var) != ARRAY_RANGE_REF
&& TREE_CODE (var) != REALPART_EXPR
&& TREE_CODE (var) != IMAGPART_EXPR)
var = TREE_OPERAND (var, 0);
if (var != pt_var && TREE_CODE (var) == ARRAY_REF)
var = TREE_OPERAND (var, 0);
if (! TYPE_SIZE_UNIT (TREE_TYPE (var))
|| ! host_integerp (TYPE_SIZE_UNIT (TREE_TYPE (var)), 1)
|| (pt_var_size
&& tree_int_cst_lt (pt_var_size,
TYPE_SIZE_UNIT (TREE_TYPE (var)))))
var = pt_var;
else if (var != pt_var && TREE_CODE (pt_var) == MEM_REF)
{
tree v = var;
/* For &X->fld, compute object size only if fld isn't the last
field, as struct { int i; char c[1]; } is often used instead
of flexible array member. */
while (v && v != pt_var)
switch (TREE_CODE (v))
{
case ARRAY_REF:
if (TYPE_SIZE_UNIT (TREE_TYPE (TREE_OPERAND (v, 0)))
&& TREE_CODE (TREE_OPERAND (v, 1)) == INTEGER_CST)
{
tree domain
= TYPE_DOMAIN (TREE_TYPE (TREE_OPERAND (v, 0)));
if (domain
&& TYPE_MAX_VALUE (domain)
&& TREE_CODE (TYPE_MAX_VALUE (domain))
== INTEGER_CST
&& tree_int_cst_lt (TREE_OPERAND (v, 1),
TYPE_MAX_VALUE (domain)))
{
v = NULL_TREE;
break;
}
}
v = TREE_OPERAND (v, 0);
break;
case REALPART_EXPR:
case IMAGPART_EXPR:
v = NULL_TREE;
break;
case COMPONENT_REF:
if (TREE_CODE (TREE_TYPE (v)) != ARRAY_TYPE)
{
v = NULL_TREE;
break;
}
while (v != pt_var && TREE_CODE (v) == COMPONENT_REF)
if (TREE_CODE (TREE_TYPE (TREE_OPERAND (v, 0)))
!= UNION_TYPE
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (v, 0)))
!= QUAL_UNION_TYPE)
break;
else
v = TREE_OPERAND (v, 0);
if (TREE_CODE (v) == COMPONENT_REF
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (v, 0)))
== RECORD_TYPE)
{
tree fld_chain = DECL_CHAIN (TREE_OPERAND (v, 1));
for (; fld_chain; fld_chain = DECL_CHAIN (fld_chain))
if (TREE_CODE (fld_chain) == FIELD_DECL)
break;
if (fld_chain)
{
v = NULL_TREE;
break;
}
v = TREE_OPERAND (v, 0);
}
while (v != pt_var && TREE_CODE (v) == COMPONENT_REF)
if (TREE_CODE (TREE_TYPE (TREE_OPERAND (v, 0)))
!= UNION_TYPE
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (v, 0)))
!= QUAL_UNION_TYPE)
break;
else
v = TREE_OPERAND (v, 0);
if (v != pt_var)
v = NULL_TREE;
else
v = pt_var;
break;
default:
v = pt_var;
break;
}
if (v == pt_var)
var = pt_var;
}
}
else
var = pt_var;
if (var != pt_var)
var_size = TYPE_SIZE_UNIT (TREE_TYPE (var));
else if (!pt_var_size)
return unknown[object_size_type];
else
var_size = pt_var_size;
bytes = compute_object_offset (TREE_OPERAND (ptr, 0), var);
if (bytes != error_mark_node)
{
if (TREE_CODE (bytes) == INTEGER_CST
&& tree_int_cst_lt (var_size, bytes))
bytes = size_zero_node;
else
bytes = size_binop (MINUS_EXPR, var_size, bytes);
}
if (var != pt_var
&& pt_var_size
&& TREE_CODE (pt_var) == MEM_REF
&& bytes != error_mark_node)
{
tree bytes2 = compute_object_offset (TREE_OPERAND (ptr, 0), pt_var);
if (bytes2 != error_mark_node)
{
if (TREE_CODE (bytes2) == INTEGER_CST
&& tree_int_cst_lt (pt_var_size, bytes2))
bytes2 = size_zero_node;
else
bytes2 = size_binop (MINUS_EXPR, pt_var_size, bytes2);
bytes = size_binop (MIN_EXPR, bytes, bytes2);
}
}
}
else if (!pt_var_size)
return unknown[object_size_type];
else
bytes = pt_var_size;
if (host_integerp (bytes, 1))
return tree_low_cst (bytes, 1);
return unknown[object_size_type];
}
tree
build_array_notation_ref (location_t loc, tree array, tree start_index,
tree length, tree stride, tree type)
{
tree array_ntn_tree = NULL_TREE;
size_t stride_rank = 0, length_rank = 0, start_rank = 0;
if (!INTEGRAL_TYPE_P (TREE_TYPE (start_index)))
{
error_at (loc,
"start-index of array notation triplet is not an integer");
return error_mark_node;
}
if (!INTEGRAL_TYPE_P (TREE_TYPE (length)))
{
error_at (loc, "length of array notation triplet is not an integer");
return error_mark_node;
}
/* The stride is an optional field. */
if (stride && !INTEGRAL_TYPE_P (TREE_TYPE (stride)))
{
error_at (loc, "stride of array notation triplet is not an integer");
return error_mark_node;
}
if (!stride)
{
if (TREE_CONSTANT (start_index) && TREE_CONSTANT (length)
&& tree_int_cst_lt (length, start_index))
stride = build_int_cst (TREE_TYPE (start_index), -1);
else
stride = build_int_cst (TREE_TYPE (start_index), 1);
}
if (!find_rank (loc, start_index, start_index, false, &start_rank))
return error_mark_node;
if (!find_rank (loc, length, length, false, &length_rank))
return error_mark_node;
if (!find_rank (loc, stride, stride, false, &stride_rank))
return error_mark_node;
if (start_rank != 0)
{
error_at (loc, "rank of an array notation triplet's start-index is not "
"zero");
return error_mark_node;
}
if (length_rank != 0)
{
error_at (loc, "rank of an array notation triplet's length is not zero");
return error_mark_node;
}
if (stride_rank != 0)
{
error_at (loc, "rank of array notation triplet's stride is not zero");
return error_mark_node;
}
array_ntn_tree = build4 (ARRAY_NOTATION_REF, NULL_TREE, NULL_TREE, NULL_TREE,
NULL_TREE, NULL_TREE);
ARRAY_NOTATION_ARRAY (array_ntn_tree) = array;
ARRAY_NOTATION_START (array_ntn_tree) = start_index;
ARRAY_NOTATION_LENGTH (array_ntn_tree) = length;
ARRAY_NOTATION_STRIDE (array_ntn_tree) = stride;
TREE_TYPE (array_ntn_tree) = type;
return array_ntn_tree;
}
void
omp_extract_for_data (gomp_for *for_stmt, struct omp_for_data *fd,
struct omp_for_data_loop *loops)
{
tree t, var, *collapse_iter, *collapse_count;
tree count = NULL_TREE, iter_type = long_integer_type_node;
struct omp_for_data_loop *loop;
int i;
struct omp_for_data_loop dummy_loop;
location_t loc = gimple_location (for_stmt);
bool simd = gimple_omp_for_kind (for_stmt) & GF_OMP_FOR_SIMD;
bool distribute = gimple_omp_for_kind (for_stmt)
== GF_OMP_FOR_KIND_DISTRIBUTE;
bool taskloop = gimple_omp_for_kind (for_stmt)
== GF_OMP_FOR_KIND_TASKLOOP;
tree iterv, countv;
fd->for_stmt = for_stmt;
fd->pre = NULL;
if (gimple_omp_for_collapse (for_stmt) > 1)
fd->loops = loops;
else
fd->loops = &fd->loop;
fd->have_nowait = distribute || simd;
fd->have_ordered = false;
fd->collapse = 1;
fd->ordered = 0;
fd->sched_kind = OMP_CLAUSE_SCHEDULE_STATIC;
fd->sched_modifiers = 0;
fd->chunk_size = NULL_TREE;
fd->simd_schedule = false;
if (gimple_omp_for_kind (fd->for_stmt) == GF_OMP_FOR_KIND_CILKFOR)
fd->sched_kind = OMP_CLAUSE_SCHEDULE_CILKFOR;
collapse_iter = NULL;
collapse_count = NULL;
for (t = gimple_omp_for_clauses (for_stmt); t ; t = OMP_CLAUSE_CHAIN (t))
switch (OMP_CLAUSE_CODE (t))
{
case OMP_CLAUSE_NOWAIT:
fd->have_nowait = true;
break;
case OMP_CLAUSE_ORDERED:
fd->have_ordered = true;
if (OMP_CLAUSE_ORDERED_EXPR (t))
fd->ordered = tree_to_shwi (OMP_CLAUSE_ORDERED_EXPR (t));
break;
case OMP_CLAUSE_SCHEDULE:
gcc_assert (!distribute && !taskloop);
fd->sched_kind
= (enum omp_clause_schedule_kind)
(OMP_CLAUSE_SCHEDULE_KIND (t) & OMP_CLAUSE_SCHEDULE_MASK);
fd->sched_modifiers = (OMP_CLAUSE_SCHEDULE_KIND (t)
& ~OMP_CLAUSE_SCHEDULE_MASK);
fd->chunk_size = OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (t);
fd->simd_schedule = OMP_CLAUSE_SCHEDULE_SIMD (t);
break;
case OMP_CLAUSE_DIST_SCHEDULE:
gcc_assert (distribute);
fd->chunk_size = OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (t);
break;
case OMP_CLAUSE_COLLAPSE:
fd->collapse = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (t));
if (fd->collapse > 1)
{
collapse_iter = &OMP_CLAUSE_COLLAPSE_ITERVAR (t);
collapse_count = &OMP_CLAUSE_COLLAPSE_COUNT (t);
}
break;
default:
break;
}
if (fd->ordered && fd->collapse == 1 && loops != NULL)
{
fd->loops = loops;
iterv = NULL_TREE;
countv = NULL_TREE;
collapse_iter = &iterv;
collapse_count = &countv;
}
/* FIXME: for now map schedule(auto) to schedule(static).
There should be analysis to determine whether all iterations
are approximately the same amount of work (then schedule(static)
is best) or if it varies (then schedule(dynamic,N) is better). */
if (fd->sched_kind == OMP_CLAUSE_SCHEDULE_AUTO)
{
fd->sched_kind = OMP_CLAUSE_SCHEDULE_STATIC;
gcc_assert (fd->chunk_size == NULL);
}
gcc_assert (fd->collapse == 1 || collapse_iter != NULL);
if (taskloop)
fd->sched_kind = OMP_CLAUSE_SCHEDULE_RUNTIME;
if (fd->sched_kind == OMP_CLAUSE_SCHEDULE_RUNTIME)
gcc_assert (fd->chunk_size == NULL);
else if (fd->chunk_size == NULL)
{
/* We only need to compute a default chunk size for ordered
static loops and dynamic loops. */
if (fd->sched_kind != OMP_CLAUSE_SCHEDULE_STATIC
|| fd->have_ordered)
fd->chunk_size = (fd->sched_kind == OMP_CLAUSE_SCHEDULE_STATIC)
? integer_zero_node : integer_one_node;
}
int cnt = fd->ordered ? fd->ordered : fd->collapse;
for (i = 0; i < cnt; i++)
{
if (i == 0 && fd->collapse == 1 && (fd->ordered == 0 || loops == NULL))
loop = &fd->loop;
else if (loops != NULL)
loop = loops + i;
else
loop = &dummy_loop;
loop->v = gimple_omp_for_index (for_stmt, i);
gcc_assert (SSA_VAR_P (loop->v));
gcc_assert (TREE_CODE (TREE_TYPE (loop->v)) == INTEGER_TYPE
|| TREE_CODE (TREE_TYPE (loop->v)) == POINTER_TYPE);
var = TREE_CODE (loop->v) == SSA_NAME ? SSA_NAME_VAR (loop->v) : loop->v;
loop->n1 = gimple_omp_for_initial (for_stmt, i);
loop->cond_code = gimple_omp_for_cond (for_stmt, i);
loop->n2 = gimple_omp_for_final (for_stmt, i);
gcc_assert (loop->cond_code != NE_EXPR
|| gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_CILKSIMD
|| gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_CILKFOR);
omp_adjust_for_condition (loc, &loop->cond_code, &loop->n2);
t = gimple_omp_for_incr (for_stmt, i);
gcc_assert (TREE_OPERAND (t, 0) == var);
loop->step = omp_get_for_step_from_incr (loc, t);
if (simd
|| (fd->sched_kind == OMP_CLAUSE_SCHEDULE_STATIC
&& !fd->have_ordered))
{
if (fd->collapse == 1)
iter_type = TREE_TYPE (loop->v);
else if (i == 0
|| TYPE_PRECISION (iter_type)
< TYPE_PRECISION (TREE_TYPE (loop->v)))
iter_type
= build_nonstandard_integer_type
(TYPE_PRECISION (TREE_TYPE (loop->v)), 1);
}
else if (iter_type != long_long_unsigned_type_node)
{
if (POINTER_TYPE_P (TREE_TYPE (loop->v)))
iter_type = long_long_unsigned_type_node;
else if (TYPE_UNSIGNED (TREE_TYPE (loop->v))
&& TYPE_PRECISION (TREE_TYPE (loop->v))
>= TYPE_PRECISION (iter_type))
{
tree n;
if (loop->cond_code == LT_EXPR)
n = fold_build2_loc (loc,
PLUS_EXPR, TREE_TYPE (loop->v),
loop->n2, loop->step);
else
n = loop->n1;
if (TREE_CODE (n) != INTEGER_CST
|| tree_int_cst_lt (TYPE_MAX_VALUE (iter_type), n))
iter_type = long_long_unsigned_type_node;
}
else if (TYPE_PRECISION (TREE_TYPE (loop->v))
> TYPE_PRECISION (iter_type))
{
tree n1, n2;
if (loop->cond_code == LT_EXPR)
{
n1 = loop->n1;
n2 = fold_build2_loc (loc,
PLUS_EXPR, TREE_TYPE (loop->v),
loop->n2, loop->step);
}
else
{
n1 = fold_build2_loc (loc,
MINUS_EXPR, TREE_TYPE (loop->v),
loop->n2, loop->step);
n2 = loop->n1;
}
if (TREE_CODE (n1) != INTEGER_CST
|| TREE_CODE (n2) != INTEGER_CST
|| !tree_int_cst_lt (TYPE_MIN_VALUE (iter_type), n1)
|| !tree_int_cst_lt (n2, TYPE_MAX_VALUE (iter_type)))
iter_type = long_long_unsigned_type_node;
}
}
if (i >= fd->collapse)
continue;
if (collapse_count && *collapse_count == NULL)
{
t = fold_binary (loop->cond_code, boolean_type_node,
fold_convert (TREE_TYPE (loop->v), loop->n1),
fold_convert (TREE_TYPE (loop->v), loop->n2));
if (t && integer_zerop (t))
count = build_zero_cst (long_long_unsigned_type_node);
else if ((i == 0 || count != NULL_TREE)
&& TREE_CODE (TREE_TYPE (loop->v)) == INTEGER_TYPE
&& TREE_CONSTANT (loop->n1)
&& TREE_CONSTANT (loop->n2)
&& TREE_CODE (loop->step) == INTEGER_CST)
{
tree itype = TREE_TYPE (loop->v);
if (POINTER_TYPE_P (itype))
itype = signed_type_for (itype);
t = build_int_cst (itype, (loop->cond_code == LT_EXPR ? -1 : 1));
t = fold_build2_loc (loc,
PLUS_EXPR, itype,
fold_convert_loc (loc, itype, loop->step), t);
t = fold_build2_loc (loc, PLUS_EXPR, itype, t,
fold_convert_loc (loc, itype, loop->n2));
t = fold_build2_loc (loc, MINUS_EXPR, itype, t,
fold_convert_loc (loc, itype, loop->n1));
if (TYPE_UNSIGNED (itype) && loop->cond_code == GT_EXPR)
t = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype,
fold_build1_loc (loc, NEGATE_EXPR, itype, t),
fold_build1_loc (loc, NEGATE_EXPR, itype,
fold_convert_loc (loc, itype,
loop->step)));
else
t = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, t,
fold_convert_loc (loc, itype, loop->step));
t = fold_convert_loc (loc, long_long_unsigned_type_node, t);
if (count != NULL_TREE)
count = fold_build2_loc (loc,
MULT_EXPR, long_long_unsigned_type_node,
count, t);
else
count = t;
if (TREE_CODE (count) != INTEGER_CST)
count = NULL_TREE;
}
else if (count && !integer_zerop (count))
count = NULL_TREE;
}
}
if (count
&& !simd
&& (fd->sched_kind != OMP_CLAUSE_SCHEDULE_STATIC
|| fd->have_ordered))
{
if (!tree_int_cst_lt (count, TYPE_MAX_VALUE (long_integer_type_node)))
iter_type = long_long_unsigned_type_node;
else
iter_type = long_integer_type_node;
}
else if (collapse_iter && *collapse_iter != NULL)
iter_type = TREE_TYPE (*collapse_iter);
fd->iter_type = iter_type;
if (collapse_iter && *collapse_iter == NULL)
*collapse_iter = create_tmp_var (iter_type, ".iter");
if (collapse_count && *collapse_count == NULL)
{
if (count)
*collapse_count = fold_convert_loc (loc, iter_type, count);
else
*collapse_count = create_tmp_var (iter_type, ".count");
}
if (fd->collapse > 1 || (fd->ordered && loops))
{
fd->loop.v = *collapse_iter;
fd->loop.n1 = build_int_cst (TREE_TYPE (fd->loop.v), 0);
fd->loop.n2 = *collapse_count;
fd->loop.step = build_int_cst (TREE_TYPE (fd->loop.v), 1);
fd->loop.cond_code = LT_EXPR;
}
else if (loops)
loops[0] = fd->loop;
}
static void
lto_symtab_resolve_symbols (void **slot)
{
lto_symtab_entry_t e;
lto_symtab_entry_t prevailing = NULL;
/* Always set e->node so that edges are updated to reflect decl merging. */
for (e = (lto_symtab_entry_t) *slot; e; e = e->next)
{
if (TREE_CODE (e->decl) == FUNCTION_DECL)
e->node = cgraph_get_node (e->decl);
else if (TREE_CODE (e->decl) == VAR_DECL)
e->vnode = varpool_get_node (e->decl);
if (e->resolution == LDPR_PREVAILING_DEF_IRONLY
|| e->resolution == LDPR_PREVAILING_DEF_IRONLY_EXP
|| e->resolution == LDPR_PREVAILING_DEF)
prevailing = e;
}
/* If the chain is already resolved there is nothing else to do. */
if (prevailing)
return;
/* Find the single non-replaceable prevailing symbol and
diagnose ODR violations. */
for (e = (lto_symtab_entry_t) *slot; e; e = e->next)
{
if (!lto_symtab_resolve_can_prevail_p (e))
{
e->resolution = LDPR_RESOLVED_IR;
e->guessed = true;
continue;
}
/* Set a default resolution - the final prevailing one will get
adjusted later. */
e->resolution = LDPR_PREEMPTED_IR;
e->guessed = true;
if (!lto_symtab_resolve_replaceable_p (e))
{
if (prevailing)
{
error_at (DECL_SOURCE_LOCATION (e->decl),
"%qD has already been defined", e->decl);
inform (DECL_SOURCE_LOCATION (prevailing->decl),
"previously defined here");
}
prevailing = e;
}
}
if (prevailing)
goto found;
/* Do a second round choosing one from the replaceable prevailing decls. */
for (e = (lto_symtab_entry_t) *slot; e; e = e->next)
{
if (e->resolution != LDPR_PREEMPTED_IR)
continue;
/* Choose the first function that can prevail as prevailing. */
if (TREE_CODE (e->decl) == FUNCTION_DECL)
{
prevailing = e;
break;
}
/* From variables that can prevail choose the largest one. */
if (!prevailing
|| tree_int_cst_lt (DECL_SIZE (prevailing->decl),
DECL_SIZE (e->decl)))
prevailing = e;
}
if (!prevailing)
return;
found:
/* If current lto files represent the whole program,
it is correct to use LDPR_PREVALING_DEF_IRONLY.
If current lto files are part of whole program, internal
resolver doesn't know if it is LDPR_PREVAILING_DEF
or LDPR_PREVAILING_DEF_IRONLY. Use IRONLY conforms to
using -fwhole-program. Otherwise, it doesn't
matter using either LDPR_PREVAILING_DEF or
LDPR_PREVAILING_DEF_IRONLY
FIXME: above workaround due to gold plugin makes some
variables IRONLY, which are indeed PREVAILING_DEF in
resolution file. These variables still need manual
externally_visible attribute. */
prevailing->resolution = LDPR_PREVAILING_DEF_IRONLY;
prevailing->guessed = true;
}
static void
build_constructors (gimple swtch)
{
unsigned i, branch_num = gimple_switch_num_labels (swtch);
tree pos = info.range_min;
for (i = 1; i < branch_num; i++)
{
tree cs = gimple_switch_label (swtch, i);
basic_block bb = label_to_block (CASE_LABEL (cs));
edge e;
tree high;
gimple_stmt_iterator gsi;
int j;
if (bb == info.final_bb)
e = find_edge (info.switch_bb, bb);
else
e = single_succ_edge (bb);
gcc_assert (e);
while (tree_int_cst_lt (pos, CASE_LOW (cs)))
{
int k;
for (k = 0; k < info.phi_count; k++)
{
constructor_elt *elt;
elt = VEC_quick_push (constructor_elt,
info.constructors[k], NULL);
elt->index = int_const_binop (MINUS_EXPR, pos,
info.range_min, 0);
elt->value = info.default_values[k];
}
pos = int_const_binop (PLUS_EXPR, pos, integer_one_node, 0);
}
gcc_assert (tree_int_cst_equal (pos, CASE_LOW (cs)));
j = 0;
if (CASE_HIGH (cs))
high = CASE_HIGH (cs);
else
high = CASE_LOW (cs);
for (gsi = gsi_start_phis (info.final_bb);
!gsi_end_p (gsi); gsi_next (&gsi))
{
gimple phi = gsi_stmt (gsi);
tree val = PHI_ARG_DEF_FROM_EDGE (phi, e);
tree low = CASE_LOW (cs);
pos = CASE_LOW (cs);
do
{
constructor_elt *elt;
elt = VEC_quick_push (constructor_elt,
info.constructors[j], NULL);
elt->index = int_const_binop (MINUS_EXPR, pos, info.range_min, 0);
elt->value = val;
pos = int_const_binop (PLUS_EXPR, pos, integer_one_node, 0);
} while (!tree_int_cst_lt (high, pos) && tree_int_cst_lt (low, pos));
j++;
}
}
}
static tree
build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
{
gfc_symbol *common_sym;
tree decl;
/* Create a namespace to store symbols for common blocks. */
if (gfc_common_ns == NULL)
gfc_common_ns = gfc_get_namespace (NULL);
gfc_get_symbol (com->name, gfc_common_ns, &common_sym);
decl = common_sym->backend_decl;
/* Update the size of this common block as needed. */
if (decl != NULL_TREE)
{
tree size = TYPE_SIZE_UNIT (union_type);
if (tree_int_cst_lt (DECL_SIZE_UNIT (decl), size))
{
/* Named common blocks of the same name shall be of the same size
in all scoping units of a program in which they appear, but
blank common blocks may be of different sizes. */
if (strcmp (com->name, BLANK_COMMON_NAME))
gfc_warning ("Named COMMON block '%s' at %L shall be of the "
"same size", com->name, &com->where);
DECL_SIZE_UNIT (decl) = size;
}
}
/* If this common block has been declared in a previous program unit,
and either it is already initialized or there is no new initialization
for it, just return. */
if ((decl != NULL_TREE) && (!is_init || DECL_INITIAL (decl)))
return decl;
/* If there is no backend_decl for the common block, build it. */
if (decl == NULL_TREE)
{
decl = build_decl (VAR_DECL, get_identifier (com->name), union_type);
SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_common_id (com->name));
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
DECL_USER_ALIGN (decl) = 0;
gfc_set_decl_location (decl, &com->where);
/* Place the back end declaration for this common block in
GLOBAL_BINDING_LEVEL. */
common_sym->backend_decl = pushdecl_top_level (decl);
}
/* Has no initial values. */
if (!is_init)
{
DECL_INITIAL (decl) = NULL_TREE;
DECL_COMMON (decl) = 1;
DECL_DEFER_OUTPUT (decl) = 1;
}
else
{
DECL_INITIAL (decl) = error_mark_node;
DECL_COMMON (decl) = 0;
DECL_DEFER_OUTPUT (decl) = 0;
}
return decl;
}
