int
gfc_encode_character (int kind, int length, const gfc_char_t *string,
unsigned char *buffer, size_t buffer_size)
{
size_t elsize = size_character (1, kind);
tree type = gfc_get_char_type (kind);
int i;
gcc_assert (buffer_size >= size_character (length, kind));
for (i = 0; i < length; i++)
native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
elsize);
return length;
}
static int
encode_character (int length, char *string, unsigned char *buffer,
size_t buffer_size)
{
gcc_assert (buffer_size >= size_character (length));
memcpy (buffer, string, length);
return length;
}
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;
}
}
int
gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
gfc_expr *result)
{
int i;
if (result->ts.cl && result->ts.cl->length)
result->value.character.length =
(int) mpz_get_ui (result->ts.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length,
result->ts.kind));
result->value.character.string =
gfc_get_wide_string (result->value.character.length + 1);
if (result->ts.kind == gfc_default_character_kind)
for (i = 0; i < result->value.character.length; i++)
result->value.character.string[i] = (gfc_char_t) buffer[i];
else
{
mpz_t integer;
unsigned bytes = size_character (1, result->ts.kind);
mpz_init (integer);
gcc_assert (bytes <= sizeof (unsigned long));
for (i = 0; i < result->value.character.length; i++)
{
gfc_conv_tree_to_mpz (integer,
native_interpret_expr (gfc_get_char_type (result->ts.kind),
&buffer[bytes*i], buffer_size-bytes*i));
result->value.character.string[i]
= (gfc_char_t) mpz_get_ui (integer);
}
mpz_clear (integer);
}
result->value.character.string[result->value.character.length] = '\0';
return result->value.character.length;
}
int
gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
if (result->ts.cl && result->ts.cl->length)
result->value.character.length =
(int)mpz_get_ui (result->ts.cl->length->value.integer);
gcc_assert (buffer_size >= size_character (result->value.character.length));
result->value.character.string =
gfc_getmem (result->value.character.length + 1);
memcpy (result->value.character.string, buffer,
result->value.character.length);
result->value.character.string [result->value.character.length] = '\0';
return result->value.character.length;
}