/* Simulate storage of variables into target memory.
- Copyright (C) 2007, 2008, 2009, 2010
- Free Software Foundation, Inc.
+ Copyright (C) 2007-2013 Free Software Foundation, Inc.
Contributed by Paul Thomas and Brooks Moses
This file is part of GCC.
#include "flags.h"
#include "machmode.h"
#include "tree.h"
+#include "stor-layout.h"
#include "gfortran.h"
#include "arith.h"
#include "constructor.h"
#include "trans-const.h"
#include "trans-types.h"
#include "target-memory.h"
+#include "wide-int.h"
-/* --------------------------------------------------------------- */
+/* --------------------------------------------------------------- */
/* Calculate the size of an expression. */
-static size_t
-size_array (gfc_expr *e)
-{
- mpz_t array_size;
- gfc_constructor *c = gfc_constructor_first (e->value.constructor);
- size_t elt_size = gfc_target_expr_size (c->expr);
-
- gfc_array_size (e, &array_size);
- return (size_t)mpz_get_ui (array_size) * elt_size;
-}
static size_t
size_integer (int kind)
}
+/* Return the size of a single element of the given expression.
+ Identical to gfc_target_expr_size for scalars. */
+
size_t
-gfc_target_expr_size (gfc_expr *e)
+gfc_element_size (gfc_expr *e)
{
tree type;
- gcc_assert (e != NULL);
-
- if (e->expr_type == EXPR_ARRAY)
- return size_array (e);
-
switch (e->ts.type)
{
case BT_INTEGER:
return e->representation.length;
case BT_DERIVED:
case BT_CLASS:
+ case BT_VOID:
+ case BT_ASSUMED:
{
/* Determine type size without clobbering the typespec for ISO C
binding types. */
return size;
}
default:
- gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
+ gfc_internal_error ("Invalid expression in gfc_element_size.");
return 0;
}
}
-/* The encode_* functions export a value into a buffer, and
+/* Return the size of an expression in its target representation. */
+
+size_t
+gfc_target_expr_size (gfc_expr *e)
+{
+ mpz_t tmp;
+ size_t asz;
+
+ gcc_assert (e != NULL);
+
+ if (e->rank)
+ {
+ if (gfc_array_size (e, &tmp))
+ asz = mpz_get_ui (tmp);
+ else
+ asz = 0;
+ }
+ else
+ asz = 1;
+
+ return asz * gfc_element_size (e);
+}
+
+
+/* The encode_* functions export a value into a buffer, and
return the number of bytes of the buffer that have been
used. */
|| source->expr_type == EXPR_STRUCTURE
|| source->expr_type == EXPR_SUBSTRING);
- /* If we already have a target-memory representation, we use that rather
+ /* If we already have a target-memory representation, we use that rather
than recreating one. */
if (source->representation.string)
{
}
case BT_DERIVED:
+ if (source->ts.u.derived->ts.f90_type == BT_VOID)
+ {
+ gfc_constructor *c;
+ gcc_assert (source->expr_type == EXPR_STRUCTURE);
+ c = gfc_constructor_first (source->value.constructor);
+ gcc_assert (c->expr->expr_type == EXPR_CONSTANT
+ && c->expr->ts.type == BT_INTEGER);
+ return encode_integer (gfc_index_integer_kind, c->expr->value.integer,
+ buffer, buffer_size);
+ }
+
return encode_derived (source, buffer, buffer_size);
default:
gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");
{
tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
buffer_size);
- *logical = tree_to_double_int (t).is_zero () ? 0 : 1;
+ *logical = wi::eq_p (t, 0) ? 0 : 1;
return size_logical (kind);
}
/* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec
sets this to BT_INTEGER. */
result->ts.type = BT_DERIVED;
- e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where);
+ e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where);
c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
c->n.component = cmp;
gfc_target_interpret_expr (buffer, buffer_size, e, true);
{
gfc_constructor *c;
gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind,
- &result->where);
+ &result->where);
e->ts = cmp->ts;
/* Copy shape, if needed. */
gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e, true);
}
-
+
return int_size_in_bytes (type);
}
switch (result->ts.type)
{
case BT_INTEGER:
- result->representation.length =
+ result->representation.length =
gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
result->value.integer);
break;
case BT_REAL:
- result->representation.length =
+ result->representation.length =
gfc_interpret_float (result->ts.kind, buffer, buffer_size,
result->value.real);
break;
case BT_COMPLEX:
- result->representation.length =
+ result->representation.length =
gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
result->value.complex);
break;
case BT_LOGICAL:
- result->representation.length =
+ result->representation.length =
gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
&result->value.logical);
break;
case BT_CHARACTER:
- result->representation.length =
+ result->representation.length =
gfc_interpret_character (buffer, buffer_size, result);
break;
result->ts = CLASS_DATA (result)->ts;
/* Fall through. */
case BT_DERIVED:
- result->representation.length =
+ result->representation.length =
gfc_interpret_derived (buffer, buffer_size, result);
gcc_assert (result->representation.length >= 0);
break;
}
-/* --------------------------------------------------------------- */
+/* --------------------------------------------------------------- */
/* Two functions used by trans-common.c to write overlapping
equivalence initializers to a buffer. This is added to the union
and the original initializers freed. */
gfc_interpret_complex (ts->kind, buffer, buffer_size,
expr->value.complex);
}
- expr->is_boz = 0;
+ expr->is_boz = 0;
expr->ts.type = ts->type;
expr->ts.kind = ts->kind;
projects / thirdparty / gcc.git / blobdiff