static void
build_field (segment_info *h, tree union_type, record_layout_info rli)
{
tree field;
tree name;
HOST_WIDE_INT offset = h->offset;
unsigned HOST_WIDE_INT desired_align, known_align;
name = get_identifier (h->sym->name);
field = build_decl (h->sym->declared_at.lb->location,
FIELD_DECL, name, h->field);
known_align = (offset & -offset) * BITS_PER_UNIT;
if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
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 (offset);
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)));
/* If this field is assigned to a label, we create another two variables.
One will hold the address of target label or format label. The other will
hold the length of format label string. */
if (h->sym->attr.assign)
{
tree len;
tree addr;
gfc_allocate_lang_decl (field);
GFC_DECL_ASSIGN (field) = 1;
len = gfc_create_var_np (gfc_charlen_type_node,h->sym->name);
addr = gfc_create_var_np (pvoid_type_node, h->sym->name);
TREE_STATIC (len) = 1;
TREE_STATIC (addr) = 1;
DECL_INITIAL (len) = build_int_cst (NULL_TREE, -2);
gfc_set_decl_location (len, &h->sym->declared_at);
gfc_set_decl_location (addr, &h->sym->declared_at);
GFC_DECL_STRING_LEN (field) = pushdecl_top_level (len);
GFC_DECL_ASSIGN_ADDR (field) = pushdecl_top_level (addr);
}
/* If this field is volatile, mark it. */
if (h->sym->attr.volatile_)
{
tree new_type;
TREE_THIS_VOLATILE (field) = 1;
new_type = build_qualified_type (TREE_TYPE (field), TYPE_QUAL_VOLATILE);
TREE_TYPE (field) = new_type;
}
h->field = field;
}
static tree
build_equiv_decl (tree union_type, bool is_init)
{
tree decl;
if (is_init)
{
decl = gfc_create_var (union_type, "equiv");
TREE_STATIC (decl) = 1;
return decl;
}
decl = build_decl (VAR_DECL, NULL, union_type);
DECL_ARTIFICIAL (decl) = 1;
DECL_COMMON (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
TREE_USED (decl) = 1;
/* The source location has been lost, and doesn't really matter.
We need to set it to something though. */
gfc_set_decl_location (decl, &gfc_current_locus);
gfc_add_decl_to_function (decl);
return decl;
}
static void
build_field (segment_info *h, tree union_type, record_layout_info rli)
{
tree field;
tree name;
HOST_WIDE_INT offset = h->offset;
unsigned HOST_WIDE_INT desired_align, known_align;
name = get_identifier (h->sym->name);
field = build_decl (FIELD_DECL, name, h->field);
gfc_set_decl_location (field, &h->sym->declared_at);
known_align = (offset & -offset) * BITS_PER_UNIT;
if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
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 (offset);
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)));
h->field = field;
}
static tree
build_equiv_decl (tree union_type, bool is_init)
{
tree decl;
char name[15];
static int serial = 0;
if (is_init)
{
decl = gfc_create_var (union_type, "equiv");
TREE_STATIC (decl) = 1;
return decl;
}
snprintf (name, sizeof (name), "equiv.%d", serial++);
decl = build_decl (VAR_DECL, get_identifier (name), union_type);
DECL_ARTIFICIAL (decl) = 1;
DECL_IGNORED_P (decl) = 1;
if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)))
TREE_STATIC (decl) = 1;
TREE_ADDRESSABLE (decl) = 1;
TREE_USED (decl) = 1;
/* The source location has been lost, and doesn't really matter.
We need to set it to something though. */
gfc_set_decl_location (decl, &gfc_current_locus);
gfc_add_decl_to_function (decl);
return decl;
}
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 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;
}
