summaryrefslogtreecommitdiff
path: root/gcc/fortran/target-memory.c
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/fortran/target-memory.c
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/fortran/target-memory.c')
-rw-r--r--gcc/fortran/target-memory.c752
1 files changed, 752 insertions, 0 deletions
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
new file mode 100644
index 000000000..0a09f5a5e
--- /dev/null
+++ b/gcc/fortran/target-memory.c
@@ -0,0 +1,752 @@
+/* Simulate storage of variables into target memory.
+ Copyright (C) 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
+ Contributed by Paul Thomas and Brooks Moses
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "machmode.h"
+#include "tree.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"
+
+/* --------------------------------------------------------------- */
+/* Calculate the size of an expression. */
+
+static size_t
+size_array (gfc_expr *e)
+{
+ mpz_t array_size;
+ gfc_constructor *c = gfc_constructor_first (e->value.constructor);
+ size_t elt_size = gfc_target_expr_size (c->expr);
+
+ gfc_array_size (e, &array_size);
+ return (size_t)mpz_get_ui (array_size) * elt_size;
+}
+
+static size_t
+size_integer (int kind)
+{
+ return GET_MODE_SIZE (TYPE_MODE (gfc_get_int_type (kind)));;
+}
+
+
+static size_t
+size_float (int kind)
+{
+ return GET_MODE_SIZE (TYPE_MODE (gfc_get_real_type (kind)));;
+}
+
+
+static size_t
+size_complex (int kind)
+{
+ return 2 * size_float (kind);
+}
+
+
+static size_t
+size_logical (int kind)
+{
+ return GET_MODE_SIZE (TYPE_MODE (gfc_get_logical_type (kind)));;
+}
+
+
+static size_t
+size_character (int length, int kind)
+{
+ int i = gfc_validate_kind (BT_CHARACTER, kind, false);
+ return length * gfc_character_kinds[i].bit_size / 8;
+}
+
+
+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;
+ }
+}
+
+
+/* The encode_* functions export a value into a buffer, and
+ return the number of bytes of the buffer that have been
+ used. */
+
+static 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_constructor_lookup_expr (ctor, i),
+ &buffer[ptr], buffer_size - ptr);
+ }
+
+ mpz_clear (array_size);
+ return ptr;
+}
+
+
+static int
+encode_integer (int kind, mpz_t integer, unsigned char *buffer,
+ size_t buffer_size)
+{
+ return native_encode_expr (gfc_conv_mpz_to_tree (integer, kind),
+ buffer, buffer_size);
+}
+
+
+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, 0), buffer,
+ buffer_size);
+}
+
+
+static int
+encode_complex (int kind, mpc_t cmplx,
+ unsigned char *buffer, size_t buffer_size)
+{
+ int 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_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size)
+{
+ return native_encode_expr (build_int_cst (gfc_get_logical_type (kind),
+ logical),
+ buffer, buffer_size);
+}
+
+
+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_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
+{
+ gfc_constructor *c;
+ gfc_component *cmp;
+ int ptr;
+ tree type;
+
+ type = gfc_typenode_for_spec (&source->ts);
+
+ 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 (!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;
+
+ if (c->expr->expr_type == EXPR_NULL)
+ memset (&buffer[ptr], 0,
+ int_size_in_bytes (TREE_TYPE (cmp->backend_decl)));
+ else
+ gfc_target_encode_expr (c->expr, &buffer[ptr],
+ buffer_size - ptr);
+ }
+
+ return int_size_in_bytes (type);
+}
+
+
+/* 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, source->value.complex,
+ 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;
+ }
+}
+
+
+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;
+}
+
+
+int
+gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
+ mpz_t integer)
+{
+ mpz_init (integer);
+ gfc_conv_tree_to_mpz (integer,
+ native_interpret_expr (gfc_get_int_type (kind),
+ buffer, buffer_size));
+ return size_integer (kind);
+}
+
+
+int
+gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
+ 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),
+ buffer, buffer_size));
+
+ return size_float (kind);
+}
+
+
+int
+gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
+ mpc_t complex)
+{
+ int size;
+ 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;
+}
+
+
+int
+gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
+ int *logical)
+{
+ 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;
+ return size_logical (kind);
+}
+
+
+int
+gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
+ gfc_expr *result)
+{
+ int i;
+
+ if (result->ts.u.cl && result->ts.u.cl->length)
+ result->value.character.length =
+ (int) mpz_get_ui (result->ts.u.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_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+{
+ gfc_component *cmp;
+ 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);
+ e->ts.is_iso_c = 1;
+ return int_size_in_bytes (ptr_type_node);
+ }
+
+ type = gfc_typenode_for_spec (&result->ts);
+
+ /* Run through the derived type components. */
+ for (;cmp; cmp = cmp->next)
+ {
+ 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;
+
+ e->expr_type = EXPR_ARRAY;
+ e->rank = cmp->as->rank;
+
+ e->shape = gfc_get_shape (e->rank);
+ for (n = 0; n < e->rank; 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 (e->shape[n], e->shape[n],
+ cmp->as->lower[n]->value.integer);
+ }
+ }
+
+ 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 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. */
+
+ 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);
+ }
+
+ 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)
+{
+ if (result->expr_type == EXPR_ARRAY)
+ return interpret_array (buffer, buffer_size, result);
+
+ switch (result->ts.type)
+ {
+ case BT_INTEGER:
+ result->representation.length =
+ gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
+ result->value.integer);
+ break;
+
+ case BT_REAL:
+ result->representation.length =
+ gfc_interpret_float (result->ts.kind, buffer, buffer_size,
+ result->value.real);
+ break;
+
+ case BT_COMPLEX:
+ result->representation.length =
+ gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
+ result->value.complex);
+ break;
+
+ case BT_LOGICAL:
+ result->representation.length =
+ gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
+ &result->value.logical);
+ break;
+
+ case BT_CHARACTER:
+ result->representation.length =
+ gfc_interpret_character (buffer, buffer_size, result);
+ break;
+
+ case BT_DERIVED:
+ result->representation.length =
+ gfc_interpret_derived (buffer, buffer_size, result);
+ break;
+
+ default:
+ gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
+ break;
+ }
+
+ if (result->ts.type == BT_CHARACTER)
+ result->representation.string
+ = gfc_widechar_to_char (result->value.character.string,
+ result->value.character.length);
+ else
+ {
+ result->representation.string =
+ (char *) gfc_getmem (result->representation.length + 1);
+ memcpy (result->representation.string, buffer,
+ result->representation.length);
+ result->representation.string[result->representation.length] = '\0';
+ }
+
+ return result->representation.length;
+}
+
+
+/* --------------------------------------------------------------- */
+/* 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. */
+
+
+/* Writes the values of a constant expression to a char buffer. If another
+ unequal initializer has already been written to the buffer, this is an
+ error. */
+
+static size_t
+expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
+{
+ int i;
+ int ptr;
+ gfc_constructor *c;
+ gfc_component *cmp;
+ unsigned char *buffer;
+
+ if (e == NULL)
+ return 0;
+
+ /* Take a derived type, one component at a time, using the offsets from the backend
+ declaration. */
+ if (e->ts.type == BT_DERIVED)
+ {
+ 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 (!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 (c->expr, &data[ptr], &chk[ptr], len);
+ }
+ return len;
+ }
+
+ /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate
+ to the target, in a buffer and check off the initialized part of the buffer. */
+ len = gfc_target_expr_size (e);
+ buffer = (unsigned char*)alloca (len);
+ len = gfc_target_encode_expr (e, buffer, len);
+
+ for (i = 0; i < (int)len; i++)
+ {
+ if (chk[i] && (buffer[i] != data[i]))
+ {
+ gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
+ "at %L", &e->where);
+ return 0;
+ }
+ chk[i] = 0xFF;
+ }
+
+ memcpy (data, buffer, len);
+ return len;
+}
+
+
+/* Writes the values from the equivalence initializers to a char* array
+ that will be written to the constructor to make the initializer for
+ the union declaration. */
+
+size_t
+gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
+ unsigned char *chk, size_t length)
+{
+ size_t len = 0;
+ gfc_constructor * c;
+
+ switch (e->expr_type)
+ {
+ case EXPR_CONSTANT:
+ case EXPR_STRUCTURE:
+ len = expr_to_char (e, &data[0], &chk[0], length);
+
+ break;
+
+ case EXPR_ARRAY:
+ 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->offset)
+ len = elt_size * (size_t)mpz_get_si (c->offset);
+
+ len = len + gfc_merge_initializers (ts, c->expr, &data[len],
+ &chk[len], length - len);
+ }
+ break;
+
+ default:
+ return 0;
+ }
+
+ 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;
+}