Commit dcfef7d4 by Tobias Schlüter

trans-types.h (gfc_packed): New enum.

* trans-types.h (gfc_packed): New enum.
(gfc_get_nodesc_array_type): Change prototype to use new enum.
* trans-types.c (gfc_get_nodesc_array): Use gfc_packed for
argument packed.  Adapt all references to values accordingly.
(gfc_sym_type): Use enum values in call to gfc_get_nodesc_array.
(gfc_get_derived_type): Likewise.
* trans-array.c (gfc_build_constant_array_constructor): Likewise.
* trans-expr.c (gfc_get_interface_mapping_charlen): Changed packed
argument to type gfc_packed.
(gfc_add_interface_mapping): Use enum values in call to
gfc_get_interface_mapping.
* trans-decl.c (gfc_build_dummy_array_decl): Adapt to use enum
values when determining packing.

From-SVN: r123924
parent f01ec37d
2007-04-17 Tobias Schlter <tobi@gcc.gnu.org>
* trans-types.h (gfc_packed): New enum.
(gfc_get_nodesc_array_type): Change prototype to use new enum.
* trans-types.c (gfc_get_nodesc_array): Use gfc_packed for
argument packed. Adapt all references to values accordingly.
(gfc_sym_type): Use enum values in call to gfc_get_nodesc_array.
(gfc_get_derived_type): Likewise.
* trans-array.c (gfc_build_constant_array_constructor): Likewise.
* trans-expr.c (gfc_get_interface_mapping_charlen): Changed packed
argument to type gfc_packed.
(gfc_add_interface_mapping): Use enum values in call to
gfc_get_interface_mapping.
* trans-decl.c (gfc_build_dummy_array_decl): Adapt to use enum
values when determining packing.
* arith.h: Update copyright years.
* dependency.h: Likewise.
* gfortran.h: Likewise.
......
......@@ -1493,7 +1493,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
as.upper[i] = gfc_int_expr (tmp - 1);
}
tmptype = gfc_get_nodesc_array_type (type, &as, 3);
tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC);
init = build_constructor_from_list (tmptype, nreverse (list));
......
......@@ -664,7 +664,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
tree type;
gfc_array_spec *as;
char *name;
int packed;
gfc_packed packed;
int n;
bool known_size;
......@@ -697,28 +697,28 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
{
/* Create a descriptorless array pointer. */
as = sym->as;
packed = 0;
packed = PACKED_NO;
if (!gfc_option.flag_repack_arrays)
{
if (as->type == AS_ASSUMED_SIZE)
packed = 2;
packed = PACKED_FULL;
}
else
{
if (as->type == AS_EXPLICIT)
{
packed = 2;
packed = PACKED_FULL;
for (n = 0; n < as->rank; n++)
{
if (!(as->upper[n]
&& as->lower[n]
&& as->upper[n]->expr_type == EXPR_CONSTANT
&& as->lower[n]->expr_type == EXPR_CONSTANT))
packed = 1;
packed = PACKED_PARTIAL;
}
}
else
packed = 1;
packed = PACKED_PARTIAL;
}
type = gfc_typenode_for_spec (&sym->ts);
......@@ -732,7 +732,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
DECL_ARTIFICIAL (sym->backend_decl) = 1;
sym->backend_decl = NULL_TREE;
type = gfc_sym_type (sym);
packed = 2;
packed = PACKED_FULL;
}
ASM_FORMAT_PRIVATE_NAME (name, IDENTIFIER_POINTER (DECL_NAME (dummy)), 0);
......@@ -747,16 +747,10 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
frontend bugs. */
gcc_assert (sym->as->type != AS_DEFERRED);
switch (packed)
{
case 1:
GFC_DECL_PARTIAL_PACKED_ARRAY (decl) = 1;
break;
case 2:
GFC_DECL_PACKED_ARRAY (decl) = 1;
break;
}
if (packed == PACKED_PARTIAL)
GFC_DECL_PARTIAL_PACKED_ARRAY (decl) = 1;
else if (packed == PACKED_FULL)
GFC_DECL_PACKED_ARRAY (decl) = 1;
gfc_build_qualified_array (decl, sym);
......
......@@ -1348,7 +1348,7 @@ gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping,
static tree
gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
int packed, tree data)
gfc_packed packed, tree data)
{
tree type;
tree var;
......@@ -1500,14 +1500,16 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping,
/* Create the replacement variable. */
tmp = gfc_conv_descriptor_data_get (desc);
value = gfc_get_interface_mapping_array (&se->pre, sym, 0, tmp);
value = gfc_get_interface_mapping_array (&se->pre, sym,
PACKED_NO, tmp);
/* Use DESC to work out the upper bounds, strides and offset. */
gfc_set_interface_mapping_bounds (&se->pre, TREE_TYPE (value), desc);
}
else
/* Otherwise we have a packed array. */
value = gfc_get_interface_mapping_array (&se->pre, sym, 2, se->expr);
value = gfc_get_interface_mapping_array (&se->pre, sym,
PACKED_FULL, se->expr);
new_sym->backend_decl = value;
}
......
......@@ -1006,11 +1006,11 @@ gfc_get_dtype (tree type)
}
/* Build an array type for use without a descriptor. Valid values of packed
are 0=no, 1=partial, 2=full, 3=static. */
/* Build an array type for use without a descriptor, packed according
to the value of PACKED. */
tree
gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
{
tree range;
tree type;
......@@ -1036,7 +1036,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
TYPE_LANG_SPECIFIC (type) = (struct lang_type *)
ggc_alloc_cleared (sizeof (struct lang_type));
known_stride = (packed != 0);
known_stride = (packed != PACKED_NO);
known_offset = 1;
for (n = 0; n < as->rank; n++)
{
......@@ -1092,7 +1092,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
}
/* Only the first stride is known for partial packed arrays. */
if (packed < 2)
if (packed == PACKED_NO || packed == PACKED_PARTIAL)
known_stride = 0;
}
......@@ -1140,7 +1140,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
mpz_clear (stride);
mpz_clear (delta);
if (packed < 3 || !known_stride)
if (packed != PACKED_STATIC || !known_stride)
{
/* For dummy arrays and automatic (heap allocated) arrays we
want a pointer to the array. */
......@@ -1350,7 +1350,8 @@ gfc_sym_type (gfc_symbol * sym)
|| sym->ts.cl->backend_decl)
{
type = gfc_get_nodesc_array_type (type, sym->as,
byref ? 2 : 3);
byref ? PACKED_FULL
: PACKED_STATIC);
byref = 0;
}
}
......@@ -1538,7 +1539,8 @@ gfc_get_derived_type (gfc_symbol * derived)
field_type = gfc_build_array_type (field_type, c->as);
}
else
field_type = gfc_get_nodesc_array_type (field_type, c->as, 3);
field_type = gfc_get_nodesc_array_type (field_type, c->as,
PACKED_STATIC);
}
else if (c->pointer)
field_type = build_pointer_type (field_type);
......
......@@ -54,6 +54,13 @@ extern GTY(()) tree pchar_type_node;
and runtime library. */
extern GTY(()) tree gfc_charlen_type_node;
typedef enum {
PACKED_NO = 0,
PACKED_PARTIAL,
PACKED_FULL,
PACKED_STATIC
} gfc_packed;
/* be-function.c */
void gfc_convert_function_code (gfc_namespace *);
......@@ -80,7 +87,7 @@ tree gfc_signed_type (tree);
tree gfc_get_element_type (tree);
tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int);
tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, int);
tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed);
/* 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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment