struct segment_info *next;
} segment_info;
-static segment_info *current_segment, *current_common;
-static HOST_WIDE_INT current_offset;
+static segment_info * current_segment;
static gfc_namespace *gfc_common_ns = NULL;
#define BLANK_COMMON_NAME "__BLNK__"
backend declarations for all of the elements. */
static void
-create_common (gfc_common_head *com)
+create_common (gfc_common_head *com, segment_info * head)
{
segment_info *s, *next_s;
tree union_type;
rli = start_record_layout (union_type);
field_link = &TYPE_FIELDS (union_type);
- for (s = current_common; s; s = s->next)
+ for (s = head; s; s = s->next)
{
build_field (s, union_type, rli);
HOST_WIDE_INT offset = 0;
list = NULL_TREE;
- for (s = current_common; s; s = s->next)
+ for (s = head; s; s = s->next)
{
if (s->sym->value)
{
}
/* Build component reference for each variable. */
- for (s = current_common; s; s = next_s)
+ for (s = head; s; s = next_s)
{
s->sym->backend_decl = build3 (COMPONENT_REF, TREE_TYPE (s->field),
decl, s->field, NULL_TREE);
}
-/* Given a seed symbol, create a new segment consisting of that symbol
- and all of the symbols equivalenced with that symbol. */
+/* Returns the offset neccessary to properly align the current equivalence.
+ Sets *palign to the required alignment. */
+
+static HOST_WIDE_INT
+align_segment (unsigned HOST_WIDE_INT * palign)
+{
+ segment_info *s;
+ unsigned HOST_WIDE_INT offset;
+ unsigned HOST_WIDE_INT max_align;
+ unsigned HOST_WIDE_INT this_align;
+ unsigned HOST_WIDE_INT this_offset;
+
+ max_align = 1;
+ offset = 0;
+ for (s = current_segment; s; s = s->next)
+ {
+ this_align = TYPE_ALIGN_UNIT (s->field);
+ if (s->offset & (this_align - 1))
+ {
+ /* Field is misaligned. */
+ this_offset = this_align - ((s->offset + offset) & (this_align - 1));
+ if (this_offset & (max_align - 1))
+ {
+ /* Aligning this field would misalign a previous field. */
+ gfc_error ("The equivalence set for variable '%s' "
+ "declared at %L violates alignment requirents",
+ s->sym->name, &s->sym->declared_at);
+ }
+ offset += this_offset;
+ }
+ max_align = this_align;
+ }
+ if (palign)
+ *palign = max_align;
+ return offset;
+}
+
+
+/* Adjust segment offsets by the given amount. */
static void
-new_segment (gfc_common_head *common, gfc_symbol *sym)
+apply_segment_offset (segment_info * s, HOST_WIDE_INT offset)
{
+ for (; s; s = s->next)
+ s->offset += offset;
+}
+
+
+/* Lay out a symbol in a common block. If the symbol has already been seen
+ then check the location is consistent. Otherwise create segments
+ for that symbol and all the symbols equivalenced with it. */
+
+/* Translate a single common block. */
+
+static void
+translate_common (gfc_common_head *common, gfc_symbol *var_list)
+{
+ gfc_symbol *sym;
+ segment_info *s;
+ segment_info *common_segment;
+ HOST_WIDE_INT offset;
+ HOST_WIDE_INT current_offset;
+ unsigned HOST_WIDE_INT align;
+ unsigned HOST_WIDE_INT max_align;
+
+ common_segment = NULL;
+ current_offset = 0;
+ max_align = 1;
+
+ /* Add symbols to the segment. */
+ for (sym = var_list; sym; sym = sym->common_next)
+ {
+ if (sym->equiv_built)
+ {
+ /* Symbol has already been added via an equivalence. */
+ current_segment = common_segment;
+ s = find_segment_info (sym);
+
+ /* Ensure the current location is properly aligned. */
+ align = TYPE_ALIGN_UNIT (s->field);
+ current_offset = (current_offset + align - 1) &~ (align - 1);
+
+ /* Verify that it ended up where we expect it. */
+ if (s->offset != current_offset)
+ {
+ gfc_error ("Equivalence for '%s' does not match ordering of "
+ "COMMON '%s' at %L", sym->name,
+ common->name, &common->where);
+ }
+ }
+ else
+ {
+ /* A symbol we haven't seen before. */
+ s = current_segment = get_segment_info (sym, current_offset);
- current_segment = get_segment_info (sym, current_offset);
+ /* Add all objects directly or indirectly equivalenced with this
+ symbol. */
+ add_equivalences ();
- /* The offset of the next common variable. */
- current_offset += current_segment->length;
+ if (current_segment->offset < 0)
+ gfc_error ("The equivalence set for '%s' cause an invalid "
+ "extension to COMMON '%s' at %L", sym->name,
+ common->name, &common->where);
- /* Add all object directly or indirectly equivalenced with this common
- variable. */
- add_equivalences ();
+ offset = align_segment (&align);
+ apply_segment_offset (current_segment, offset);
- if (current_segment->offset < 0)
- gfc_error ("The equivalence set for '%s' cause an invalid "
- "extension to COMMON '%s' at %L", sym->name,
- common->name, &common->where);
+ if (offset & (max_align - 1))
+ {
+ /* The required offset conflicts with previous alignment
+ requirements. Insert padding immediately before this
+ segment. */
+ gfc_warning ("Padding of %d bytes required before '%s' in "
+ "COMMON '%s' at %L", offset, s->sym->name,
+ common->name, &common->where);
+ }
+ else
+ {
+ /* Offset the whole common block. */
+ apply_segment_offset (common_segment, offset);
+ }
- /* Add these to the common block. */
- current_common = add_segments (current_common, current_segment);
+ /* Apply the offset to the new segments. */
+ apply_segment_offset (current_segment, offset);
+ current_offset += offset;
+ if (max_align < align)
+ max_align = align;
+
+ /* Add the new segments to the common block. */
+ common_segment = add_segments (common_segment, current_segment);
+ }
+
+ /* The offset of the next common variable. */
+ current_offset += s->length;
+ }
+
+ if (common_segment->offset != 0)
+ {
+ gfc_warning ("COMMON '%s' at %L requires %d bytes of padding at start",
+ common->name, &common->where, common_segment->offset);
+ }
+
+ create_common (common, common_segment);
}
{
gfc_equiv *z, *y;
gfc_symbol *sym;
- segment_info *v;
HOST_WIDE_INT min_offset;
for (z = ns->equiv; z; z = z->next)
/* All objects directly or indirectly equivalenced with this symbol. */
add_equivalences ();
- /* Calculate the minimal offset. */
- min_offset = current_segment->offset;
+ /* Bias the offsets to to start at zero. */
+ min_offset = -current_segment->offset;
+
+ /* Ensure the block is properly aligned. */
+ min_offset += align_segment (NULL);
- /* Adjust the offset of each equivalence object. */
- for (v = current_segment; v; v = v->next)
- v->offset -= min_offset;
+ apply_segment_offset (current_segment, min_offset);
- current_common = current_segment;
- create_common (NULL);
+ /* Create the decl. */
+ create_common (NULL, current_segment);
break;
}
}
-/* Translate a single common block. */
-
-static void
-translate_common (gfc_common_head *common, gfc_symbol *var_list)
-{
- gfc_symbol *sym;
-
- current_common = NULL;
- current_offset = 0;
-
- /* Add symbols to the segment. */
- for (sym = var_list; sym; sym = sym->common_next)
- {
- if (! sym->equiv_built)
- new_segment (common, sym);
- }
-
- create_common (common);
-}
-
-
/* Work function for translating a named common block. */
static void
named_common (gfc_symtree *st)
{
-
translate_common (st->n.common, st->n.common->head);
}
OSDN Git Service
