diff options
author | Brooks Moses <brooks.moses@codesourcery.com> | 2007-05-28 18:20:29 +0000 |
---|---|---|
committer | Brooks Moses <brooks@gcc.gnu.org> | 2007-05-28 11:20:29 -0700 |
commit | 20585ad66ab2455771dc13704f5a0c0f94de8ead (patch) | |
tree | 285e1933957cc1ea01f2d184aeb1656b76b6b3cb | |
parent | 0258dc3a2c897ba06499af1493aac7e736adbbb9 (diff) | |
download | gcc-20585ad66ab2455771dc13704f5a0c0f94de8ead.zip gcc-20585ad66ab2455771dc13704f5a0c0f94de8ead.tar.gz gcc-20585ad66ab2455771dc13704f5a0c0f94de8ead.tar.bz2 |
gfortran.h (gfc_expr): Remove from_H, add "representation" struct.
* gfortran.h (gfc_expr): Remove from_H, add "representation"
struct.
* primary.c (match_hollerith_constant): Store the representation
of the Hollerith in representation, not in value.character.
* arith.c: Add dependency on target-memory.h.
(eval_intrinsic): Remove check for from_H.
(hollerith2representation): New function.
(gfc_hollerith2int): Determine value of the new constant.
(gfc_hollerith2real): Likewise.
(gfc_hollerith2complex): Likewise.
(gfc_hollerith2logical): Likewise.
(gfc_hollerith2character): Point both representation.string and
value.character.string at the value string.
* data.c (create_character_initializer): For BT_HOLLERITH
rvalues, get the value from the representation rather than
value.character.
* expr.c (free_expr0): Update handling of BT_HOLLERITH values
and values with representation.string.
(gfc_copy_expr): Likewise.
* intrinsic.c (do_simplify): Remove special treatement of
variables resulting from Hollerith constants.
* dump-parse-trees.c (gfc_show_expr): Update handling of
Holleriths.
* trans-const.c (gfc_conv_constant_to_tree): Replace from_H
check with check for representation.string; get Hollerith
representation from representation.string, not value.character.
* trans-expr.c (is_zero_initializer_p): Replace from_H check
with check for representation.string.
* trans-stmt.c (gfc_trans_integer_select): Use
gfc_conv_mpz_to_tree for case values, so as to avoid picking up
the memory representation if the case is given by a transfer
expression.
* target-memory.c (gfc_target_encode_expr): Use the known memory
representation rather than the value, if it exists.
(gfc_target_interpret_expr): Store the memory representation of
the interpreted expression as well as its value.
(interpret_integer): Move to gfc_interpret_integer, make
non-static.
(interpret_float): Move to gfc_interpret_float, make non-static.
(interpret_complex): Move to gfc_interpret_complex, make
non-static.
(interpret_logical): Move to gfc_interpret_logical, make
non-static.
(interpret_character): Move to gfc_interpret_character, make
non-static.
(interpret_derived): Move to gfc_interpret_derived, make
non-static.
* target-memory.h: Add prototypes for newly-exported
gfc_interpret_* functions.
From-SVN: r125135
-rw-r--r-- | gcc/fortran/ChangeLog | 52 | ||||
-rw-r--r-- | gcc/fortran/arith.c | 127 | ||||
-rw-r--r-- | gcc/fortran/data.c | 21 | ||||
-rw-r--r-- | gcc/fortran/dump-parse-tree.c | 32 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 38 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 17 | ||||
-rw-r--r-- | gcc/fortran/intrinsic.c | 10 | ||||
-rw-r--r-- | gcc/fortran/primary.c | 19 | ||||
-rw-r--r-- | gcc/fortran/target-memory.c | 92 | ||||
-rw-r--r-- | gcc/fortran/target-memory.h | 7 | ||||
-rw-r--r-- | gcc/fortran/trans-const.c | 33 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 5 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 6 |
13 files changed, 287 insertions, 172 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 59278dc..e1265a6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,55 @@ +2007-05-27 Brooks Moses <brooks.moses@codesourcery.com> + + * gfortran.h (gfc_expr): Remove from_H, add "representation" + struct. + * primary.c (match_hollerith_constant): Store the representation + of the Hollerith in representation, not in value.character. + * arith.c: Add dependency on target-memory.h. + (eval_intrinsic): Remove check for from_H. + (hollerith2representation): New function. + (gfc_hollerith2int): Determine value of the new constant. + (gfc_hollerith2real): Likewise. + (gfc_hollerith2complex): Likewise. + (gfc_hollerith2logical): Likewise. + (gfc_hollerith2character): Point both representation.string and + value.character.string at the value string. + * data.c (create_character_initializer): For BT_HOLLERITH + rvalues, get the value from the representation rather than + value.character. + * expr.c (free_expr0): Update handling of BT_HOLLERITH values + and values with representation.string. + (gfc_copy_expr): Likewise. + * intrinsic.c (do_simplify): Remove special treatement of + variables resulting from Hollerith constants. + * dump-parse-trees.c (gfc_show_expr): Update handling of + Holleriths. + * trans-const.c (gfc_conv_constant_to_tree): Replace from_H + check with check for representation.string; get Hollerith + representation from representation.string, not value.character. + * trans-expr.c (is_zero_initializer_p): Replace from_H check + with check for representation.string. + * trans-stmt.c (gfc_trans_integer_select): Use + gfc_conv_mpz_to_tree for case values, so as to avoid picking up + the memory representation if the case is given by a transfer + expression. + * target-memory.c (gfc_target_encode_expr): Use the known memory + representation rather than the value, if it exists. + (gfc_target_interpret_expr): Store the memory representation of + the interpreted expression as well as its value. + (interpret_integer): Move to gfc_interpret_integer, make + non-static. + (interpret_float): Move to gfc_interpret_float, make non-static. + (interpret_complex): Move to gfc_interpret_complex, make + non-static. + (interpret_logical): Move to gfc_interpret_logical, make + non-static. + (interpret_character): Move to gfc_interpret_character, make + non-static. + (interpret_derived): Move to gfc_interpret_derived, make + non-static. + * target-memory.h: Add prototypes for newly-exported + gfc_interpret_* functions. + 2007-05-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/31812 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 8c995ea..9d8428d 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -30,6 +30,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "flags.h" #include "gfortran.h" #include "arith.h" +#include "target-memory.h" /* MPFR does not have a direct replacement for mpz_set_f() from GMP. It's easily implemented with a few calls though. */ @@ -1613,17 +1614,15 @@ eval_intrinsic (gfc_intrinsic_op operator, if (operator == INTRINSIC_POWER && op2->ts.type != BT_INTEGER) goto runtime; - if (op1->from_H - || (op1->expr_type != EXPR_CONSTANT - && (op1->expr_type != EXPR_ARRAY - || !gfc_is_constant_expr (op1) || !gfc_expanded_ac (op1)))) + if (op1->expr_type != EXPR_CONSTANT + && (op1->expr_type != EXPR_ARRAY + || !gfc_is_constant_expr (op1) || !gfc_expanded_ac (op1))) goto runtime; if (op2 != NULL - && (op2->from_H - || (op2->expr_type != EXPR_CONSTANT - && (op2->expr_type != EXPR_ARRAY - || !gfc_is_constant_expr (op2) || !gfc_expanded_ac (op2))))) + && op2->expr_type != EXPR_CONSTANT + && (op2->expr_type != EXPR_ARRAY + || !gfc_is_constant_expr (op2) || !gfc_expanded_ac (op2))) goto runtime; if (unary) @@ -2307,37 +2306,52 @@ gfc_int2log (gfc_expr *src, int kind) } +/* Helper function to set the representation in a Hollerith conversion. + This assumes that the ts.type and ts.kind of the result have already + been set. */ + +static void +hollerith2representation (gfc_expr *result, gfc_expr *src) +{ + int src_len, result_len; + + src_len = src->representation.length; + result_len = gfc_target_expr_size (result); + + if (src_len > result_len) + { + gfc_warning ("The Hollerith constant at %L is too long to convert to %s", + &src->where, gfc_typename(&result->ts)); + } + + result->representation.string = gfc_getmem (result_len + 1); + memcpy (result->representation.string, src->representation.string, + MIN (result_len, src_len)); + + if (src_len < result_len) + memset (&result->representation.string[src_len], ' ', result_len - src_len); + + result->representation.string[result_len] = '\0'; /* For debugger */ + result->representation.length = result_len; +} + + /* Convert Hollerith to integer. The constant will be padded or truncated. */ gfc_expr * gfc_hollerith2int (gfc_expr *src, int kind) { gfc_expr *result; - int len; - - len = src->value.character.length; result = gfc_get_expr (); result->expr_type = EXPR_CONSTANT; result->ts.type = BT_INTEGER; result->ts.kind = kind; result->where = src->where; - result->from_H = 1; - - if (len > kind) - { - gfc_warning ("The Hollerith constant at %L is too long to convert to %s", - &src->where, gfc_typename(&result->ts)); - } - result->value.character.string = gfc_getmem (kind + 1); - memcpy (result->value.character.string, src->value.character.string, - MIN (kind, len)); - - if (len < kind) - memset (&result->value.character.string[len], ' ', kind - len); - result->value.character.string[kind] = '\0'; /* For debugger */ - result->value.character.length = kind; + hollerith2representation (result, src); + gfc_interpret_integer(kind, (unsigned char *) result->representation.string, + result->representation.length, result->value.integer); return result; } @@ -2358,22 +2372,10 @@ gfc_hollerith2real (gfc_expr *src, int kind) result->ts.type = BT_REAL; result->ts.kind = kind; result->where = src->where; - result->from_H = 1; - if (len > kind) - { - gfc_warning ("The Hollerith constant at %L is too long to convert to %s", - &src->where, gfc_typename(&result->ts)); - } - result->value.character.string = gfc_getmem (kind + 1); - memcpy (result->value.character.string, src->value.character.string, - MIN (kind, len)); - - if (len < kind) - memset (&result->value.character.string[len], ' ', kind - len); - - result->value.character.string[kind] = '\0'; /* For debugger. */ - result->value.character.length = kind; + hollerith2representation (result, src); + gfc_interpret_float(kind, (unsigned char *) result->representation.string, + result->representation.length, result->value.real); return result; } @@ -2394,24 +2396,11 @@ gfc_hollerith2complex (gfc_expr *src, int kind) result->ts.type = BT_COMPLEX; result->ts.kind = kind; result->where = src->where; - result->from_H = 1; - - kind = kind * 2; - - if (len > kind) - { - gfc_warning ("The Hollerith constant at %L is too long to convert to %s", - &src->where, gfc_typename(&result->ts)); - } - result->value.character.string = gfc_getmem (kind + 1); - memcpy (result->value.character.string, src->value.character.string, - MIN (kind, len)); - if (len < kind) - memset (&result->value.character.string[len], ' ', kind - len); - - result->value.character.string[kind] = '\0'; /* For debugger */ - result->value.character.length = kind; + hollerith2representation (result, src); + gfc_interpret_complex(kind, (unsigned char *) result->representation.string, + result->representation.length, result->value.complex.r, + result->value.complex.i); return result; } @@ -2427,7 +2416,9 @@ gfc_hollerith2character (gfc_expr *src, int kind) result = gfc_copy_expr (src); result->ts.type = BT_CHARACTER; result->ts.kind = kind; - result->from_H = 1; + + result->value.character.string = result->representation.string; + result->value.character.length = result->representation.length; return result; } @@ -2448,22 +2439,10 @@ gfc_hollerith2logical (gfc_expr *src, int kind) result->ts.type = BT_LOGICAL; result->ts.kind = kind; result->where = src->where; - result->from_H = 1; - - if (len > kind) - { - gfc_warning ("The Hollerith constant at %L is too long to convert to %s", - &src->where, gfc_typename(&result->ts)); - } - result->value.character.string = gfc_getmem (kind + 1); - memcpy (result->value.character.string, src->value.character.string, - MIN (kind, len)); - - if (len < kind) - memset (&result->value.character.string[len], ' ', kind - len); - result->value.character.string[kind] = '\0'; /* For debugger */ - result->value.character.length = kind; + hollerith2representation (result, src); + gfc_interpret_logical(kind, (unsigned char *) result->representation.string, + result->representation.length, &result->value.logical); return result; } diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 70a7151..75e4241 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -154,7 +154,7 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts, int len; int start; int end; - char *dest; + char *dest, *rvalue_string; gfc_extract_int (ts->cl->length, &len); @@ -207,7 +207,17 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts, } /* Copy the initial value. */ - len = rvalue->value.character.length; + if (rvalue->ts.type == BT_HOLLERITH) + { + len = rvalue->representation.length; + rvalue_string = rvalue->representation.string; + } + else + { + len = rvalue->value.character.length; + rvalue_string = rvalue->value.character.string; + } + if (len > end - start) { len = end - start; @@ -215,14 +225,17 @@ create_character_intializer (gfc_expr *init, gfc_typespec *ts, "at %L", &rvalue->where); } - memcpy (&dest[start], rvalue->value.character.string, len); + memcpy (&dest[start], rvalue_string, len); /* Pad with spaces. Substrings will already be blanked. */ if (len < end - start && ref == NULL) memset (&dest[start + len], ' ', end - (start + len)); if (rvalue->ts.type == BT_HOLLERITH) - init->from_H = 1; + { + init->representation.length = init->value.character.length; + init->representation.string = init->value.character.string; + } return init; } diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 6f2a6a7..51af1c4 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -340,16 +340,6 @@ gfc_show_expr (gfc_expr *p) break; case EXPR_CONSTANT: - if (p->from_H || p->ts.type == BT_HOLLERITH) - { - gfc_status ("%dH", p->value.character.length); - c = p->value.character.string; - for (i = 0; i < p->value.character.length; i++, c++) - { - gfc_status_char (*c); - } - break; - } switch (p->ts.type) { case BT_INTEGER: @@ -405,11 +395,33 @@ gfc_show_expr (gfc_expr *p) gfc_status (")"); break; + case BT_HOLLERITH: + gfc_status ("%dH", p->representation.length); + c = p->representation.string; + for (i = 0; i < p->representation.length; i++, c++) + { + gfc_status_char (*c); + } + break; + default: gfc_status ("???"); break; } + if (p->representation.string) + { + gfc_status (" {"); + c = p->representation.string; + for (i = 0; i < p->representation.length; i++, c++) + { + gfc_status ("%.2x", (unsigned int) *c); + if (i < p->representation.length - 1) + gfc_status_char (','); + } + gfc_status_char ('}'); + } + break; case EXPR_VARIABLE: diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 9957a46..849b406 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -140,12 +140,7 @@ free_expr0 (gfc_expr *e) switch (e->expr_type) { case EXPR_CONSTANT: - if (e->from_H) - { - gfc_free (e->value.character.string); - break; - } - + /* Free any parts of the value that need freeing. */ switch (e->ts.type) { case BT_INTEGER: @@ -157,7 +152,6 @@ free_expr0 (gfc_expr *e) break; case BT_CHARACTER: - case BT_HOLLERITH: gfc_free (e->value.character.string); break; @@ -170,6 +164,11 @@ free_expr0 (gfc_expr *e) break; } + /* Free the representation, except in character constants where it + is the same as value.character.string and thus already freed. */ + if (e->representation.string && e->ts.type != BT_CHARACTER) + gfc_free (e->representation.string); + break; case EXPR_OP: @@ -413,14 +412,16 @@ gfc_copy_expr (gfc_expr *p) break; case EXPR_CONSTANT: - if (p->from_H) + /* Copy target representation, if it exists. */ + if (p->representation.string) { - s = gfc_getmem (p->value.character.length + 1); - q->value.character.string = s; + s = gfc_getmem (p->representation.length + 1); + q->representation.string = s; - memcpy (s, p->value.character.string, p->value.character.length + 1); - break; + memcpy (s, p->representation.string, p->representation.length + 1); } + + /* Copy the values of any pointer components of p->value. */ switch (q->ts.type) { case BT_INTEGER: @@ -442,13 +443,18 @@ gfc_copy_expr (gfc_expr *p) break; case BT_CHARACTER: - case BT_HOLLERITH: - s = gfc_getmem (p->value.character.length + 1); - q->value.character.string = s; + if (p->representation.string) + q->value.character.string = q->representation.string; + else + { + s = gfc_getmem (p->value.character.length + 1); + q->value.character.string = s; - memcpy (s, p->value.character.string, p->value.character.length + 1); + memcpy (s, p->value.character.string, p->value.character.length + 1); + } break; + case BT_HOLLERITH: case BT_LOGICAL: case BT_DERIVED: break; /* Already done */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 38ef1a6..c7fa5f8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1290,17 +1290,28 @@ typedef struct gfc_expr locus where; - /* True if it is converted from Hollerith constant. */ - unsigned int from_H : 1; /* True if the expression is a call to a function that returns an array, and if we have decided not to allocate temporary data for that array. */ unsigned int inline_noncopying_intrinsic : 1; - /* Used to quickly find a given constructor by it's offset. */ + + /* Used to quickly find a given constructor by its offset. */ splay_tree con_by_offset; + /* If an expression comes from a Hollerith constant or compile-time + evaluation of a transfer statement, it may have a prescribed target- + memory representation, and these cannot always be backformed from + the value. */ + struct + { + int length; + char *string; + } + representation; + union { int logical; + mpz_t integer; mpfr_t real; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index d64f77f..d3392b0 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -3065,16 +3065,6 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e) gfc_expr *result, *a1, *a2, *a3, *a4, *a5; gfc_actual_arglist *arg; - /* Check the arguments if there are Hollerith constants. We deal with - them at run-time. */ - for (arg = e->value.function.actual; arg != NULL; arg = arg->next) - { - if (arg->expr && arg->expr->from_H) - { - result = NULL; - goto finish; - } - } /* Max and min require special handling due to the variable number of args. */ if (specific->simplify.f1 == gfc_simplify_min) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 653df5d..ce81f44 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -236,7 +236,6 @@ match_hollerith_constant (gfc_expr **result) locus old_loc; gfc_expr *e = NULL; const char *msg; - char *buffer; int num; int i; @@ -270,18 +269,18 @@ match_hollerith_constant (gfc_expr **result) } else { - buffer = (char *) gfc_getmem (sizeof(char) * num + 1); - for (i = 0; i < num; i++) - { - buffer[i] = gfc_next_char_literal (1); - } gfc_free_expr (e); e = gfc_constant_result (BT_HOLLERITH, gfc_default_character_kind, &gfc_current_locus); - e->value.character.string = gfc_getmem (num + 1); - memcpy (e->value.character.string, buffer, num); - e->value.character.string[num] = '\0'; - e->value.character.length = num; + + e->representation.string = gfc_getmem (num + 1); + for (i = 0; i < num; i++) + { + e->representation.string[i] = gfc_next_char_literal (1); + } + e->representation.string[num] = '\0'; + e->representation.length = num; + *result = e; return MATCH_YES; } diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index ba2363a..194bc0b 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -220,6 +220,15 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, gcc_assert (source->expr_type == EXPR_CONSTANT || source->expr_type == EXPR_STRUCTURE); + /* 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: @@ -289,8 +298,8 @@ interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result) } -static int -interpret_integer (int kind, unsigned char *buffer, size_t buffer_size, +int +gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size, mpz_t integer) { mpz_init (integer); @@ -301,8 +310,8 @@ interpret_integer (int kind, unsigned char *buffer, size_t buffer_size, } -static int -interpret_float (int kind, unsigned char *buffer, size_t buffer_size, +int +gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size, mpfr_t real) { mpfr_init (real); @@ -314,19 +323,19 @@ interpret_float (int kind, unsigned char *buffer, size_t buffer_size, } -static int -interpret_complex (int kind, unsigned char *buffer, size_t buffer_size, +int +gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size, mpfr_t real, mpfr_t imaginary) { int size; - size = interpret_float (kind, &buffer[0], buffer_size, real); - size += interpret_float (kind, &buffer[size], buffer_size - size, imaginary); + size = gfc_interpret_float (kind, &buffer[0], buffer_size, real); + size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary); return size; } -static int -interpret_logical (int kind, unsigned char *buffer, size_t buffer_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, @@ -337,8 +346,8 @@ interpret_logical (int kind, unsigned char *buffer, size_t buffer_size, } -static int -interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result) +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 = @@ -355,8 +364,8 @@ interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result } -static int -interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result) +int +gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result) { gfc_component *cmp; gfc_constructor *head = NULL, *tail = NULL; @@ -428,24 +437,55 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, switch (result->ts.type) { case BT_INTEGER: - return interpret_integer (result->ts.kind, buffer, buffer_size, - result->value.integer); + result->representation.length = + gfc_interpret_integer (result->ts.kind, buffer, buffer_size, + result->value.integer); + break; + case BT_REAL: - return interpret_float (result->ts.kind, buffer, buffer_size, - result->value.real); + result->representation.length = + gfc_interpret_float (result->ts.kind, buffer, buffer_size, + result->value.real); + break; + case BT_COMPLEX: - return interpret_complex (result->ts.kind, buffer, buffer_size, - result->value.complex.r, - result->value.complex.i); + result->representation.length = + gfc_interpret_complex (result->ts.kind, buffer, buffer_size, + result->value.complex.r, + result->value.complex.i); + break; + case BT_LOGICAL: - return interpret_logical (result->ts.kind, buffer, buffer_size, - &result->value.logical); + result->representation.length = + gfc_interpret_logical (result->ts.kind, buffer, buffer_size, + &result->value.logical); + break; + case BT_CHARACTER: - return interpret_character (buffer, buffer_size, result); + result->representation.length = + gfc_interpret_character (buffer, buffer_size, result); + break; + case BT_DERIVED: - return interpret_derived (buffer, buffer_size, result); + 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 = result->value.character.string; + else + { + result->representation.string = + gfc_getmem (result->representation.length + 1); + memcpy (result->representation.string, buffer, + result->representation.length); + result->representation.string[result->representation.length] = '\0'; } - return 0; + + return result->representation.length; } diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index 85ae552..8e35e69 100644 --- a/gcc/fortran/target-memory.h +++ b/gcc/fortran/target-memory.h @@ -32,6 +32,13 @@ size_t gfc_target_expr_size (gfc_expr *); int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t); /* Read a target buffer into a constant expression. */ + +int gfc_interpret_integer (int, unsigned char *, size_t, mpz_t); +int gfc_interpret_float (int, unsigned char *, size_t, mpfr_t); +int gfc_interpret_complex (int, unsigned char *, size_t, mpfr_t, mpfr_t); +int gfc_interpret_logical (int, unsigned char *, size_t, int *); +int gfc_interpret_character (unsigned char *, size_t, gfc_expr *); +int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *); int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *); #endif /* GFC_TARGET_MEMORY_H */ diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 435d5ec..24aa809 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -209,45 +209,45 @@ gfc_conv_constant_to_tree (gfc_expr * expr) { gcc_assert (expr->expr_type == EXPR_CONSTANT); - /* If it is converted from Hollerith constant, we build string constant - and VIEW_CONVERT to its type. */ + /* If it is has a prescribed memory representation, we build a string + constant and VIEW_CONVERT to its type. */ switch (expr->ts.type) { case BT_INTEGER: - if (expr->from_H) + if (expr->representation.string) return build1 (VIEW_CONVERT_EXPR, gfc_get_int_type (expr->ts.kind), - gfc_build_string_const (expr->value.character.length, - expr->value.character.string)); + gfc_build_string_const (expr->representation.length, + expr->representation.string)); else return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind); case BT_REAL: - if (expr->from_H) + if (expr->representation.string) return build1 (VIEW_CONVERT_EXPR, gfc_get_real_type (expr->ts.kind), - gfc_build_string_const (expr->value.character.length, - expr->value.character.string)); + gfc_build_string_const (expr->representation.length, + expr->representation.string)); else return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind); case BT_LOGICAL: - if (expr->from_H) + if (expr->representation.string) return build1 (VIEW_CONVERT_EXPR, gfc_get_logical_type (expr->ts.kind), - gfc_build_string_const (expr->value.character.length, - expr->value.character.string)); + gfc_build_string_const (expr->representation.length, + expr->representation.string)); else return build_int_cst (gfc_get_logical_type (expr->ts.kind), expr->value.logical); case BT_COMPLEX: - if (expr->from_H) + if (expr->representation.string) return build1 (VIEW_CONVERT_EXPR, gfc_get_complex_type (expr->ts.kind), - gfc_build_string_const (expr->value.character.length, - expr->value.character.string)); + gfc_build_string_const (expr->representation.length, + expr->representation.string)); else { tree real = gfc_conv_mpfr_to_tree (expr->value.complex.r, @@ -260,10 +260,13 @@ gfc_conv_constant_to_tree (gfc_expr * expr) } case BT_CHARACTER: - case BT_HOLLERITH: return gfc_build_string_const (expr->value.character.length, expr->value.character.string); + case BT_HOLLERITH: + return gfc_build_string_const (expr->representation.length, + expr->representation.string); + default: fatal_error ("gfc_conv_constant_to_tree(): invalid type: %s", gfc_typename (&expr->ts)); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e621a6a..c8f8012 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3567,8 +3567,9 @@ is_zero_initializer_p (gfc_expr * expr) { if (expr->expr_type != EXPR_CONSTANT) return false; - /* We ignore Hollerith constants for the time being. */ - if (expr->from_H) + + /* We ignore constants with prescribed memory representations for now. */ + if (expr->representation.string) return false; switch (expr->ts.type) diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index ec7548e..b1cd029 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1139,7 +1139,8 @@ gfc_trans_integer_select (gfc_code * code) if (cp->low) { - low = gfc_conv_constant_to_tree (cp->low); + low = gfc_conv_mpz_to_tree (cp->low->value.integer, + cp->low->ts.kind); /* If there's only a lower bound, set the high bound to the maximum value of the case expression. */ @@ -1169,7 +1170,8 @@ gfc_trans_integer_select (gfc_code * code) || (cp->low && mpz_cmp (cp->low->value.integer, cp->high->value.integer) != 0)) - high = gfc_conv_constant_to_tree (cp->high); + high = gfc_conv_mpz_to_tree (cp->high->value.integer, + cp->high->ts.kind); /* Unbounded case. */ if (!cp->low) |