Exemplo n.º 1
0
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;
}
Exemplo n.º 2
0
static void
create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
{
  segment_info *s, *next_s;
  tree union_type;
  tree *field_link;
  tree field;
  tree field_init = NULL_TREE;
  record_layout_info rli;
  tree decl;
  bool is_init = false;
  bool is_saved = false;

  /* Declare the variables inside the common block.
     If the current common block contains any equivalence object, then
     make a UNION_TYPE node, otherwise RECORD_TYPE. This will let the
     alias analyzer work well when there is no address overlapping for
     common variables in the current common block.  */
  if (saw_equiv)
    union_type = make_node (UNION_TYPE);
  else
    union_type = make_node (RECORD_TYPE);

  rli = start_record_layout (union_type);
  field_link = &TYPE_FIELDS (union_type);

  /* Check for overlapping initializers and replace them with a single,
     artificial field that contains all the data.  */
  if (saw_equiv)
    field = get_init_field (head, union_type, &field_init, rli);
  else
    field = NULL_TREE;

  if (field != NULL_TREE)
    {
      is_init = true;
      *field_link = field;
      field_link = &DECL_CHAIN (field);
    }

  for (s = head; s; s = s->next)
    {
      build_field (s, union_type, rli);

      /* Link the field into the type.  */
      *field_link = s->field;
      field_link = &DECL_CHAIN (s->field);

      /* Has initial value.  */
      if (s->sym->value)
        is_init = true;

      /* Has SAVE attribute.  */
      if (s->sym->attr.save)
        is_saved = true;
    }

  finish_record_layout (rli, true);

  if (com)
    decl = build_common_decl (com, union_type, is_init);
  else
    decl = build_equiv_decl (union_type, is_init, is_saved);

  if (is_init)
    {
      tree ctor, tmp;
      VEC(constructor_elt,gc) *v = NULL;

      if (field != NULL_TREE && field_init != NULL_TREE)
	CONSTRUCTOR_APPEND_ELT (v, field, field_init);
      else
	for (s = head; s; s = s->next)
	  {
	    if (s->sym->value)
	      {
		/* Add the initializer for this field.  */
		tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts,
					    TREE_TYPE (s->field),
					    s->sym->attr.dimension,
					    s->sym->attr.pointer
					    || s->sym->attr.allocatable, false);

		CONSTRUCTOR_APPEND_ELT (v, s->field, tmp);
	      }
	  }

      gcc_assert (!VEC_empty (constructor_elt, v));
      ctor = build_constructor (union_type, v);
      TREE_CONSTANT (ctor) = 1;
      TREE_STATIC (ctor) = 1;
      DECL_INITIAL (decl) = ctor;

#ifdef ENABLE_CHECKING
      {
	tree field, value;
	unsigned HOST_WIDE_INT idx;
	FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (ctor), idx, field, value)
	  gcc_assert (TREE_CODE (field) == FIELD_DECL);
      }
#endif
    }

  /* Build component reference for each variable.  */
  for (s = head; s; s = next_s)
    {
      tree var_decl;

      var_decl = build_decl (s->sym->declared_at.lb->location,
			     VAR_DECL, DECL_NAME (s->field),
			     TREE_TYPE (s->field));
      TREE_STATIC (var_decl) = TREE_STATIC (decl);
      /* Mark the variable as used in order to avoid warnings about
	 unused variables.  */
      TREE_USED (var_decl) = 1;
      if (s->sym->attr.use_assoc)
	DECL_IGNORED_P (var_decl) = 1;
      if (s->sym->attr.target)
	TREE_ADDRESSABLE (var_decl) = 1;
      /* Fake variables are not visible from other translation units. */
      TREE_PUBLIC (var_decl) = 0;

      /* To preserve identifier names in COMMON, chain to procedure
         scope unless at top level in a module definition.  */
      if (com
          && s->sym->ns->proc_name
          && s->sym->ns->proc_name->attr.flavor == FL_MODULE)
	var_decl = pushdecl_top_level (var_decl);
      else
	gfc_add_decl_to_function (var_decl);

      SET_DECL_VALUE_EXPR (var_decl,
			   fold_build3_loc (input_location, COMPONENT_REF,
					    TREE_TYPE (s->field),
					    decl, s->field, NULL_TREE));
      DECL_HAS_VALUE_EXPR_P (var_decl) = 1;
      GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1;

      if (s->sym->attr.assign)
	{
	  gfc_allocate_lang_decl (var_decl);
	  GFC_DECL_ASSIGN (var_decl) = 1;
	  GFC_DECL_STRING_LEN (var_decl) = GFC_DECL_STRING_LEN (s->field);
	  GFC_DECL_ASSIGN_ADDR (var_decl) = GFC_DECL_ASSIGN_ADDR (s->field);
	}

      s->sym->backend_decl = var_decl;

      next_s = s->next;
      free (s);
    }
}