From 53415fa1a1f7b3c13dde3aa0a73f35ae4dcc335b Mon Sep 17 00:00:00 2001 From: Roger Sayle Date: Thu, 8 May 2003 13:13:59 +0000 Subject: [PATCH] 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 --- gcc/f/ChangeLog | 18 +++++ gcc/f/com.c | 33 +++++++-- gcc/f/target.h | 83 +++++++++++++++++++--- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/g77.f-torture/compile/8485.f | 8 +++ 5 files changed, 130 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/g77.f-torture/compile/8485.f diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog index 503e851b971..0c5c5361170 100644 --- a/gcc/f/ChangeLog +++ b/gcc/f/ChangeLog @@ -1,3 +1,21 @@ +2003-05-08 Roger Sayle + + 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 * com.c (ffecom_do_entry_): Use location_t and input_location diff --git a/gcc/f/com.c b/gcc/f/com.c index 36658f2ce72..7ec18134ec2 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 7c48b791d1f..9140decde5b 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 a1bb392b6c6..baf9936d43d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2003-05-08 Roger Sayle + + * g77.f-torture/compile/8485.f: New test case. + 2003-05-07 Richard Henderson 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 00000000000..95e58fbfc18 --- /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 -- 2.30.2