[PATCH] PR fortran/8485: Misc INTEGER*8 fixes
Roger Sayle
roger@www.eyesopen.com
Mon May 5 03:47:00 GMT 2003
This patch fixes GNATS PR fortran/8485. This failure is caused
by the g77 front-end's inability to convert a 64-bit integer, i.e.
a fortran INTEGER*8, to a floating point value at compile time.
It turns out that the relevant hooks for converting between reals
and long longs (internally refered to as "integer4") are currently
unimplemented and just return FFEBAD_NOCANDO. The obvious fix is
to provide implementations for the 8 unimplemented hooks.
Handling 64bit integers using GCC's internal representation of two
HOST_WIDE_INTs requires the use of conditional compilation: On some
platforms a HOST_WIDE_INT is 64bits, allowing an INTEGER*8 to be
held in a single HOST_WIDE_INT, whilst on others it requires two.
The "#if" directives are required as shifting a "long long int" by
HOST_BITS_PER_WIDE_INT is only defined if a "long long" is bigger
than a HOST_WIDE_INT.
There are no remaining uses of FFEBAD_NOCANDO in target.h.
These original changes bootstrapped fine, fixing the PR, but alas
resulted in 25 testsuite regressions. It turns out that there are
other bugs in g77, when passing "integer4" constants to the middle-end.
For example:
INTEGER*8 foo
foo = 4e10
previously we would be unable to convert the floating point literal
to a 64-bit integer, leaving it to be converted either in the RTL
optimizers or potentially at run-time. With the "target.h" fixes
this is now converted into a 64bit immediate constant in the g77
front-end, but alas the code to convert constant integers to RTL
const_int nodes was truncating values at 32 bits. Doh!
Correcting g77's generation of RTL integer constants cures these
latent bugs, and fixes all of the above mentioned regressions.
The following patch has been tested on i686-pc-linux-gnu with a
bootstrap that included the g77 front-end, and regression tested
by running the g77 testsuite. Please don't ask for an exhaustive
set of test cases for INTEGER*8 functionality, adding the PRINT
statement to the testcase below (to confirm that we generate the
correct value) pushed my knowledge of FORTRAN to its limits.
I'll also test it on alphaev67-dec-osf5.1 tomorrow to test the
"trivial" 64-bit code paths. Unfortunately, I need to install
the Tru64 license PAKs to reenable user logins after 1 May :}
Ok for mainline?
2003-05-04 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.
* g77.f-torture/compile/8485.f: New test case.
Index: target.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/target.h,v
retrieving revision 1.22
diff -c -3 -p -r1.22 target.h
*** target.h 27 Mar 2003 00:09:58 -0000 1.22
--- target.h 5 May 2003 02:02:28 -0000
*************** void *ffetarget_memcpy_ (void *dst, void
*** 790,799 ****
/* Define macros. */
! #define FFETARGET_REAL_VALUE_FROM_INT_(resr, lf, kt) \
! REAL_VALUE_FROM_INT (resr, (long) lf, (long) ((lf < 0) ? -1 : 0), \
((kt == 1) ? SFmode : DFmode))
#define ffetarget_add_complex1(res,l,r) \
({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
--- 790,814 ----
/* Define macros. */
! #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); \
*************** void *ffetarget_memcpy_ (void *dst, void
*** 895,901 ****
#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_real1(res,l) \
((res)->real = (l), \
ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
--- 910,923 ----
#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) \
! ({ 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), \
*************** void *ffetarget_memcpy_ (void *dst, void
*** 930,936 ****
#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_real1(res,l) \
({ REAL_VALUE_TYPE lr; \
lr = ffetarget_cvt_r1_to_rv_ (l); \
--- 952,965 ----
#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) \
! ({ 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); \
*************** void *ffetarget_memcpy_ (void *dst, void
*** 993,1000 ****
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_hollerith(res,l) \
ffetarget_convert_integer1_hollerith(res,l)
#define ffetarget_convert_integer4_integer1(res,l) (*(res) = (l), FFEBAD)
--- 1022,1041 ----
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) \
! ({ 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)
*************** void *ffetarget_memcpy_ (void *dst, void
*** 1008,1015 ****
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_typeless(res,l) \
ffetarget_convert_integer1_typeless(res,l)
#define ffetarget_convert_logical1_character1(res,l) \
--- 1049,1068 ----
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) \
! ({ 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) \
*************** void *ffetarget_memcpy_ (void *dst, void
*** 1109,1115 ****
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_typeless(res,l) \
ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
#define ffetarget_convert_real1_complex1(res,l) (*(res) = (l).real, FFEBAD)
--- 1162,1173 ----
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) \
! ({ 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)
*************** void *ffetarget_memcpy_ (void *dst, void
*** 1134,1140 ****
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_typeless(res,l) \
ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
#define ffetarget_convert_real2_complex1(res,l) \
--- 1192,1203 ----
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) \
! ({ 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) \
Index: com.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/com.c,v
retrieving revision 1.192
diff -c -3 -p -r1.192 com.c
*** com.c 3 May 2003 16:39:49 -0000 1.192
--- com.c 5 May 2003 02:02:37 -0000
*************** ffecom_constantunion (ffebldConstantUnio
*** 10325,10355 ****
{
case FFEINFO_basictypeINTEGER:
{
! int val;
switch (kt)
{
#if FFETARGET_okINTEGER1
case FFEINFO_kindtypeINTEGER1:
! val = ffebld_cu_val_integer1 (*cu);
break;
#endif
#if FFETARGET_okINTEGER2
case FFEINFO_kindtypeINTEGER2:
! val = ffebld_cu_val_integer2 (*cu);
break;
#endif
#if FFETARGET_okINTEGER3
case FFEINFO_kindtypeINTEGER3:
! val = ffebld_cu_val_integer3 (*cu);
break;
#endif
#if FFETARGET_okINTEGER4
case FFEINFO_kindtypeINTEGER4:
! val = ffebld_cu_val_integer4 (*cu);
break;
#endif
--- 10325,10367 ----
{
case FFEINFO_basictypeINTEGER:
{
! HOST_WIDE_INT hi, lo;
switch (kt)
{
#if FFETARGET_okINTEGER1
case FFEINFO_kindtypeINTEGER1:
! lo = ffebld_cu_val_integer1 (*cu);
! hi = (lo < 0) ? -1 : 0;
break;
#endif
#if FFETARGET_okINTEGER2
case FFEINFO_kindtypeINTEGER2:
! lo = ffebld_cu_val_integer2 (*cu);
! hi = (lo < 0) ? -1 : 0;
break;
#endif
#if FFETARGET_okINTEGER3
case FFEINFO_kindtypeINTEGER3:
! lo = ffebld_cu_val_integer3 (*cu);
! hi = (lo < 0) ? -1 : 0;
break;
#endif
#if FFETARGET_okINTEGER4
case FFEINFO_kindtypeINTEGER4:
! #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
*************** ffecom_constantunion (ffebldConstantUnio
*** 10359,10365 ****
case FFEINFO_kindtypeANY:
return error_mark_node;
}
! item = build_int_2 (val, (val < 0) ? -1 : 0);
TREE_TYPE (item) = tree_type;
}
break;
--- 10371,10377 ----
case FFEINFO_kindtypeANY:
return error_mark_node;
}
! item = build_int_2 (lo, hi);
TREE_TYPE (item) = tree_type;
}
break;
*************** ffecom_constantunion_with_type (ffebldCo
*** 10614,10621 ****
--- 10626,10642 ----
#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
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
Roger
--
Roger Sayle, E-mail: roger@eyesopen.com
OpenEye Scientific Software, WWW: http://www.eyesopen.com/
Suite 1107, 3600 Cerrillos Road, Tel: (+1) 505-473-7385
Santa Fe, New Mexico, 87507. Fax: (+1) 505-473-0833
More information about the Gcc-patches
mailing list