static tree
ubsan_type_descriptor_type (void)
{
static const char *field_names[3]
= { "__typekind", "__typeinfo", "__typename" };
tree fields[3], ret;
tree itype = build_range_type (sizetype, size_zero_node, NULL_TREE);
tree flex_arr_type = build_array_type (char_type_node, itype);
ret = make_node (RECORD_TYPE);
for (int i = 0; i < 3; i++)
{
fields[i] = build_decl (UNKNOWN_LOCATION, FIELD_DECL,
get_identifier (field_names[i]),
(i == 2) ? flex_arr_type
: short_unsigned_type_node);
DECL_CONTEXT (fields[i]) = ret;
if (i)
DECL_CHAIN (fields[i - 1]) = fields[i];
}
TYPE_FIELDS (ret) = fields[0];
TYPE_NAME (ret) = get_identifier ("__ubsan_type_descriptor");
layout_type (ret);
return ret;
}
tree
gfc_build_wide_string_const (int kind, int length, const gfc_char_t *string)
{
int i;
tree str, len;
size_t size;
char *s;
i = gfc_validate_kind (BT_CHARACTER, kind, false);
size = length * gfc_character_kinds[i].bit_size / 8;
s = XCNEWVAR (char, size);
gfc_encode_character (kind, length, string, (unsigned char *) s, size);
str = build_string (size, s);
free (s);
len = size_int (length);
TREE_TYPE (str) =
build_array_type (gfc_get_char_type (kind),
build_range_type (gfc_charlen_type_node,
size_one_node, len));
TYPE_STRING_FLAG (TREE_TYPE (str)) = 1;
return str;
}
tree
gfc_build_string_const (int length, const char *s)
{
tree str;
tree len;
str = build_string (length, s);
len = size_int (length);
TREE_TYPE (str) =
build_array_type (gfc_character1_type_node,
build_range_type (gfc_charlen_type_node,
size_one_node, len));
return str;
}
static tree
get_init_field (segment_info *head, tree union_type, tree *field_init,
record_layout_info rli)
{
segment_info *s;
HOST_WIDE_INT length = 0;
HOST_WIDE_INT offset = 0;
unsigned HOST_WIDE_INT known_align, desired_align;
bool overlap = false;
tree tmp, field;
tree init;
unsigned char *data, *chk;
VEC(constructor_elt,gc) *v = NULL;
tree type = unsigned_char_type_node;
int i;
/* Obtain the size of the union and check if there are any overlapping
initializers. */
for (s = head; s; s = s->next)
{
HOST_WIDE_INT slen = s->offset + s->length;
if (s->sym->value)
{
if (s->offset < offset)
overlap = true;
offset = slen;
}
length = length < slen ? slen : length;
}
if (!overlap)
return NULL_TREE;
/* Now absorb all the initializer data into a single vector,
whilst checking for overlapping, unequal values. */
data = XCNEWVEC (unsigned char, (size_t)length);
chk = XCNEWVEC (unsigned char, (size_t)length);
/* TODO - change this when default initialization is implemented. */
memset (data, '\0', (size_t)length);
memset (chk, '\0', (size_t)length);
for (s = head; s; s = s->next)
if (s->sym->value)
gfc_merge_initializers (s->sym->ts, s->sym->value,
&data[s->offset],
&chk[s->offset],
(size_t)s->length);
for (i = 0; i < length; i++)
CONSTRUCTOR_APPEND_ELT (v, NULL, build_int_cst (type, data[i]));
free (data);
free (chk);
/* Build a char[length] array to hold the initializers. Much of what
follows is borrowed from build_field, above. */
tmp = build_int_cst (gfc_array_index_type, length - 1);
tmp = build_range_type (gfc_array_index_type,
gfc_index_zero_node, tmp);
tmp = build_array_type (type, tmp);
field = build_decl (gfc_current_locus.lb->location,
FIELD_DECL, NULL_TREE, tmp);
known_align = BIGGEST_ALIGNMENT;
desired_align = update_alignment_for_field (rli, field, known_align);
if (desired_align > known_align)
DECL_PACKED (field) = 1;
DECL_FIELD_CONTEXT (field) = union_type;
DECL_FIELD_OFFSET (field) = size_int (0);
DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
SET_DECL_OFFSET_ALIGN (field, known_align);
rli->offset = size_binop (MAX_EXPR, rli->offset,
size_binop (PLUS_EXPR,
DECL_FIELD_OFFSET (field),
DECL_SIZE_UNIT (field)));
init = build_constructor (TREE_TYPE (field), v);
TREE_CONSTANT (init) = 1;
*field_init = init;
for (s = head; s; s = s->next)
{
if (s->sym->value == NULL)
continue;
gfc_free_expr (s->sym->value);
s->sym->value = NULL;
}
return field;
}
void
gfc_init_types (void)
{
char name_buf[16];
int index;
tree type;
unsigned n;
unsigned HOST_WIDE_INT hi;
unsigned HOST_WIDE_INT lo;
/* Create and name the types. */
#define PUSH_TYPE(name, node) \
pushdecl (build_decl (TYPE_DECL, get_identifier (name), node))
for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
{
type = gfc_build_int_type (&gfc_integer_kinds[index]);
gfc_integer_types[index] = type;
snprintf (name_buf, sizeof(name_buf), "int%d",
gfc_integer_kinds[index].kind);
PUSH_TYPE (name_buf, type);
}
for (index = 0; gfc_logical_kinds[index].kind != 0; ++index)
{
type = gfc_build_logical_type (&gfc_logical_kinds[index]);
gfc_logical_types[index] = type;
snprintf (name_buf, sizeof(name_buf), "logical%d",
gfc_logical_kinds[index].kind);
PUSH_TYPE (name_buf, type);
}
for (index = 0; gfc_real_kinds[index].kind != 0; index++)
{
type = gfc_build_real_type (&gfc_real_kinds[index]);
gfc_real_types[index] = type;
snprintf (name_buf, sizeof(name_buf), "real%d",
gfc_real_kinds[index].kind);
PUSH_TYPE (name_buf, type);
type = gfc_build_complex_type (type);
gfc_complex_types[index] = type;
snprintf (name_buf, sizeof(name_buf), "complex%d",
gfc_real_kinds[index].kind);
PUSH_TYPE (name_buf, type);
}
gfc_character1_type_node = build_type_variant (unsigned_char_type_node,
0, 0);
PUSH_TYPE ("char", gfc_character1_type_node);
PUSH_TYPE ("byte", unsigned_char_type_node);
PUSH_TYPE ("void", void_type_node);
/* DBX debugging output gets upset if these aren't set. */
if (!TYPE_NAME (integer_type_node))
PUSH_TYPE ("c_integer", integer_type_node);
if (!TYPE_NAME (char_type_node))
PUSH_TYPE ("c_char", char_type_node);
#undef PUSH_TYPE
pvoid_type_node = build_pointer_type (void_type_node);
ppvoid_type_node = build_pointer_type (pvoid_type_node);
pchar_type_node = build_pointer_type (gfc_character1_type_node);
gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
gfc_array_range_type
= build_range_type (gfc_array_index_type,
build_int_cst (gfc_array_index_type, 0),
NULL_TREE);
/* The maximum array element size that can be handled is determined
by the number of bits available to store this field in the array
descriptor. */
n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
lo = ~ (unsigned HOST_WIDE_INT) 0;
if (n > HOST_BITS_PER_WIDE_INT)
hi = lo >> (2*HOST_BITS_PER_WIDE_INT - n);
else
