/* Simulate storage of variables into target memory.
- Copyright (C) 2007
- 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 "config.h"
#include "system.h"
+#include "coretypes.h"
#include "flags.h"
#include "machmode.h"
#include "tree.h"
+#include "stor-layout.h"
#include "gfortran.h"
#include "arith.h"
+#include "constructor.h"
#include "trans.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;
- size_t elt_size = gfc_target_expr_size (e->value.constructor->expr);
-
- gfc_array_size (e, &array_size);
- return (size_t)mpz_get_ui (array_size) * elt_size;
-}
static size_t
size_integer (int kind)
static size_t
-size_character (int length)
+size_character (int length, int kind)
{
- return length;
+ int i = gfc_validate_kind (BT_CHARACTER, kind, false);
+ return length * gfc_character_kinds[i].bit_size / 8;
}
+/* 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:
case BT_LOGICAL:
return size_logical (e->ts.kind);
case BT_CHARACTER:
- return size_character (e->value.character.length);
+ if (e->expr_type == EXPR_CONSTANT)
+ return size_character (e->value.character.length, e->ts.kind);
+ else if (e->ts.u.cl != NULL && e->ts.u.cl->length != NULL
+ && e->ts.u.cl->length->expr_type == EXPR_CONSTANT
+ && e->ts.u.cl->length->ts.type == BT_INTEGER)
+ {
+ int length;
+
+ gfc_extract_int (e->ts.u.cl->length, &length);
+ return size_character (length, e->ts.kind);
+ }
+ else
+ return 0;
+
case BT_HOLLERITH:
return e->representation.length;
case BT_DERIVED:
- type = gfc_typenode_for_spec (&e->ts);
- return int_size_in_bytes (type);
+ case BT_CLASS:
+ case BT_VOID:
+ case BT_ASSUMED:
+ {
+ /* Determine type size without clobbering the typespec for ISO C
+ binding types. */
+ gfc_typespec ts;
+ HOST_WIDE_INT size;
+ ts = e->ts;
+ type = gfc_typenode_for_spec (&ts);
+ size = int_size_in_bytes (type);
+ gcc_assert (size >= 0);
+ 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. */
-static int
+static unsigned HOST_WIDE_INT
encode_array (gfc_expr *expr, unsigned char *buffer, size_t buffer_size)
{
mpz_t array_size;
int i;
int ptr = 0;
+ gfc_constructor_base ctor = expr->value.constructor;
+
gfc_array_size (expr, &array_size);
for (i = 0; i < (int)mpz_get_ui (array_size); i++)
{
- ptr += gfc_target_encode_expr (gfc_get_array_element (expr, i),
+ ptr += gfc_target_encode_expr (gfc_constructor_lookup_expr (ctor, i),
&buffer[ptr], buffer_size - ptr);
}
static int
encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
{
- return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind), buffer,
+ return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind, 0), buffer,
buffer_size);
}
static int
-encode_complex (int kind, mpfr_t real, mpfr_t imaginary, unsigned char *buffer,
- size_t buffer_size)
+encode_complex (int kind, mpc_t cmplx,
+ unsigned char *buffer, size_t buffer_size)
{
int size;
- size = encode_float (kind, real, &buffer[0], buffer_size);
- size += encode_float (kind, imaginary, &buffer[size], buffer_size - size);
+ size = encode_float (kind, mpc_realref (cmplx), &buffer[0], buffer_size);
+ size += encode_float (kind, mpc_imagref (cmplx),
+ &buffer[size], buffer_size - size);
return size;
}
}
-static int
-encode_character (int length, char *string, unsigned char *buffer,
- size_t buffer_size)
+int
+gfc_encode_character (int kind, int length, const gfc_char_t *string,
+ unsigned char *buffer, size_t buffer_size)
{
- gcc_assert (buffer_size >= size_character (length));
- memcpy (buffer, string, length);
+ 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
+static unsigned HOST_WIDE_INT
encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
{
- gfc_constructor *ctr;
+ gfc_constructor *c;
gfc_component *cmp;
int ptr;
tree type;
+ HOST_WIDE_INT size;
type = gfc_typenode_for_spec (&source->ts);
- ctr = source->value.constructor;
- cmp = source->ts.derived->components;
- for (;ctr; ctr = ctr->next, cmp = cmp->next)
+ for (c = gfc_constructor_first (source->value.constructor),
+ cmp = source->ts.u.derived->components;
+ c;
+ c = gfc_constructor_next (c), cmp = cmp->next)
{
gcc_assert (cmp);
- if (!ctr->expr)
+ if (!c->expr)
continue;
ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+ TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
- gfc_target_encode_expr (ctr->expr, &buffer[ptr],
- buffer_size - ptr);
+
+ if (c->expr->expr_type == EXPR_NULL)
+ {
+ size = int_size_in_bytes (TREE_TYPE (cmp->backend_decl));
+ gcc_assert (size >= 0);
+ memset (&buffer[ptr], 0, size);
+ }
+ else
+ gfc_target_encode_expr (c->expr, &buffer[ptr],
+ buffer_size - ptr);
}
- return int_size_in_bytes (type);
+ size = int_size_in_bytes (type);
+ gcc_assert (size >= 0);
+ return size;
}
/* Write a constant expression in binary form to a buffer. */
-int
+unsigned HOST_WIDE_INT
gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
size_t buffer_size)
{
return encode_array (source, buffer, buffer_size);
gcc_assert (source->expr_type == EXPR_CONSTANT
- || source->expr_type == EXPR_STRUCTURE);
+ || 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)
{
return encode_float (source->ts.kind, source->value.real, buffer,
buffer_size);
case BT_COMPLEX:
- return encode_complex (source->ts.kind, source->value.complex.r,
- source->value.complex.i, buffer, buffer_size);
+ return encode_complex (source->ts.kind, source->value.complex,
+ buffer, buffer_size);
case BT_LOGICAL:
return encode_logical (source->ts.kind, source->value.logical, buffer,
buffer_size);
case BT_CHARACTER:
- return encode_character (source->value.character.length,
- source->value.character.string, buffer,
- buffer_size);
+ 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:
+ 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.");
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;
- gfc_constructor *head = NULL, *tail = NULL;
/* Calculate array size from its shape and rank. */
gcc_assert (result->rank > 0 && result->shape);
/* 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;
- }
+ gfc_expr *e = gfc_get_constant_expr (result->ts.type, result->ts.kind,
+ &result->where);
+ e->ts = result->ts;
- tail->where = result->where;
- tail->expr = gfc_constant_result (result->ts.type,
- result->ts.kind, &result->where);
- tail->expr->ts = result->ts;
+ if (e->ts.type == BT_CHARACTER)
+ e->value.character.length = result->value.character.length;
- if (tail->expr->ts.type == BT_CHARACTER)
- tail->expr->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,
- tail->expr);
+ ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e,
+ true);
}
- result->value.constructor = head;
+ result->value.constructor = base;
return ptr;
}
int
gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
- mpfr_t real)
+ mpfr_t real)
{
+ gfc_set_model_kind (kind);
mpfr_init (real);
gfc_conv_tree_to_mpfr (real,
native_interpret_expr (gfc_get_real_type (kind),
int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
- mpfr_t real, mpfr_t imaginary)
+ mpc_t complex)
{
int size;
- size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
- size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary);
+ size = gfc_interpret_float (kind, &buffer[0], buffer_size,
+ mpc_realref (complex));
+ size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
+ mpc_imagref (complex));
return size;
}
{
tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
buffer_size);
- *logical = double_int_zero_p (tree_to_double_int (t))
- ? 0 : 1;
+ *logical = wi::eq_p (t, 0) ? 0 : 1;
return size_logical (kind);
}
int
-gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
+ gfc_expr *result)
{
- if (result->ts.cl && result->ts.cl->length)
+ int i;
+
+ if (result->ts.u.cl && result->ts.u.cl->length)
result->value.character.length =
- (int)mpz_get_ui (result->ts.cl->length->value.integer);
+ (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
- gcc_assert (buffer_size >= size_character (result->value.character.length));
+ gcc_assert (buffer_size >= size_character (result->value.character.length,
+ result->ts.kind));
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';
+ 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;
}
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;
+ cmp = result->ts.u.derived->components;
+
+ if (result->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
+ && (result->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
+ || result->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
+ {
+ gfc_constructor *c;
+ gfc_expr *e;
+ /* 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);
+ c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+ c->n.component = cmp;
+ gfc_target_interpret_expr (buffer, buffer_size, e, true);
+ e->ts.is_iso_c = 1;
+ return int_size_in_bytes (ptr_type_node);
+ }
+
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;
+ gfc_constructor *c;
+ gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind,
+ &result->where);
+ e->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;
+ e->expr_type = EXPR_ARRAY;
+ e->rank = cmp->as->rank;
- tail->expr->shape = gfc_get_shape (tail->expr->rank);
- for (n = 0; n < tail->expr->rank; n++)
+ e->shape = gfc_get_shape (e->rank);
+ for (n = 0; n < e->rank; n++)
{
- mpz_init_set_ui (tail->expr->shape[n], 1);
- mpz_add (tail->expr->shape[n], tail->expr->shape[n],
+ mpz_init_set_ui (e->shape[n], 1);
+ mpz_add (e->shape[n], e->shape[n],
cmp->as->upper[n]->value.integer);
- mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
+ mpz_sub (e->shape[n], e->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);
+ c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+
+ /* The constructor points to the component. */
+ c->n.component = cmp;
+
+ /* Calculate the offset, which consists of 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. */
- result->value.constructor = head;
+ gcc_assert (cmp->backend_decl);
+ 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, e, true);
}
-
+
return int_size_in_bytes (type);
}
/* Read a binary buffer to a constant expression. */
int
gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
- gfc_expr *result)
+ gfc_expr *result, bool convert_widechar)
{
if (result->expr_type == EXPR_ARRAY)
return interpret_array (buffer, buffer_size, result);
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.r,
- result->value.complex.i);
+ 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;
+ case BT_CLASS:
+ 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;
default:
break;
}
- if (result->ts.type == BT_CHARACTER)
- result->representation.string = result->value.character.string;
+ if (result->ts.type == BT_CHARACTER && convert_widechar)
+ result->representation.string
+ = gfc_widechar_to_char (result->value.character.string,
+ result->value.character.length);
else
{
result->representation.string =
- gfc_getmem (result->representation.length + 1);
+ XCNEWVEC (char, result->representation.length + 1);
memcpy (result->representation.string, buffer,
result->representation.length);
result->representation.string[result->representation.length] = '\0';
}
-/* --------------------------------------------------------------- */
+/* --------------------------------------------------------------- */
/* 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. */
{
int i;
int ptr;
- gfc_constructor *ctr;
+ gfc_constructor *c;
gfc_component *cmp;
unsigned char *buffer;
declaration. */
if (e->ts.type == BT_DERIVED)
{
- ctr = e->value.constructor;
- cmp = e->ts.derived->components;
- for (;ctr; ctr = ctr->next, cmp = cmp->next)
+ for (c = gfc_constructor_first (e->value.constructor),
+ cmp = e->ts.u.derived->components;
+ c; c = gfc_constructor_next (c), cmp = cmp->next)
{
gcc_assert (cmp && cmp->backend_decl);
- if (!ctr->expr)
+ if (!c->expr)
continue;
ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+ TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
- expr_to_char (ctr->expr, &data[ptr], &chk[ptr], len);
+ expr_to_char (c->expr, &data[ptr], &chk[ptr], len);
}
return len;
}
break;
case EXPR_ARRAY:
- for (c = e->value.constructor; c; c = c->next)
+ for (c = gfc_constructor_first (e->value.constructor);
+ c; c = gfc_constructor_next (c))
{
size_t elt_size = gfc_target_expr_size (c->expr);
- if (c->n.offset)
- len = elt_size * (size_t)mpz_get_si (c->n.offset);
+ if (mpz_cmp_si (c->offset, 0) != 0)
+ len = elt_size * (size_t)mpz_get_si (c->offset);
len = len + gfc_merge_initializers (ts, c->expr, &data[len],
&chk[len], length - len);
return len;
}
+
+
+/* Transfer the bitpattern of a (integer) BOZ to real or complex variables.
+ When successful, no BOZ or nothing to do, true is returned. */
+
+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
+ {
+ mpc_init2 (expr->value.complex, mpfr_get_default_prec());
+ gfc_interpret_complex (ts->kind, buffer, buffer_size,
+ expr->value.complex);
+ }
+ expr->is_boz = 0;
+ expr->ts.type = ts->type;
+ expr->ts.kind = ts->kind;
+
+ return true;
+}
projects / thirdparty / gcc.git / blobdiff