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