* 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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@125135 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 53 insertions, 74 deletions

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 8c995ea3b2d..9d8428ddca0 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;
 }