int
gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
gfc_component *cmp;
gfc_constructor *head = NULL, *tail = NULL;
int ptr;
tree type;
/* The attributes of the derived type need to be bolted to the floor. */
result->expr_type = EXPR_STRUCTURE;
type = gfc_typenode_for_spec (&result->ts);
cmp = result->ts.derived->components;
/* Run through the derived type components. */
for (;cmp; cmp = cmp->next)
{
if (head == NULL)
head = tail = gfc_get_constructor ();
else
{
tail->next = gfc_get_constructor ();
tail = tail->next;
}
/* The constructor points to the component. */
tail->n.component = cmp;
tail->expr = gfc_constant_result (cmp->ts.type, cmp->ts.kind,
&result->where);
tail->expr->ts = cmp->ts;
/* Copy shape, if needed. */
if (cmp->as && cmp->as->rank)
{
int n;
tail->expr->expr_type = EXPR_ARRAY;
tail->expr->rank = cmp->as->rank;
tail->expr->shape = gfc_get_shape (tail->expr->rank);
for (n = 0; n < tail->expr->rank; n++)
{
mpz_init_set_ui (tail->expr->shape[n], 1);
mpz_add (tail->expr->shape[n], tail->expr->shape[n],
cmp->as->upper[n]->value.integer);
mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
cmp->as->lower[n]->value.integer);
}
}
ptr = TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
tail->expr);
result->value.constructor = head;
}
return int_size_in_bytes (type);
}
static int
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
gfc_constructor_base base = NULL;
int array_size = 1;
int i;
int ptr = 0;
/* Calculate array size from its shape and rank. */
gcc_assert (result->rank > 0 && result->shape);
for (i = 0; i < result->rank; i++)
array_size *= (int)mpz_get_ui (result->shape[i]);
/* Iterate over array elements, producing constructors. */
for (i = 0; i < array_size; i++)
{
gfc_expr *e = gfc_get_constant_expr (result->ts.type, result->ts.kind,
&result->where);
e->ts = result->ts;
if (e->ts.type == BT_CHARACTER)
e->value.character.length = result->value.character.length;
gfc_constructor_append_expr (&base, e, &result->where);
ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e);
}
result->value.constructor = base;
return ptr;
}
static int
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
int array_size = 1;
int i;
int ptr = 0;
gfc_constructor *head = NULL, *tail = NULL;
/* Calculate array size from its shape and rank. */
gcc_assert (result->rank > 0 && result->shape);
for (i = 0; i < result->rank; i++)
array_size *= (int)mpz_get_ui (result->shape[i]);
/* Iterate over array elements, producing constructors. */
for (i = 0; i < array_size; i++)
{
if (head == NULL)
head = tail = gfc_get_constructor ();
else
{
tail->next = gfc_get_constructor ();
tail = tail->next;
}
tail->where = result->where;
tail->expr = gfc_constant_result (result->ts.type,
result->ts.kind, &result->where);
tail->expr->ts = result->ts;
if (tail->expr->ts.type == BT_CHARACTER)
tail->expr->value.character.length = result->value.character.length;
ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
tail->expr);
}
result->value.constructor = head;
return ptr;
}
int
gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
gfc_component *cmp;
gfc_constructor *head = NULL, *tail = NULL;
int ptr;
tree type;
/* The attributes of the derived type need to be bolted to the floor. */
result->expr_type = EXPR_STRUCTURE;
type = gfc_typenode_for_spec (&result->ts);
cmp = result->ts.u.derived->components;
/* Run through the derived type components. */
for (;cmp; cmp = cmp->next)
{
if (head == NULL)
head = tail = gfc_get_constructor ();
else
{
tail->next = gfc_get_constructor ();
tail = tail->next;
}
/* The constructor points to the component. */
tail->n.component = cmp;
tail->expr = gfc_constant_result (cmp->ts.type, cmp->ts.kind,
&result->where);
tail->expr->ts = cmp->ts;
/* Copy shape, if needed. */
if (cmp->as && cmp->as->rank)
{
int n;
tail->expr->expr_type = EXPR_ARRAY;
tail->expr->rank = cmp->as->rank;
tail->expr->shape = gfc_get_shape (tail->expr->rank);
for (n = 0; n < tail->expr->rank; n++)
{
mpz_init_set_ui (tail->expr->shape[n], 1);
mpz_add (tail->expr->shape[n], tail->expr->shape[n],
cmp->as->upper[n]->value.integer);
mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
cmp->as->lower[n]->value.integer);
}
}
/* Calculate the offset, which consists of the the FIELD_OFFSET in
bytes, which appears in multiples of DECL_OFFSET_ALIGN-bit-sized,
and additional bits of FIELD_BIT_OFFSET. The code assumes that all
sizes of the components are multiples of BITS_PER_UNIT,
i.e. there are, e.g., no bit fields. */
ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl));
gcc_assert (ptr % 8 == 0);
ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
tail->expr);
result->value.constructor = head;
}
return int_size_in_bytes (type);
}
