tree
gfc_build_wide_string_const (int kind, int length, const gfc_char_t *string)
{
int i;
tree str, len;
size_t size;
char *s;
i = gfc_validate_kind (BT_CHARACTER, kind, false);
size = length * gfc_character_kinds[i].bit_size / 8;
s = XCNEWVAR (char, size);
gfc_encode_character (kind, length, string, (unsigned char *) s, size);
str = build_string (size, s);
gfc_free (s);
len = build_int_cst (NULL_TREE, length);
TREE_TYPE (str) =
build_array_type (gfc_get_char_type (kind),
build_range_type (gfc_charlen_type_node,
integer_one_node, len));
return str;
}
/* Write a constant expression in binary form to a buffer. */
int
gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
size_t buffer_size)
{
if (source == NULL)
return 0;
if (source->expr_type == EXPR_ARRAY)
return encode_array (source, buffer, buffer_size);
gcc_assert (source->expr_type == EXPR_CONSTANT
|| source->expr_type == EXPR_STRUCTURE
|| source->expr_type == EXPR_SUBSTRING);
/* If we already have a target-memory representation, we use that rather
than recreating one. */
if (source->representation.string)
{
memcpy (buffer, source->representation.string,
source->representation.length);
return source->representation.length;
}
switch (source->ts.type)
{
case BT_INTEGER:
return encode_integer (source->ts.kind, source->value.integer, buffer,
buffer_size);
case BT_REAL:
return encode_float (source->ts.kind, source->value.real, buffer,
buffer_size);
case BT_COMPLEX:
return encode_complex (source->ts.kind,
#ifdef HAVE_mpc
source->value.complex,
#else
source->value.complex.r,
source->value.complex.i,
#endif
buffer, buffer_size);
case BT_LOGICAL:
return encode_logical (source->ts.kind, source->value.logical, buffer,
buffer_size);
case BT_CHARACTER:
if (source->expr_type == EXPR_CONSTANT || source->ref == NULL)
return gfc_encode_character (source->ts.kind,
source->value.character.length,
source->value.character.string,
buffer, buffer_size);
else
{
int start, end;
gcc_assert (source->expr_type == EXPR_SUBSTRING);
gfc_extract_int (source->ref->u.ss.start, &start);
gfc_extract_int (source->ref->u.ss.end, &end);
return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0),
&source->value.character.string[start-1],
buffer, buffer_size);
}
case BT_DERIVED:
return encode_derived (source, buffer, buffer_size);
default:
gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");
return 0;
}
}
