C++ DECL_ALIGN函数代码示例

static unsigned int
increase_alignment (void)
{
  struct varpool_node *vnode;

  /* Increase the alignment of all global arrays for vectorization.  */
  FOR_EACH_DEFINED_VARIABLE (vnode)
    {
      tree vectype, decl = vnode->symbol.decl;
      tree t;
      unsigned int alignment;

      t = TREE_TYPE(decl);
      if (TREE_CODE (t) != ARRAY_TYPE)
        continue;
      vectype = get_vectype_for_scalar_type (strip_array_types (t));
      if (!vectype)
        continue;
      alignment = TYPE_ALIGN (vectype);
      if (DECL_ALIGN (decl) >= alignment)
        continue;

      if (vect_can_force_dr_alignment_p (decl, alignment))
        {
          DECL_ALIGN (decl) = TYPE_ALIGN (vectype);
          DECL_USER_ALIGN (decl) = 1;
          dump_printf (MSG_NOTE, "Increasing alignment of decl: ");
          dump_generic_expr (MSG_NOTE, TDF_SLIM, decl);
          dump_printf (MSG_NOTE, "\n");
        }
    }
  return 0;
}

/* Output a declaration.  Used for function locals, and struct/union members. */
void xml_generic_decl(tree decl, int indent, const char *tag, FILE *out)
{
    fprintf(out, "%s<%s", spc(indent), tag);
    xml_location(decl, out);
    fprintf(out, ">\n");
    indent += INDENT;

    xml_decl_binding(decl, indent, "binding", out);

    fprintf(out, "%s<type", spc(indent));
    if (DECL_SIZE(decl))
        fprintf(out, " size='%lu'", TREE_INT_CST_LOW(DECL_SIZE(decl)));
    if (DECL_ALIGN(decl))
        fprintf(out, " alignment='%d'", DECL_ALIGN(decl));
    fprintf(out, ">\n");

    /* Output the type. */
    xml_type(TREE_TYPE(decl), decl, indent + INDENT, out);

    fprintf(out, "%s</type>\n", spc(indent));

    if (TREE_CODE(decl) == VAR_DECL && DECL_INITIAL(decl))
    {
        fprintf(out, "%s<initial>\n", spc(indent));
        xml_expr(DECL_INITIAL(decl), indent + INDENT, out);
        fprintf(out, "%s</initial>\n", spc(indent));
    }

    indent -= INDENT;
    fprintf(out, "%s</%s>\n", spc(indent), tag);
}

static void
unpack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
{
  DECL_MODE (expr) = bp_unpack_machine_mode (bp);
  DECL_NONLOCAL (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_VIRTUAL_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_IGNORED_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_ABSTRACT_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_ARTIFICIAL (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_USER_ALIGN (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_PRESERVE_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_EXTERNAL (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_GIMPLE_REG_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_ALIGN (expr) = (unsigned) bp_unpack_var_len_unsigned (bp);
#ifdef ACCEL_COMPILER
  if (DECL_ALIGN (expr) > targetm.absolute_biggest_alignment)
    DECL_ALIGN (expr) = targetm.absolute_biggest_alignment;
#endif
  if (TREE_CODE (expr) == LABEL_DECL)
    {
      EH_LANDING_PAD_NR (expr) = (int) bp_unpack_var_len_unsigned (bp);

      /* Always assume an initial value of -1 for LABEL_DECL_UID to
	 force gimple_set_bb to recreate label_to_block_map.  */
      LABEL_DECL_UID (expr) = -1;
    }

  if (TREE_CODE (expr) == FIELD_DECL)
    {
      DECL_PACKED (expr) = (unsigned) bp_unpack_value (bp, 1);
      DECL_NONADDRESSABLE_P (expr) = (unsigned) bp_unpack_value (bp, 1);
      expr->decl_common.off_align = bp_unpack_value (bp, 8);
    }

  if (TREE_CODE (expr) == VAR_DECL)
    {
      DECL_HAS_DEBUG_EXPR_P (expr) = (unsigned) bp_unpack_value (bp, 1);
      DECL_NONLOCAL_FRAME (expr) = (unsigned) bp_unpack_value (bp, 1);
    }

  if (TREE_CODE (expr) == RESULT_DECL
      || TREE_CODE (expr) == PARM_DECL
      || TREE_CODE (expr) == VAR_DECL)
    {
      DECL_BY_REFERENCE (expr) = (unsigned) bp_unpack_value (bp, 1);
      if (TREE_CODE (expr) == VAR_DECL
	  || TREE_CODE (expr) == PARM_DECL)
	DECL_HAS_VALUE_EXPR_P (expr) = (unsigned) bp_unpack_value (bp, 1);
    }
}

static void
lto_symtab_merge_decls_2 (symtab_node first, bool diagnosed_p)
{
  symtab_node prevailing, e;
  vec<tree> mismatches = vNULL;
  unsigned i;
  tree decl;

  /* Nothing to do for a single entry.  */
  prevailing = first;
  if (!prevailing->symbol.next_sharing_asm_name)
    return;

  /* Try to merge each entry with the prevailing one.  */
  for (e = prevailing->symbol.next_sharing_asm_name;
       e; e = e->symbol.next_sharing_asm_name)
    if (TREE_PUBLIC (e->symbol.decl))
      {
	if (!lto_symtab_merge (prevailing, e)
	    && !diagnosed_p)
	  mismatches.safe_push (e->symbol.decl);
      }
  if (mismatches.is_empty ())
    return;

  /* Diagnose all mismatched re-declarations.  */
  FOR_EACH_VEC_ELT (mismatches, i, decl)
    {
      if (!types_compatible_p (TREE_TYPE (prevailing->symbol.decl),
			       TREE_TYPE (decl)))
	diagnosed_p |= warning_at (DECL_SOURCE_LOCATION (decl), 0,
				   "type of %qD does not match original "
				   "declaration", decl);

      else if ((DECL_USER_ALIGN (prevailing->symbol.decl)
	        && DECL_USER_ALIGN (decl))
	       && DECL_ALIGN (prevailing->symbol.decl) < DECL_ALIGN (decl))
	{
	  diagnosed_p |= warning_at (DECL_SOURCE_LOCATION (decl), 0,
				     "alignment of %qD is bigger than "
				     "original declaration", decl);
	}
    }
  if (diagnosed_p)
    inform (DECL_SOURCE_LOCATION (prevailing->symbol.decl),
	    "previously declared here");

  mismatches.release ();
}

struct FieldInfo* createFieldInfo(const tree field_decl)
{
  struct FieldInfo* fi = (struct FieldInfo*) xcalloc(1, sizeof(struct FieldInfo));
  fi->isSpecial = DECL_ARTIFICIAL(field_decl);
  fi->isBitField = DECL_BIT_FIELD(field_decl);

  const char* fieldName;
  if (fi->isSpecial)
    fieldName = fieldNames[FIELD_BASE];
  else if (DECL_NAME(field_decl))
    fieldName = IDENTIFIER_POINTER(DECL_NAME(field_decl));
  else
    fieldName = fieldNames[FIELD_NONAME];

  fi->name = xstrdup(fieldName);

  fi->size = TREE_INT_CST_LOW(DECL_SIZE(field_decl));

  // Offset calculation is a little bit wierd. According to GCC docs:
  // "... DECL_FIELD_OFFSET is position, counting in bytes, of the
  // DECL_OFFSET_ALIGN-bit sized word ..." and ".. DECL_FIELD_BIT_OFFSET is the
  // bit offset of the first bit of the field within this word"
  fi->offset = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(field_decl)) * BITS_PER_UNIT +
    TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(field_decl));

  fi->align = DECL_ALIGN(field_decl);

  return fi;
}

static tree
create_struct_type(tree decl, size_t front_rz_size, size_t rear_rz_size)
{
    // TODO make this dynamic rather than static
    char type_name[50];
    tree fieldfront, orig_var, fieldrear, struct_type;

    gcc_assert(front_rz_size % 8 == 0 && rear_rz_size % 8 == 0);

    struct_type = mf_mark(make_node (RECORD_TYPE));

    // Build the front red zone
    tree front_array_idx =  build_index_type (size_int (front_rz_size / sizeof(unsigned int)));
    tree front_rz_array = build_array_type (unsigned_type_node, front_array_idx);
    fieldfront = build_decl (UNKNOWN_LOCATION,
            FIELD_DECL, get_identifier ("rz_front"), front_rz_array);
    DECL_ALIGN(fieldfront) = 8;
    DECL_CONTEXT (fieldfront) = struct_type;

    // orig variable
    orig_var = build_decl (UNKNOWN_LOCATION,
            FIELD_DECL, get_identifier("orig_var"), TREE_TYPE(decl));
    DECL_CONTEXT (orig_var) = struct_type; // Look at comments above
    DECL_CHAIN (fieldfront) = orig_var;

    // Rear zone
    if (COMPLETE_TYPE_P(decl)){
        tree rear_array_idx =  build_index_type (size_int (rear_rz_size / sizeof(unsigned int)));
        tree rear_rz_array = build_array_type (unsigned_type_node, rear_array_idx);
        fieldrear = build_decl (UNKNOWN_LOCATION,
                FIELD_DECL, get_identifier ("rz_rear"), rear_rz_array);
        DECL_ALIGN(fieldrear) = 8;
        DECL_CONTEXT (fieldrear) = struct_type;
        DECL_CHAIN (orig_var) = fieldrear;
    }

    TYPE_FIELDS (struct_type) = fieldfront;

    strcpy(type_name, "rz_");
    strcat(type_name, get_name(decl));
    strcat(type_name, "_type");
    TYPE_NAME (struct_type) = get_identifier (type_name);
    layout_type (struct_type);

    return struct_type;
}

static void
lto_symtab_merge_decls_2 (void **slot, bool diagnosed_p)
{
  lto_symtab_entry_t prevailing, e;
  VEC(tree, heap) *mismatches = NULL;
  unsigned i;
  tree decl;

  /* Nothing to do for a single entry.  */
  prevailing = (lto_symtab_entry_t) *slot;
  if (!prevailing->next)
    return;

  /* Try to merge each entry with the prevailing one.  */
  for (e = prevailing->next; e; e = e->next)
    {
      if (!lto_symtab_merge (prevailing, e)
	  && !diagnosed_p)
	VEC_safe_push (tree, heap, mismatches, e->decl);
    }
  if (VEC_empty (tree, mismatches))
    return;

  /* Diagnose all mismatched re-declarations.  */
  FOR_EACH_VEC_ELT (tree, mismatches, i, decl)
    {
      if (!types_compatible_p (TREE_TYPE (prevailing->decl), TREE_TYPE (decl)))
	diagnosed_p |= warning_at (DECL_SOURCE_LOCATION (decl), 0,
				   "type of %qD does not match original "
				   "declaration", decl);

      else if ((DECL_USER_ALIGN (prevailing->decl) && DECL_USER_ALIGN (decl))
	       && DECL_ALIGN (prevailing->decl) < DECL_ALIGN (decl))
	{
	  diagnosed_p |= warning_at (DECL_SOURCE_LOCATION (decl), 0,
				     "alignment of %qD is bigger than "
				     "original declaration", decl);
	}
    }
  if (diagnosed_p)
    inform (DECL_SOURCE_LOCATION (prevailing->decl),
	    "previously declared here");

  VEC_free (tree, heap, mismatches);
}

static unsigned int
increase_alignment (void)
{
  struct varpool_node *vnode;

  /* Increase the alignment of all global arrays for vectorization.  */
  for (vnode = varpool_nodes_queue;
       vnode;
       vnode = vnode->next_needed)
    {
      tree vectype, decl = vnode->decl;
      tree t;
      unsigned int alignment;

      t = TREE_TYPE(decl);
      if (TREE_CODE (t) != ARRAY_TYPE)
        continue;
      vectype = get_vectype_for_scalar_type (strip_array_types (t));
      if (!vectype)
        continue;
      alignment = TYPE_ALIGN (vectype);
      if (DECL_ALIGN (decl) >= alignment)
        continue;

      if (vect_can_force_dr_alignment_p (decl, alignment))
        {
          DECL_ALIGN (decl) = TYPE_ALIGN (vectype);
          DECL_USER_ALIGN (decl) = 1;
          if (dump_file)
            {
              fprintf (dump_file, "Increasing alignment of decl: ");
              print_generic_expr (dump_file, decl, TDF_SLIM);
	      fprintf (dump_file, "\n");
            }
        }
    }
  return 0;
}

static unsigned int
get_decl_align_unit (tree decl)
{
  unsigned int align;

  align = DECL_ALIGN (decl);
  align = LOCAL_ALIGNMENT (TREE_TYPE (decl), align);
  if (align > PREFERRED_STACK_BOUNDARY)
    align = PREFERRED_STACK_BOUNDARY;
  if (cfun->stack_alignment_needed < align)
    cfun->stack_alignment_needed = align;

  return align / BITS_PER_UNIT;
}

static void
pack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
{
  bp_pack_enum (bp, machine_mode, MAX_MACHINE_MODE, DECL_MODE (expr));
  bp_pack_value (bp, DECL_NONLOCAL (expr), 1);
  bp_pack_value (bp, DECL_VIRTUAL_P (expr), 1);
  bp_pack_value (bp, DECL_IGNORED_P (expr), 1);
  bp_pack_value (bp, DECL_ABSTRACT (expr), 1);
  bp_pack_value (bp, DECL_ARTIFICIAL (expr), 1);
  bp_pack_value (bp, DECL_USER_ALIGN (expr), 1);
  bp_pack_value (bp, DECL_PRESERVE_P (expr), 1);
  bp_pack_value (bp, DECL_EXTERNAL (expr), 1);
  bp_pack_value (bp, DECL_GIMPLE_REG_P (expr), 1);
  bp_pack_var_len_unsigned (bp, DECL_ALIGN (expr));

  if (TREE_CODE (expr) == LABEL_DECL)
    {
      /* Note that we do not write LABEL_DECL_UID.  The reader will
	 always assume an initial value of -1 so that the
	 label_to_block_map is recreated by gimple_set_bb.  */
      bp_pack_value (bp, DECL_ERROR_ISSUED (expr), 1);
      bp_pack_var_len_unsigned (bp, EH_LANDING_PAD_NR (expr));
    }

  if (TREE_CODE (expr) == FIELD_DECL)
    {
      bp_pack_value (bp, DECL_PACKED (expr), 1);
      bp_pack_value (bp, DECL_NONADDRESSABLE_P (expr), 1);
      bp_pack_value (bp, expr->decl_common.off_align, 8);
    }

  if (TREE_CODE (expr) == VAR_DECL)
    {
      bp_pack_value (bp, DECL_HAS_DEBUG_EXPR_P (expr), 1);
      bp_pack_value (bp, DECL_NONLOCAL_FRAME (expr), 1);
    }

  if (TREE_CODE (expr) == RESULT_DECL
      || TREE_CODE (expr) == PARM_DECL
      || TREE_CODE (expr) == VAR_DECL)
    {
      bp_pack_value (bp, DECL_BY_REFERENCE (expr), 1);
      if (TREE_CODE (expr) == VAR_DECL
	  || TREE_CODE (expr) == PARM_DECL)
	bp_pack_value (bp, DECL_HAS_VALUE_EXPR_P (expr), 1);
    }
}

static void
unpack_ts_decl_common_value_fields (struct bitpack_d *bp, tree expr)
{
  DECL_MODE (expr) = bp_unpack_enum (bp, machine_mode, MAX_MACHINE_MODE);
  DECL_NONLOCAL (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_VIRTUAL_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_IGNORED_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_ABSTRACT (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_ARTIFICIAL (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_USER_ALIGN (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_PRESERVE_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_DEBUG_EXPR_IS_FROM (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_EXTERNAL (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_GIMPLE_REG_P (expr) = (unsigned) bp_unpack_value (bp, 1);
  DECL_ALIGN (expr) = (unsigned) bp_unpack_var_len_unsigned (bp);

  if (TREE_CODE (expr) == LABEL_DECL)
    {
      DECL_ERROR_ISSUED (expr) = (unsigned) bp_unpack_value (bp, 1);
      EH_LANDING_PAD_NR (expr) = (int) bp_unpack_var_len_unsigned (bp);

      /* Always assume an initial value of -1 for LABEL_DECL_UID to
	 force gimple_set_bb to recreate label_to_block_map.  */
      LABEL_DECL_UID (expr) = -1;
    }

  if (TREE_CODE (expr) == FIELD_DECL)
    {
      DECL_PACKED (expr) = (unsigned) bp_unpack_value (bp, 1);
      DECL_NONADDRESSABLE_P (expr) = (unsigned) bp_unpack_value (bp, 1);
      expr->decl_common.off_align = bp_unpack_value (bp, 8);
    }

  if (TREE_CODE (expr) == VAR_DECL)
    DECL_NONLOCAL_FRAME (expr) = (unsigned) bp_unpack_value (bp, 1);

  if (TREE_CODE (expr) == RESULT_DECL
      || TREE_CODE (expr) == PARM_DECL
      || TREE_CODE (expr) == VAR_DECL)
    {
      DECL_BY_REFERENCE (expr) = (unsigned) bp_unpack_value (bp, 1);
      if (TREE_CODE (expr) == VAR_DECL
	  || TREE_CODE (expr) == PARM_DECL)
	DECL_HAS_VALUE_EXPR_P (expr) = (unsigned) bp_unpack_value (bp, 1);
    }
}

tree
copy_var_decl (tree var, tree name, tree type)
{
  tree copy = build_decl (DECL_SOURCE_LOCATION (var), VAR_DECL, name, type);

  TREE_ADDRESSABLE (copy) = TREE_ADDRESSABLE (var);
  TREE_THIS_VOLATILE (copy) = TREE_THIS_VOLATILE (var);
  DECL_GIMPLE_REG_P (copy) = DECL_GIMPLE_REG_P (var);
  DECL_ARTIFICIAL (copy) = DECL_ARTIFICIAL (var);
  DECL_IGNORED_P (copy) = DECL_IGNORED_P (var);
  DECL_CONTEXT (copy) = DECL_CONTEXT (var);
  TREE_NO_WARNING (copy) = TREE_NO_WARNING (var);
  TREE_USED (copy) = 1;
  DECL_SEEN_IN_BIND_EXPR_P (copy) = 1;
  DECL_ATTRIBUTES (copy) = DECL_ATTRIBUTES (var);
  if (DECL_USER_ALIGN (var))
    {
      SET_DECL_ALIGN (copy, DECL_ALIGN (var));
      DECL_USER_ALIGN (copy) = 1;
    }

  return copy;
}

static void
expand_one_stack_var_at (tree decl, HOST_WIDE_INT offset)
{
  HOST_WIDE_INT align;
  rtx x;
  
  /* If this fails, we've overflowed the stack frame.  Error nicely?  */
  gcc_assert (offset == trunc_int_for_mode (offset, Pmode));

  x = plus_constant (virtual_stack_vars_rtx, offset);
  x = gen_rtx_MEM (DECL_MODE (decl), x);

  /* Set alignment we actually gave this decl.  */
  offset -= frame_phase;
  align = offset & -offset;
  align *= BITS_PER_UNIT;
  if (align > STACK_BOUNDARY || align == 0)
    align = STACK_BOUNDARY;
  DECL_ALIGN (decl) = align;
  DECL_USER_ALIGN (decl) = 0;

  set_mem_attributes (x, decl, true);
  SET_DECL_RTL (decl, x);
}

static bool
lto_symtab_merge (symtab_node prevailing, symtab_node entry)
{
  tree prevailing_decl = prevailing->symbol.decl;
  tree decl = entry->symbol.decl;
  tree prevailing_type, type;

  if (prevailing_decl == decl)
    return true;

  /* Merge decl state in both directions, we may still end up using
     the new decl.  */
  TREE_ADDRESSABLE (prevailing_decl) |= TREE_ADDRESSABLE (decl);
  TREE_ADDRESSABLE (decl) |= TREE_ADDRESSABLE (prevailing_decl);

  /* The linker may ask us to combine two incompatible symbols.
     Detect this case and notify the caller of required diagnostics.  */

  if (TREE_CODE (decl) == FUNCTION_DECL)
    {
      if (!types_compatible_p (TREE_TYPE (prevailing_decl),
			       TREE_TYPE (decl)))
	/* If we don't have a merged type yet...sigh.  The linker
	   wouldn't complain if the types were mismatched, so we
	   probably shouldn't either.  Just use the type from
	   whichever decl appears to be associated with the
	   definition.  If for some odd reason neither decl is, the
	   older one wins.  */
	(void) 0;

      return true;
    }

  /* Now we exclusively deal with VAR_DECLs.  */

  /* Sharing a global symbol is a strong hint that two types are
     compatible.  We could use this information to complete
     incomplete pointed-to types more aggressively here, ignoring
     mismatches in both field and tag names.  It's difficult though
     to guarantee that this does not have side-effects on merging
     more compatible types from other translation units though.  */

  /* We can tolerate differences in type qualification, the
     qualification of the prevailing definition will prevail.
     ???  In principle we might want to only warn for structurally
     incompatible types here, but unless we have protective measures
     for TBAA in place that would hide useful information.  */
  prevailing_type = TYPE_MAIN_VARIANT (TREE_TYPE (prevailing_decl));
  type = TYPE_MAIN_VARIANT (TREE_TYPE (decl));

  if (!types_compatible_p (prevailing_type, type))
    {
      if (COMPLETE_TYPE_P (type))
	return false;

      /* If type is incomplete then avoid warnings in the cases
	 that TBAA handles just fine.  */

      if (TREE_CODE (prevailing_type) != TREE_CODE (type))
	return false;

      if (TREE_CODE (prevailing_type) == ARRAY_TYPE)
	{
	  tree tem1 = TREE_TYPE (prevailing_type);
	  tree tem2 = TREE_TYPE (type);
	  while (TREE_CODE (tem1) == ARRAY_TYPE
		 && TREE_CODE (tem2) == ARRAY_TYPE)
	    {
	      tem1 = TREE_TYPE (tem1);
	      tem2 = TREE_TYPE (tem2);
	    }

	  if (TREE_CODE (tem1) != TREE_CODE (tem2))
	    return false;

	  if (!types_compatible_p (tem1, tem2))
	    return false;
	}

      /* Fallthru.  Compatible enough.  */
    }

  /* ???  We might want to emit a warning here if type qualification
     differences were spotted.  Do not do this unconditionally though.  */

  /* There is no point in comparing too many details of the decls here.
     The type compatibility checks or the completing of types has properly
     dealt with most issues.  */

  /* The following should all not invoke fatal errors as in non-LTO
     mode the linker wouldn't complain either.  Just emit warnings.  */

  /* Report a warning if user-specified alignments do not match.  */
  if ((DECL_USER_ALIGN (prevailing_decl) && DECL_USER_ALIGN (decl))
      && DECL_ALIGN (prevailing_decl) < DECL_ALIGN (decl))
    return false;

  return true;
}

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;
}