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

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index 503e851b971e9734f2886fdb404360a49e9064e5..0c5c53611706f3e144cf20badab94e650bc37321 100644 (file)
--- 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 36658f2ce72cf4f339f917d4cda47fc25d1d2fbe..7ec18134ec2626e367fe6027e46df0135f1be2b2 100644 (file)
--- 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 7c48b791d1f2a7f454b3da8066303eed94b88388..9140decde5b648fc7d909f74cf707ea4df6676cf 100644 (file)
--- 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 a1bb392b6c6fa5d9acea3e1530ddcf49c4357bf1..baf9936d43d5af35821f757d8585d50311d4c64a 100644 (file)
--- 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 (file)
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