int
gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
mpfr_t real)
{
mpfr_init (real);
gfc_conv_tree_to_mpfr (real,
native_interpret_expr (gfc_get_real_type (kind),
buffer, buffer_size));
return size_float (kind);
}
size_t
gfc_target_expr_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 size_integer (e->ts.kind);
case BT_REAL:
return size_float (e->ts.kind);
case BT_COMPLEX:
return size_complex (e->ts.kind);
case BT_LOGICAL:
return size_logical (e->ts.kind);
case BT_CHARACTER:
if (e->expr_type == EXPR_SUBSTRING && e->ref)
{
int start, end;
gfc_extract_int (e->ref->u.ss.start, &start);
gfc_extract_int (e->ref->u.ss.end, &end);
return size_character (MAX(end - start + 1, 0), e->ts.kind);
}
else
return size_character (e->value.character.length, e->ts.kind);
case BT_HOLLERITH:
return e->representation.length;
case BT_DERIVED:
type = gfc_typenode_for_spec (&e->ts);
return int_size_in_bytes (type);
default:
gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
return 0;
}
}
bool
gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
{
size_t buffer_size, boz_bit_size, ts_bit_size;
int index;
unsigned char *buffer;
if (!expr->is_boz)
return true;
gcc_assert (expr->expr_type == EXPR_CONSTANT
&& expr->ts.type == BT_INTEGER);
/* Don't convert BOZ to logical, character, derived etc. */
if (ts->type == BT_REAL)
{
buffer_size = size_float (ts->kind);
ts_bit_size = buffer_size * 8;
}
else if (ts->type == BT_COMPLEX)
{
buffer_size = size_complex (ts->kind);
ts_bit_size = buffer_size * 8 / 2;
}
else
return true;
/* Convert BOZ to the smallest possible integer kind. */
boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
if (boz_bit_size > ts_bit_size)
{
gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
&expr->where, (long) boz_bit_size, (long) ts_bit_size);
return false;
}
for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
break;
expr->ts.kind = gfc_integer_kinds[index].kind;
buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
buffer = (unsigned char*)alloca (buffer_size);
encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
mpz_clear (expr->value.integer);
if (ts->type == BT_REAL)
{
mpfr_init (expr->value.real);
gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
}
else
{
#ifdef HAVE_mpc
mpc_init2 (expr->value.complex, mpfr_get_default_prec());
#else
mpfr_init (expr->value.complex.r);
mpfr_init (expr->value.complex.i);
#endif
gfc_interpret_complex (ts->kind, buffer, buffer_size,
#ifdef HAVE_mpc
expr->value.complex
#else
expr->value.complex.r, expr->value.complex.i
#endif
);
}
expr->is_boz = 0;
expr->ts.type = ts->type;
expr->ts.kind = ts->kind;
return true;
}
static size_t
size_complex (int kind)
{
return 2 * size_float (kind);
}
Int size_data(cData *data, int memory_size)
{
Int size = 0;
if (memory_size) {
size += sizeof(cData);
switch (data->type) {
case INTEGER:
case FLOAT:
case OBJNUM:
case SYMBOL:
case T_ERROR:
#ifdef USE_PARENT_OBJS
case OBJECT:
#endif
break;
case STRING:
size += string_packed_size(data->u.str, memory_size);
break;
case LIST:
size += size_list(data->u.list, memory_size);
break;
case FROB:
size += size_long(data->u.frob->cclass, memory_size);
size += size_data(&data->u.frob->rep, memory_size);
break;
case DICT:
size += size_dict(data->u.dict, memory_size);
break;
case BUFFER: {
Int i;
size += size_long(data->u.buffer->len, memory_size);
for (i = 0; i < data->u.buffer->len; i++)
size += size_long(data->u.buffer->s[i], memory_size);
break;
}
default: {
INSTANCE_RECORD(data->type, r);
size += r->size(data, memory_size);
}
}
return size;
}
size += size_long(data->type, memory_size);
switch (data->type) {
case INTEGER:
size += size_long(data->u.val, memory_size);
break;
case FLOAT:
size += size_float(data->u.fval, memory_size);
break;
case OBJNUM:
size += size_long(data->u.objnum, memory_size);
break;
case SYMBOL:
size += size_ident(data->u.symbol, memory_size);
break;
case T_ERROR:
size += size_ident(data->u.error, memory_size);
break;
case STRING:
size += string_packed_size(data->u.str, memory_size);
break;
case LIST:
size += size_list(data->u.list, memory_size);
break;
case FROB:
size += size_long(data->u.frob->cclass, memory_size);
size += size_data(&data->u.frob->rep, memory_size);
break;
case DICT:
size += size_dict(data->u.dict, memory_size);
break;
case BUFFER: {
Int i;
size += size_long(data->u.buffer->len, memory_size);
for (i = 0; i < data->u.buffer->len; i++)
size += size_long(data->u.buffer->s[i], memory_size);
break;
}
default: {
INSTANCE_RECORD(data->type, r);
size += r->size(data, memory_size);
}
}
return size;
}
