diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/fortran/trans-io.c | 13 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.c | 121 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.h | 2 |
5 files changed, 88 insertions, 66 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1850913..6fbf2d5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2010-07-02 Nathan Froyd <froydnj@codesourcery.com> + + * trans-types.h (gfc_add_field_to_struct): Add tree ** parameter. + * trans-types.c (gfc_add_field_to_struct_1): New function, most + of which comes from... + (gfc_add_field_to_struct): ...here. Call it. Add new parameter. + (gfc_get_desc_dim_type): Call gfc_add_field_to_struct_1 for + building fields. + (gfc_get_array_descriptor_base): Likewise. + (gfc_get_mixed_entry_union): Likewise. + (gfc_get_derived_type): Add extra chain parameter for + gfc_add_field_to_struct. + * trans-stmt.c (gfc_trans_character_select): Likewise. + * trans-io.c (gfc_build_st_parameter): Likewise. + 2010-06-29 Janus Weil <janus@gcc.gnu.org> PR fortran/44718 diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 1608a5e..9926d2f 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -156,6 +156,7 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types) char name[64]; size_t len; tree t = make_node (RECORD_TYPE); + tree *chain = NULL; len = strlen (st_parameter[ptype].name); gcc_assert (len <= sizeof (name) - sizeof ("__st_parameter_")); @@ -177,12 +178,12 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types) case IOPARM_type_pad: p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, get_identifier (p->name), - types[p->type]); + types[p->type], &chain); break; case IOPARM_type_char1: p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, get_identifier (p->name), - pchar_type_node); + pchar_type_node, &chain); /* FALLTHROUGH */ case IOPARM_type_char2: len = strlen (p->name); @@ -191,17 +192,19 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types) memcpy (name + len, "_len", sizeof ("_len")); p->field_len = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, get_identifier (name), - gfc_charlen_type_node); + gfc_charlen_type_node, + &chain); if (p->type == IOPARM_type_char2) p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, get_identifier (p->name), - pchar_type_node); + pchar_type_node, &chain); break; case IOPARM_type_common: p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t, get_identifier (p->name), - st_parameter[IOPARM_ptype_common].type); + st_parameter[IOPARM_ptype_common].type, + &chain); break; case IOPARM_type_num: gcc_unreachable (); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 6fa84b9..15f2acb 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1633,6 +1633,7 @@ gfc_trans_character_select (gfc_code *code) if (select_struct[k] == NULL) { + tree *chain = NULL; select_struct[k] = make_node (RECORD_TYPE); if (code->expr1->ts.kind == 1) @@ -1646,7 +1647,7 @@ gfc_trans_character_select (gfc_code *code) #define ADD_FIELD(NAME, TYPE) \ ss_##NAME[k] = gfc_add_field_to_struct \ (&(TYPE_FIELDS (select_struct[k])), select_struct[k], \ - get_identifier (stringize(NAME)), TYPE) + get_identifier (stringize(NAME)), TYPE, &chain) ADD_FIELD (string1, pchartype); ADD_FIELD (string1_len, gfc_charlen_type_node); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 2f5b759..f4e78c2 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -86,6 +86,7 @@ gfc_character_info gfc_character_kinds[MAX_CHARACTER_KINDS + 1]; static GTY(()) tree gfc_character_types[MAX_CHARACTER_KINDS + 1]; static GTY(()) tree gfc_pcharacter_types[MAX_CHARACTER_KINDS + 1]; +static tree gfc_add_field_to_struct_1 (tree *, tree, tree, tree, tree **); /* The integer kind to use for array indices. This will be set to the proper value based on target information from the backend. */ @@ -1232,8 +1233,7 @@ static tree gfc_get_desc_dim_type (void) { tree type; - tree decl; - tree fieldlist; + tree fieldlist = NULL_TREE, decl, *chain = NULL; if (gfc_desc_dim_type) return gfc_desc_dim_type; @@ -1245,26 +1245,20 @@ gfc_get_desc_dim_type (void) TYPE_PACKED (type) = 1; /* Consists of the stride, lbound and ubound members. */ - decl = build_decl (input_location, - FIELD_DECL, - get_identifier ("stride"), gfc_array_index_type); - DECL_CONTEXT (decl) = type; + decl = gfc_add_field_to_struct_1 (&fieldlist, type, + get_identifier ("stride"), + gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; - fieldlist = decl; - decl = build_decl (input_location, - FIELD_DECL, - get_identifier ("lbound"), gfc_array_index_type); - DECL_CONTEXT (decl) = type; + decl = gfc_add_field_to_struct_1 (&fieldlist, type, + get_identifier ("lbound"), + gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; - fieldlist = chainon (fieldlist, decl); - decl = build_decl (input_location, - FIELD_DECL, - get_identifier ("ubound"), gfc_array_index_type); - DECL_CONTEXT (decl) = type; + decl = gfc_add_field_to_struct_1 (&fieldlist, type, + get_identifier ("ubound"), + gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; - fieldlist = chainon (fieldlist, decl); /* Finish off the type. */ TYPE_FIELDS (type) = fieldlist; @@ -1540,7 +1534,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, static tree gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) { - tree fat_type, fieldlist, decl, arraytype; + tree fat_type, fieldlist = NULL_TREE, decl, arraytype, *chain = NULL; char name[16 + 2*GFC_RANK_DIGITS + 1 + 1]; int idx = 2 * (codimen + dimen - 1) + restricted; @@ -1555,28 +1549,23 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) TYPE_NAME (fat_type) = get_identifier (name); /* Add the data member as the first element of the descriptor. */ - decl = build_decl (input_location, - FIELD_DECL, get_identifier ("data"), - restricted ? prvoid_type_node : ptr_type_node); - - DECL_CONTEXT (decl) = fat_type; - fieldlist = decl; + decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type, + get_identifier ("data"), + (restricted + ? prvoid_type_node + : ptr_type_node), &chain); /* Add the base component. */ - decl = build_decl (input_location, - FIELD_DECL, get_identifier ("offset"), - gfc_array_index_type); - DECL_CONTEXT (decl) = fat_type; + decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type, + get_identifier ("offset"), + gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; - fieldlist = chainon (fieldlist, decl); /* Add the dtype component. */ - decl = build_decl (input_location, - FIELD_DECL, get_identifier ("dtype"), - gfc_array_index_type); - DECL_CONTEXT (decl) = fat_type; + decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type, + get_identifier ("dtype"), + gfc_array_index_type, &chain); TREE_NO_WARNING (decl) = 1; - fieldlist = chainon (fieldlist, decl); /* Build the array type for the stride and bound components. */ arraytype = @@ -1585,11 +1574,10 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) gfc_index_zero_node, gfc_rank_cst[codimen + dimen - 1])); - decl = build_decl (input_location, - FIELD_DECL, get_identifier ("dim"), arraytype); - DECL_CONTEXT (decl) = fat_type; + decl = gfc_add_field_to_struct_1 (&fieldlist, fat_type, + get_identifier ("dim"), + arraytype, &chain); TREE_NO_WARNING (decl) = 1; - fieldlist = chainon (fieldlist, decl); /* Finish off the type. */ TYPE_FIELDS (fat_type) = fieldlist; @@ -1853,26 +1841,44 @@ gfc_finish_type (tree type) } /* Add a field of given NAME and TYPE to the context of a UNION_TYPE - or RECORD_TYPE pointed to by STYPE. The new field is chained - to the fieldlist pointed to by FIELDLIST. + or RECORD_TYPE pointed to by CONTEXT. The new field is chained + to the fieldlist pointed to by FIELDLIST through *CHAIN. Returns a pointer to the new field. */ +static tree +gfc_add_field_to_struct_1 (tree *fieldlist, tree context, + tree name, tree type, tree **chain) +{ + tree decl = build_decl (input_location, FIELD_DECL, name, type); + + DECL_CONTEXT (decl) = context; + TREE_CHAIN (decl) = NULL_TREE; + if (*fieldlist == NULL_TREE) + *fieldlist = decl; + if (chain != NULL) + { + if (*chain != NULL) + **chain = decl; + *chain = &TREE_CHAIN (decl); + } + + return decl; +} + +/* Like `gfc_add_field_to_struct_1', but adds alignment + information. */ + tree gfc_add_field_to_struct (tree *fieldlist, tree context, - tree name, tree type) + tree name, tree type, tree **chain) { - tree decl; + tree decl = gfc_add_field_to_struct_1 (fieldlist, context, + name, type, chain); - decl = build_decl (input_location, - FIELD_DECL, name, type); - - DECL_CONTEXT (decl) = context; DECL_INITIAL (decl) = 0; DECL_ALIGN (decl) = 0; DECL_USER_ALIGN (decl) = 0; - TREE_CHAIN (decl) = NULL_TREE; - *fieldlist = chainon (*fieldlist, decl); return decl; } @@ -1950,6 +1956,7 @@ gfc_get_derived_type (gfc_symbol * derived) { tree typenode = NULL, field = NULL, field_type = NULL, fieldlist = NULL; tree canonical = NULL_TREE; + tree *chain = NULL; bool got_canonical = false; gfc_component *c; gfc_dt_list *dt; @@ -1975,7 +1982,7 @@ gfc_get_derived_type (gfc_symbol * derived) derived->backend_decl, get_identifier (derived->components->name), gfc_typenode_for_spec ( - &(derived->components->ts))); + &(derived->components->ts)), NULL); derived->ts.kind = gfc_index_integer_kind; derived->ts.type = BT_INTEGER; @@ -2146,7 +2153,8 @@ gfc_get_derived_type (gfc_symbol * derived) field_type = build_pointer_type (field_type); field = gfc_add_field_to_struct (&fieldlist, typenode, - get_identifier (c->name), field_type); + get_identifier (c->name), + field_type, &chain); if (c->loc.lb) gfc_set_decl_location (field, &c->loc); else if (derived->declared_at.lb) @@ -2224,8 +2232,8 @@ static tree gfc_get_mixed_entry_union (gfc_namespace *ns) { tree type; - tree decl; tree fieldlist; + tree *chain = NULL; char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_entry_list *el, *el2; @@ -2248,14 +2256,9 @@ gfc_get_mixed_entry_union (gfc_namespace *ns) break; if (el == el2) - { - decl = build_decl (input_location, - FIELD_DECL, - get_identifier (el->sym->result->name), - gfc_sym_type (el->sym->result)); - DECL_CONTEXT (decl) = type; - fieldlist = chainon (fieldlist, decl); - } + gfc_add_field_to_struct_1 (&fieldlist, type, + get_identifier (el->sym->result->name), + gfc_sym_type (el->sym->result), &chain); } /* Finish off the type. */ diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 0b96211..0949b77 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -77,7 +77,7 @@ tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int, tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool); /* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */ -tree gfc_add_field_to_struct (tree *, tree, tree, tree); +tree gfc_add_field_to_struct (tree *, tree, tree, tree, tree **); /* Layout and output debugging info for a type. */ void gfc_finish_type (tree); |