re PR fortran/8485 (g77 doesn't accept INTEGER*8 constant in PARAMETER multiplication)

	PR fortran/8485
	* target.h (FFETARGET_REAL_VALUE_FROM_INT_): Cast to
	HOST_WIDE_INT instead of long.
	(FFETARGET_REAL_VALUE_FROM_LONGLONG_): New macro.
	(FFETARGET_LONGLONG_FROM_INTS_): New macro.
	(ffetarget_convert_complex1_integer4): Implement.
	(ffetarget_convert_complex2_integer4): Implement.
	(ffetarget_convert_integer4_complex1): Implement.
	(ffetarget_convert_integer4_complex2): Implement.
	(ffetarget_convert_integer4_real1): Implement.
	(ffetarget_convert_integer4_real2): Implement.
	(ffetarget_convert_real1_integer4): Implement.
	(ffetarget_convert_real2_integer4): Implement.
	* com.c (ffecom_constantunion): Handle INTEGER*8.
	(ffecom_constantunion_with_type): Likewise.

	* g77.f-torture/compile/8485.f: New test case.

From-SVN: r66596

5 files changed, 130 insertions, 16 deletions

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index 503e851..0c5c536 100644
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,21 @@
+2003-05-08  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/8485
+	* target.h (FFETARGET_REAL_VALUE_FROM_INT_): Cast to
+	HOST_WIDE_INT instead of long.
+	(FFETARGET_REAL_VALUE_FROM_LONGLONG_): New macro.
+	(FFETARGET_LONGLONG_FROM_INTS_): New macro.
+	(ffetarget_convert_complex1_integer4): Implement.
+	(ffetarget_convert_complex2_integer4): Implement.
+	(ffetarget_convert_integer4_complex1): Implement.
+	(ffetarget_convert_integer4_complex2): Implement.
+	(ffetarget_convert_integer4_real1): Implement.
+	(ffetarget_convert_integer4_real2): Implement.
+	(ffetarget_convert_real1_integer4): Implement.
+	(ffetarget_convert_real2_integer4): Implement.
+	* com.c (ffecom_constantunion): Handle INTEGER*8.
+	(ffecom_constantunion_with_type): Likewise.
+
 2003-05-03  Nathan Sidwell  <nathan@codesourcery.com>
 
 	* com.c (ffecom_do_entry_): Use location_t and input_location
diff --git a/gcc/f/com.c b/gcc/f/com.c
index 36658f2..7ec1813 100644
--- a/gcc/f/com.c
+++ b/gcc/f/com.c
@@ -10325,31 +10325,43 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
     {
     case FFEINFO_basictypeINTEGER:
       {
-	int val;
+        HOST_WIDE_INT hi, lo;
 
 	switch (kt)
 	  {
 #if FFETARGET_okINTEGER1
 	  case FFEINFO_kindtypeINTEGER1:
-	    val = ffebld_cu_val_integer1 (*cu);
+	    lo = ffebld_cu_val_integer1 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
 	    break;
 #endif
 
 #if FFETARGET_okINTEGER2
 	  case FFEINFO_kindtypeINTEGER2:
-	    val = ffebld_cu_val_integer2 (*cu);
+	    lo = ffebld_cu_val_integer2 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
 	    break;
 #endif
 
 #if FFETARGET_okINTEGER3
 	  case FFEINFO_kindtypeINTEGER3:
-	    val = ffebld_cu_val_integer3 (*cu);
+	    lo = ffebld_cu_val_integer3 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
 	    break;
 #endif
 
 #if FFETARGET_okINTEGER4
 	  case FFEINFO_kindtypeINTEGER4:
-	    val = ffebld_cu_val_integer4 (*cu);
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+	    {
+	      long long int big = ffebld_cu_val_integer4 (*cu);
+	      hi = (HOST_WIDE_INT) (big >> HOST_BITS_PER_WIDE_INT);
+	      lo = (HOST_WIDE_INT) big;
+	    }
+#else
+	    lo = ffebld_cu_val_integer4 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
+#endif
 	    break;
 #endif
 
@@ -10359,7 +10371,7 @@ ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
 	  case FFEINFO_kindtypeANY:
 	    return error_mark_node;
 	  }
-	item = build_int_2 (val, (val < 0) ? -1 : 0);
+	item = build_int_2 (lo, hi);
 	TREE_TYPE (item) = tree_type;
       }
       break;
@@ -10614,8 +10626,17 @@ ffecom_constantunion_with_type (ffebldConstantUnion *cu,
 #endif
 #if FFETARGET_okINTEGER4
 	  case  FFEBLD_constINTEGER4:
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+		  {
+		    long long int big = ffebld_cu_val_integer4 (*cu);
+		    item = build_int_2 ((HOST_WIDE_INT) big,
+					(HOST_WIDE_INT)
+					(big >> HOST_BITS_PER_WIDE_INT));
+		  }
+#else
 		  val = ffebld_cu_val_integer4 (*cu);
 		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+#endif
 		  break;
 #endif
 #if FFETARGET_okLOGICAL1
diff --git a/gcc/f/target.h b/gcc/f/target.h
index 7c48b79..9140dec 100644
--- a/gcc/f/target.h
+++ b/gcc/f/target.h
@@ -790,10 +790,25 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
 
 /* Define macros. */
 
-#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt)			\
-  REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0),	\
+#define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt)		\
+  REAL_VALUE_FROM_INT (resr, (HOST_WIDE_INT) lf,		\
+                       (HOST_WIDE_INT) ((lf < 0) ? -1 : 0),	\
 		       ((kt == 1) ? SFmode : DFmode))
 
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+#define FFETARGET_REAL_VALUE_FROM_LONGLONG_(resr, lf, kt)		\
+  REAL_VALUE_FROM_INT (resr, (HOST_WIDE_INT) lf,			\
+		       (HOST_WIDE_INT) (lf >> HOST_BITS_PER_WIDE_INT),	\
+		       ((kt == 1) ? SFmode : DFmode))
+#define FFETARGET_LONGLONG_FROM_INTS_(hi, lo)		\
+  (((long long int) hi << HOST_BITS_PER_WIDE_INT)	\
+   | (long long int) ((unsigned HOST_WIDE_INT) lo))
+#else
+#define FFETARGET_REAL_VALUE_FROM_LONGLONG_(resr, lf, kt)		\
+  FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, kt)
+#define FFETARGET_LONGLONG_FROM_INTS_(hi, lo)  lo
+#endif
+
 #define ffetarget_add_complex1(res,l,r) \
   ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
      lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
@@ -895,7 +910,14 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
 #define ffetarget_convert_complex1_integer1 ffetarget_convert_complex1_integer
 #define ffetarget_convert_complex1_integer2 ffetarget_convert_complex1_integer
 #define ffetarget_convert_complex1_integer3 ffetarget_convert_complex1_integer
-#define ffetarget_convert_complex1_integer4(res,l) FFEBAD_NOCANDO
+#define ffetarget_convert_complex1_integer4(res,l) \
+  ({ REAL_VALUE_TYPE resi, resr; \
+     ffetargetInteger4 lf = (l); \
+     FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 1); \
+     resi = dconst0; \
+     ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
+     ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
+     FFEBAD; })
 #define ffetarget_convert_complex1_real1(res,l) \
   ((res)->real = (l), \
    ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
@@ -930,7 +952,14 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
 #define ffetarget_convert_complex2_integer1 ffetarget_convert_complex2_integer
 #define ffetarget_convert_complex2_integer2 ffetarget_convert_complex2_integer
 #define ffetarget_convert_complex2_integer3 ffetarget_convert_complex2_integer
-#define ffetarget_convert_complex2_integer4(res,l) FFEBAD_NOCANDO
+#define ffetarget_convert_complex2_integer4(res,l) \
+  ({ REAL_VALUE_TYPE resi, resr; \
+     ffetargetInteger4 lf = (l); \
+     FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 2); \
+     resi = dconst0; \
+     ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
+     ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
+     FFEBAD; })
 #define ffetarget_convert_complex2_real1(res,l) \
   ({ REAL_VALUE_TYPE lr; \
      lr = ffetarget_cvt_r1_to_rv_ (l); \
@@ -993,8 +1022,20 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
         ffetarget_convert_integer1_typeless(res,l)
 #define ffetarget_convert_integer4_character1(res,l) \
         ffetarget_convert_integer1_character1(res,l)
-#define ffetarget_convert_integer4_complex1(res,l) FFEBAD_NOCANDO
-#define ffetarget_convert_integer4_complex2(res,l) FFEBAD_NOCANDO
+#define ffetarget_convert_integer4_complex1(res,l) \
+  ({ REAL_VALUE_TYPE lr; \
+     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
+     REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+     *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_,  \
+					     ffetarget_long_val_); \
+     FFEBAD; })
+#define ffetarget_convert_integer4_complex2(res,l) \
+  ({ REAL_VALUE_TYPE lr; \
+     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
+     REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+     *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_,  \
+					     ffetarget_long_val_); \
+     FFEBAD; })
 #define ffetarget_convert_integer4_hollerith(res,l) \
         ffetarget_convert_integer1_hollerith(res,l)
 #define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD)
@@ -1008,8 +1049,20 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
         ffetarget_convert_integer1_logical1(res,l)
 #define ffetarget_convert_integer4_logical4(res,l) \
         ffetarget_convert_integer1_logical1(res,l)
-#define ffetarget_convert_integer4_real1(res,l) FFEBAD_NOCANDO
-#define ffetarget_convert_integer4_real2(res,l) FFEBAD_NOCANDO
+#define ffetarget_convert_integer4_real1(res,l) \
+  ({ REAL_VALUE_TYPE lr; \
+     lr = ffetarget_cvt_r1_to_rv_ (l); \
+     REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+     *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \
+					     ffetarget_long_val_); \
+     FFEBAD; })
+#define ffetarget_convert_integer4_real2(res,l) \
+  ({ REAL_VALUE_TYPE lr; \
+     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
+     REAL_VALUE_TO_INT (&ffetarget_long_val_, &ffetarget_long_junk_, lr); \
+     *(res) = FFETARGET_LONGLONG_FROM_INTS_ (ffetarget_long_junk_, \
+					     ffetarget_long_val_); \
+     FFEBAD; })
 #define ffetarget_convert_integer4_typeless(res,l) \
         ffetarget_convert_integer1_typeless(res,l)
 #define ffetarget_convert_logical1_character1(res,l) \
@@ -1109,7 +1162,12 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
         ffetarget_convert_real1_integer1(res,l)
 #define ffetarget_convert_real1_integer3(res,l) \
         ffetarget_convert_real1_integer1(res,l)
-#define ffetarget_convert_real1_integer4(res,l) FFEBAD_NOCANDO
+#define ffetarget_convert_real1_integer4(res,l) \
+  ({ REAL_VALUE_TYPE resr; \
+     ffetargetInteger4 lf = (l); \
+     FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 1); \
+     ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
+     FFEBAD; })
 #define ffetarget_convert_real1_typeless(res,l) \
   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 #define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD)
@@ -1134,7 +1192,12 @@ void *ffetarget_memcpy_ (void *dst, void *src, size_t len);
         ffetarget_convert_real2_integer1(res,l)
 #define ffetarget_convert_real2_integer3(res,l) \
         ffetarget_convert_real2_integer1(res,l)
-#define ffetarget_convert_real2_integer4(res,l) FFEBAD_NOCANDO
+#define ffetarget_convert_real2_integer4(res,l) \
+  ({ REAL_VALUE_TYPE resr; \
+     ffetargetInteger4 lf = (l); \
+     FFETARGET_REAL_VALUE_FROM_LONGLONG_ (resr, lf, 2); \
+     ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
+     FFEBAD; })
 #define ffetarget_convert_real2_typeless(res,l) \
   ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
 #define ffetarget_convert_real2_complex1(res,l) \
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a1bb392..baf9936 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2003-05-08  Roger Sayle  <roger@eyesopen.com>
+
+	* g77.f-torture/compile/8485.f: New test case.
+
 2003-05-07  Richard Henderson  <rth@redhat.com>
 
         PR c++/10570
diff --git a/gcc/testsuite/g77.f-torture/compile/8485.f b/gcc/testsuite/g77.f-torture/compile/8485.f
new file mode 100644
index 0000000..95e58fb
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/compile/8485.f
@@ -0,0 +1,8 @@
+C      Extracted from PR fortran/8485
+       PARAMETER (PPMULT = 1.0E5)
+       INTEGER*8 NWRONG
+       PARAMETER (NWRONG = 8)
+       PARAMETER (DDMULT = PPMULT * NWRONG)
+       PRINT 10, DDMULT
+10     FORMAT (F10.3)
+       END