This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
- i686-linux, which has real(10) - sparc-solaris, whichs has real(16) - x86_64-linux, which has real(10) and integer(16) - alpha-linux, which has integer(16)
(I think I got my bases covered; hopefully, I will not have to do that again for some time ;-)
Index: libgfortran/Makefile.am
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.35
diff -p -u -r1.35 Makefile.am
--- libgfortran/Makefile.am 18 May 2005 20:35:25 -0000 1.35
+++ libgfortran/Makefile.am 6 Jun 2005 20:54:23 -0000
@@ -295,7 +295,7 @@ gfor_built_src= $(i_all_c) $(i_any_c) $(
$(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
$(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c) \
$(i_pow_c) \
- selected_int_kind.inc selected_real_kind.inc
+ selected_int_kind.inc selected_real_kind.inc kinds.h
# We only use these if libm doesn't contain complex math functions.
@@ -415,6 +415,9 @@ I_M4_DEPS=m4/iparm.m4
I_M4_DEPS0=$(I_M4_DEPS) m4/iforeach.m4
I_M4_DEPS1=$(I_M4_DEPS) m4/ifunction.m4
+kinds.h: $(srcdir)/mk-kinds-h.sh
+ $(SHELL) $(srcdir)/mk-kinds-h.sh '$(FCCOMPILE)' > $@
+
selected_int_kind.inc: $(srcdir)/mk-sik-inc.sh
$(SHELL) $(srcdir)/mk-sik-inc.sh '$(FCCOMPILE)' > $@
Index: libgfortran/configure.ac
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/configure.ac,v
retrieving revision 1.27
diff -p -u -r1.27 configure.ac
--- libgfortran/configure.ac 21 May 2005 06:44:50 -0000 1.27
+++ libgfortran/configure.ac 6 Jun 2005 20:54:24 -0000
@@ -158,7 +158,7 @@ AC_TYPE_OFF_T
AC_STDC_HEADERS
AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
-AC_CHECK_HEADERS(sys/mman.h sys/types.h sys/stat.h ieeefp.h)
+AC_CHECK_HEADERS(sys/mman.h sys/types.h sys/stat.h ieeefp.h sunmath.h)
AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
AC_CHECK_MEMBERS([struct stat.st_blksize])
@@ -169,7 +169,7 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
AC_CHECK_LIB([m],[csin],[need_math="no"],[need_math="yes"])
# Check for library functions.
-AC_CHECK_FUNCS(getrusage times mkstemp strtof snprintf ftruncate chsize)
+AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
AC_CHECK_FUNCS(sleep time)
@@ -195,6 +195,7 @@ AC_CHECK_LIB([m],[frexpf],[AC_DEFINE([HA
AC_CHECK_LIB([m],[hypotf],[AC_DEFINE([HAVE_HYPOTF],[1],[libm includes hypotf])])
AC_CHECK_LIB([m],[logf],[AC_DEFINE([HAVE_LOGF],[1],[libm includes logf])])
AC_CHECK_LIB([m],[log10f],[AC_DEFINE([HAVE_LOG10F],[1],[libm includes log10f])])
+AC_CHECK_LIB([m],[log10l],[AC_DEFINE([HAVE_LOG10L],[1],[libm includes log10l])])
AC_CHECK_LIB([m],[nextafter],[AC_DEFINE([HAVE_NEXTAFTER],[1],[libm includes nextafter])])
AC_CHECK_LIB([m],[nextafterf],[AC_DEFINE([HAVE_NEXTAFTERF],[1],[libm includes nextafterf])])
AC_CHECK_LIB([m],[powf],[AC_DEFINE([HAVE_POWF],[1],[libm includes powf])])
@@ -227,6 +228,8 @@ AC_CHECK_LIB([m],[ynf],[AC_DEFINE([HAVE_
# Fallback in case isfinite is not available.
AC_CHECK_LIB([m],[finite],[AC_DEFINE([HAVE_FINITE],[1],[libm includes finite])])
+AC_CHECK_LIB([sunmath],[log10l],[AC_DEFINE([HAVE_LOG10L_IN_LIBSUNMATH],[1],[libsunmath includes log10l])])
+AC_CHECK_LIB([sunmath],[finitel],[AC_DEFINE([HAVE_FINITEL_IN_LIBSUNMATH],[1],[libsunmath includes finitel])])
# Let the user override this
AC_ARG_ENABLE(cmath,
Index: libgfortran/libgfortran.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/libgfortran.h,v
retrieving revision 1.24
diff -p -u -r1.24 libgfortran.h
--- libgfortran/libgfortran.h 30 Apr 2005 20:51:29 -0000 1.24
+++ libgfortran/libgfortran.h 6 Jun 2005 20:54:24 -0000
@@ -197,20 +197,7 @@ isfinite (double x)
#define IMAGPART(z) (__imag__(z))
#define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
-typedef int8_t GFC_INTEGER_1;
-typedef int16_t GFC_INTEGER_2;
-typedef int32_t GFC_INTEGER_4;
-typedef int64_t GFC_INTEGER_8;
-typedef uint8_t GFC_UINTEGER_1;
-typedef uint16_t GFC_UINTEGER_2;
-typedef uint32_t GFC_UINTEGER_4;
-typedef uint64_t GFC_UINTEGER_8;
-typedef GFC_INTEGER_4 GFC_LOGICAL_4;
-typedef GFC_INTEGER_8 GFC_LOGICAL_8;
-typedef float GFC_REAL_4;
-typedef double GFC_REAL_8;
-typedef complex float GFC_COMPLEX_4;
-typedef complex double GFC_COMPLEX_8;
+#include "kinds.h"
/* The following two definitions must be consistent with the types used
by the compiler. */
@@ -384,10 +371,10 @@ internal_proto(get_args);
/* error.c */
-extern char *gfc_itoa (int64_t);
+extern char *gfc_itoa (GFC_INTEGER_LARGEST);
internal_proto(gfc_itoa);
-extern char *xtoa (uint64_t);
+extern char *xtoa (GFC_UINTEGER_LARGEST);
internal_proto(xtoa);
extern void os_error (const char *) __attribute__ ((noreturn));
Index: libgfortran/io/io.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/io.h,v
retrieving revision 1.20
diff -p -u -r1.20 io.h
--- libgfortran/io/io.h 15 May 2005 12:49:40 -0000 1.20
+++ libgfortran/io/io.h 6 Jun 2005 20:54:24 -0000
@@ -562,10 +562,10 @@ internal_proto(next_record);
/* read.c */
-extern void set_integer (void *, int64_t, int);
+extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
internal_proto(set_integer);
-extern uint64_t max_value (int, int);
+extern GFC_UINTEGER_LARGEST max_value (int, int);
internal_proto(max_value);
extern int convert_real (void *, const char *, int);
Index: libgfortran/io/list_read.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/list_read.c,v
retrieving revision 1.22
diff -p -u -r1.22 list_read.c
--- libgfortran/io/list_read.c 17 May 2005 16:54:51 -0000 1.22
+++ libgfortran/io/list_read.c 6 Jun 2005 20:54:24 -0000
@@ -344,7 +344,7 @@ convert_integer (int length, int negativ
{
char c, *buffer, message[100];
int m;
- int64_t v, max, max10;
+ GFC_INTEGER_LARGEST v, max, max10;
buffer = saved_string;
v = 0;
Index: libgfortran/io/read.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/read.c,v
retrieving revision 1.9
diff -p -u -r1.9 read.c
--- libgfortran/io/read.c 10 May 2005 08:34:58 -0000 1.9
+++ libgfortran/io/read.c 6 Jun 2005 20:54:24 -0000
@@ -43,21 +43,26 @@ Boston, MA 02111-1307, USA. */
* actually place the value into memory. */
void
-set_integer (void *dest, int64_t value, int length)
+set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
{
switch (length)
{
+#ifdef HAVE_GFC_INTEGER_16
+ case 16:
+ *((GFC_INTEGER_16 *) dest) = value;
+ break;
+#endif
case 8:
- *((int64_t *) dest) = value;
+ *((GFC_INTEGER_8 *) dest) = value;
break;
case 4:
- *((int32_t *) dest) = value;
+ *((GFC_INTEGER_4 *) dest) = value;
break;
case 2:
- *((int16_t *) dest) = value;
+ *((GFC_INTEGER_2 *) dest) = value;
break;
case 1:
- *((int8_t *) dest) = value;
+ *((GFC_INTEGER_1 *) dest) = value;
break;
default:
internal_error ("Bad integer kind");
@@ -68,13 +73,24 @@ set_integer (void *dest, int64_t value,
/* max_value()-- Given a length (kind), return the maximum signed or
* unsigned value */
-uint64_t
+GFC_UINTEGER_LARGEST
max_value (int length, int signed_flag)
{
- uint64_t value;
+ GFC_UINTEGER_LARGEST value;
+ int n;
switch (length)
{
+#if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10
+ case 16:
+ case 10:
+ value = 1;
+ for (n = 1; n < 4 * length; n++)
+ value = (value << 2) + 3;
+ if (! signed_flag)
+ value = 2*value+1;
+ break;
+#endif
case 8:
value = signed_flag ? 0x7fffffffffffffff : 0xffffffffffffffff;
break;
@@ -108,16 +124,26 @@ convert_real (void *dest, const char *bu
switch (length)
{
case 4:
- *((float *) dest) =
+ *((GFC_REAL_4 *) dest) =
#if defined(HAVE_STRTOF)
strtof (buffer, NULL);
#else
- (float) strtod (buffer, NULL);
+ (GFC_REAL_4) strtod (buffer, NULL);
#endif
break;
case 8:
- *((double *) dest) = strtod (buffer, NULL);
+ *((GFC_REAL_8 *) dest) = strtod (buffer, NULL);
+ break;
+#if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD)
+ case 10:
+ *((GFC_REAL_10 *) dest) = strtold (buffer, NULL);
+ break;
+#endif
+#if defined(HAVE_GFC_REAL_16) && defined (HAVE_STRTOLD)
+ case 16:
+ *((GFC_REAL_16 *) dest) = strtold (buffer, NULL);
break;
+#endif
default:
internal_error ("Unsupported real kind during IO");
}
@@ -164,11 +190,11 @@ read_l (fnode * f, char *dest, int lengt
{
case 't':
case 'T':
- set_integer (dest, 1, length);
+ set_integer (dest, (GFC_INTEGER_LARGEST) 1, length);
break;
case 'f':
case 'F':
- set_integer (dest, 0, length);
+ set_integer (dest, (GFC_INTEGER_LARGEST) 0, length);
break;
default:
bad:
@@ -263,8 +289,9 @@ next_char (char **p, int *w)
void
read_decimal (fnode * f, char *dest, int length)
{
- unsigned value, maxv, maxv_10;
- int v, w, negative;
+ GFC_UINTEGER_LARGEST value, maxv, maxv_10;
+ GFC_INTEGER_LARGEST v;
+ int w, negative;
char c, *p;
w = f->u.w;
@@ -275,7 +302,7 @@ read_decimal (fnode * f, char *dest, int
p = eat_leading_spaces (&w, p);
if (w == 0)
{
- set_integer (dest, 0, length);
+ set_integer (dest, (GFC_INTEGER_LARGEST) 0, length);
return;
}
@@ -324,7 +351,7 @@ read_decimal (fnode * f, char *dest, int
value += c;
}
- v = (signed int) value;
+ v = value;
if (negative)
v = -v;
@@ -350,8 +377,9 @@ read_decimal (fnode * f, char *dest, int
void
read_radix (fnode * f, char *dest, int length, int radix)
{
- unsigned value, maxv, maxv_r;
- int v, w, negative;
+ GFC_UINTEGER_LARGEST value, maxv, maxv_r;
+ GFC_INTEGER_LARGEST v;
+ int w, negative;
char c, *p;
w = f->u.w;
@@ -362,7 +390,7 @@ read_radix (fnode * f, char *dest, int l
p = eat_leading_spaces (&w, p);
if (w == 0)
{
- set_integer (dest, 0, length);
+ set_integer (dest, (GFC_INTEGER_LARGEST) 0, length);
return;
}
@@ -460,7 +488,7 @@ read_radix (fnode * f, char *dest, int l
value += c;
}
- v = (signed int) value;
+ v = value;
if (negative)
v = -v;
@@ -508,12 +536,24 @@ read_f (fnode * f, char *dest, int lengt
switch (length)
{
case 4:
- *((float *) dest) = 0.0f;
+ *((GFC_REAL_4 *) dest) = 0.0f;
break;
case 8:
- *((double *) dest) = 0.0;
+ *((GFC_REAL_8 *) dest) = 0.0;
+ break;
+
+#ifdef HAVE_GFC_REAL_10
+ case 10:
+ *((GFC_REAL_10 *) dest) = 0.0;
+ break;
+#endif
+
+#ifdef HAVE_GFC_REAL_16
+ case 16:
+ *((GFC_REAL_16 *) dest) = 0.0;
break;
+#endif
default:
internal_error ("Unsupported real kind during IO");
Index: libgfortran/io/write.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/write.c,v
retrieving revision 1.38
diff -p -u -r1.38 write.c
--- libgfortran/io/write.c 22 May 2005 21:17:42 -0000 1.38
+++ libgfortran/io/write.c 6 Jun 2005 20:54:24 -0000
@@ -37,6 +37,9 @@ Boston, MA 02111-1307, USA. */
#include "libgfortran.h"
#include "io.h"
+#if HAVE_SUNMATH_H
+#include <sunmath.h>
+#endif
#define star_fill(p, n) memset(p, '*', n)
@@ -69,10 +72,10 @@ write_a (fnode * f, const char *source,
}
}
-static int64_t
+static GFC_INTEGER_LARGEST
extract_int (const void *p, int len)
{
- int64_t i = 0;
+ GFC_INTEGER_LARGEST i = 0;
if (p == NULL)
return i;
@@ -80,17 +83,22 @@ extract_int (const void *p, int len)
switch (len)
{
case 1:
- i = *((const int8_t *) p);
+ i = *((const GFC_INTEGER_1 *) p);
break;
case 2:
- i = *((const int16_t *) p);
+ i = *((const GFC_INTEGER_2 *) p);
break;
case 4:
- i = *((const int32_t *) p);
+ i = *((const GFC_INTEGER_4 *) p);
break;
case 8:
- i = *((const int64_t *) p);
+ i = *((const GFC_INTEGER_8 *) p);
+ break;
+#ifdef HAVE_GFC_INTEGER_16
+ case 16:
+ i = *((const GFC_INTEGER_16 *) p);
break;
+#endif
default:
internal_error ("bad integer kind");
}
@@ -98,23 +106,32 @@ extract_int (const void *p, int len)
return i;
}
-static double
+static GFC_REAL_LARGEST
extract_real (const void *p, int len)
{
- double i = 0.0;
+ GFC_REAL_LARGEST i = 0;
switch (len)
{
case 4:
- i = *((const float *) p);
+ i = *((const GFC_REAL_4 *) p);
break;
case 8:
- i = *((const double *) p);
+ i = *((const GFC_REAL_8 *) p);
+ break;
+#ifdef HAVE_GFC_REAL_10
+ case 10:
+ i = *((const GFC_REAL_10 *) p);
break;
+#endif
+#ifdef HAVE_GFC_REAL_16
+ case 16:
+ i = *((const GFC_REAL_16 *) p);
+ break;
+#endif
default:
internal_error ("bad real kind");
}
return i;
-
}
@@ -148,11 +165,11 @@ calculate_sign (int negative_flag)
/* Returns the value of 10**d. */
-static double
+static GFC_REAL_LARGEST
calculate_exp (int d)
{
int i;
- double r = 1.0;
+ GFC_REAL_LARGEST r = 1.0;
for (i = 0; i< (d >= 0 ? d : -d); i++)
r *= 10;
@@ -181,13 +198,13 @@ calculate_exp (int d)
for Gw.dEe, n' ' means e+2 blanks */
static fnode *
-calculate_G_format (fnode *f, double value, int *num_blank)
+calculate_G_format (fnode *f, GFC_REAL_LARGEST value, int *num_blank)
{
int e = f->u.real.e;
int d = f->u.real.d;
int w = f->u.real.w;
fnode *newf;
- double m, exp_d;
+ GFC_REAL_LARGEST m, exp_d;
int low, high, mid;
int ubound, lbound;
@@ -199,8 +216,8 @@ calculate_G_format (fnode *f, double val
/* In case of the two data magnitude ranges,
generate E editing, Ew.d[Ee]. */
exp_d = calculate_exp (d);
- if ((m > 0.0 && m < 0.1 - 0.05 / (double) exp_d)
- || (m >= (double) exp_d - 0.5 ))
+ if ((m > 0.0 && m < 0.1 - 0.05 / (GFC_REAL_LARGEST) exp_d)
+ || (m >= (GFC_REAL_LARGEST) exp_d - 0.5 ))
{
newf->format = FMT_E;
newf->u.real.w = w;
@@ -219,7 +236,7 @@ calculate_G_format (fnode *f, double val
while (low <= high)
{
- double temp;
+ GFC_REAL_LARGEST temp;
mid = (low + high) / 2;
/* 0.1 * 10**mid - 0.5 * 10**(mid-d-1) */
@@ -271,7 +288,7 @@ calculate_G_format (fnode *f, double val
/* Output a real number according to its format which is FMT_G free. */
static void
-output_float (fnode *f, double value)
+output_float (fnode *f, GFC_REAL_LARGEST value)
{
/* This must be large enough to accurately hold any value. */
char buffer[32];
@@ -296,7 +313,7 @@ output_float (fnode *f, double value)
int nblanks;
int i;
sign_t sign;
- double abslog;
+ GFC_REAL_LARGEST abslog;
ft = f->format;
w = f->u.real.w;
@@ -321,11 +338,28 @@ output_float (fnode *f, double value)
edigits = 2;
else
{
+#if defined (HAVE_GFC_REAL_10) || defined (HAVE_GFC_REAL_16)
+# if HAVE_LOG10L || HAVE_LOG10L_IN_LIBSUNMATH
+ abslog = fabs(log10l (value));
+# else
+ extern long double __log10l (long double);
+ abslog = fabs(__log10l (value));
+# endif
+#else
abslog = fabs(log10 (value));
+#endif
if (abslog < 100)
edigits = 2;
else
+#if defined (HAVE_GFC_REAL_10) || defined (HAVE_GFC_REAL_16)
+# if HAVE_LOG10L || HAVE_LOG10L_IN_LIBSUNMATH
+ edigits = 1 + (int) log10l (abslog);
+# else
+ edigits = 1 + (int) __log10l (abslog);
+# endif
+#else
edigits = 1 + (int) log10 (abslog);
+#endif
}
if (ft == FMT_F || ft == FMT_EN
@@ -346,7 +380,24 @@ output_float (fnode *f, double value)
ndigits = 27 - edigits;
}
- sprintf (buffer, "%+-#31.*e", ndigits - 1, value);
+ /* # The result will always contain a decimal point, even if no
+ * digits follow it
+ *
+ * - The converted value is to be left adjusted on the field boundary
+ *
+ * + A sign (+ or -) always be placed before a number
+ *
+ * 31 minimum field width
+ *
+ * * (ndigits-1) is used as the precision
+ *
+ * e format: [-]d.ddde±dd where there is one digit before the
+ * decimal-point character and the number of digits after it is
+ * equal to the precision. The exponent always contains at least two
+ * digits; if the value is zero, the exponent is 00.
+ */
+ sprintf (buffer, "%+-#31.*" GFC_REAL_LARGEST_FORMAT "e",
+ ndigits - 1, value);
/* Check the resulting string has punctuation in the correct places. */
if (buffer[2] != '.' || buffer[ndigits + 2] != 'e')
@@ -673,7 +724,7 @@ void
write_l (fnode * f, char *source, int len)
{
char *p;
- int64_t n;
+ GFC_INTEGER_LARGEST n;
p = write_block (f->u.w);
if (p == NULL)
@@ -689,7 +740,7 @@ write_l (fnode * f, char *source, int le
static void
write_float (fnode *f, const char *source, int len)
{
- double n;
+ GFC_REAL_LARGEST n;
int nb =0, res, save_scale_factor;
char * p, fin;
fnode *f2 = NULL;
@@ -698,7 +749,11 @@ write_float (fnode *f, const char *sourc
if (f->format != FMT_B && f->format != FMT_O && f->format != FMT_Z)
{
+#if (HAVE_GFC_REAL_10 || HAVE_GFC_REAL_16) && HAVE_FINITEL
+ res = finitel (n);
+#else
res = isfinite (n);
+#endif
if (res == 0)
{
nb = f->u.real.w;
@@ -756,10 +811,11 @@ write_float (fnode *f, const char *sourc
static void
-write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t))
+write_int (fnode *f, const char *source, int len,
+ char *(*conv) (GFC_UINTEGER_LARGEST))
{
- uint32_t ns =0;
- uint64_t n = 0;
+//FXC uint32_t ns =0;
+ GFC_UINTEGER_LARGEST n = 0;
int w, m, digits, nzero, nblank;
char *p, *q;
@@ -784,12 +840,12 @@ write_int (fnode *f, const char *source,
}
- if (len < 8)
- {
- ns = n;
- q = conv (ns);
- }
- else
+//FXC if (len < 8)
+// {
+// ns = n;
+// q = conv (ns);
+// }
+// else
q = conv (n);
digits = strlen (q);
@@ -842,9 +898,10 @@ write_int (fnode *f, const char *source,
}
static void
-write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t))
+write_decimal (fnode *f, const char *source, int len,
+ char *(*conv) (GFC_INTEGER_LARGEST))
{
- int64_t n = 0;
+ GFC_INTEGER_LARGEST n = 0;
int w, m, digits, nsign, nzero, nblank;
char *p, *q;
sign_t sign;
@@ -930,7 +987,7 @@ write_decimal (fnode *f, const char *sou
/* Convert unsigned octal to ascii. */
static char *
-otoa (uint64_t n)
+otoa (GFC_UINTEGER_LARGEST n)
{
char *p;
@@ -958,7 +1015,7 @@ otoa (uint64_t n)
/* Convert unsigned binary to ascii. */
static char *
-btoa (uint64_t n)
+btoa (GFC_UINTEGER_LARGEST n)
{
char *p;
Index: libgfortran/runtime/error.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/runtime/error.c,v
retrieving revision 1.9
diff -p -u -r1.9 error.c
--- libgfortran/runtime/error.c 12 Jan 2005 21:27:31 -0000 1.9
+++ libgfortran/runtime/error.c 6 Jun 2005 20:54:25 -0000
@@ -69,11 +69,11 @@ static char buffer[32]; /* buffer for i
/* Returns a pointer to a static buffer. */
char *
-gfc_itoa (int64_t n)
+gfc_itoa (GFC_INTEGER_LARGEST n)
{
int negative;
char *p;
- uint64_t t;
+ GFC_UINTEGER_LARGEST t;
if (n == 0)
{
@@ -109,7 +109,7 @@ gfc_itoa (int64_t n)
* static buffer. */
char *
-xtoa (uint64_t n)
+xtoa (GFC_UINTEGER_LARGEST n)
{
int digit;
char *p;
Index: gcc/testsuite/lib/target-supports.exp
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/testsuite/lib/target-supports.exp,v
retrieving revision 1.58
diff -r1.58 target-supports.exp
412a413,488
> # Return 1 if the target supports Fortran real kinds larger than real(8),
> # 0 otherwise. Cache the result.
>
> proc check_effective_target_fortran_large_real { } {
> global et_fortran_large_real_saved
> global tool
>
> if [info exists et_fortran_large_real_saved] {
> verbose "check_effective_target_fortran_large_real returning saved $et_fortran_large_real_saved" 2
> } else {
> set et_fortran_large_real_saved 0
>
> # Set up, compile, and execute a test program using large real
> # kinds. Include the current process ID in the file names to
> # prevent conflicts with invocations for multiple testsuites.
> set src real[pid].f90
> set exe real[pid].x
>
> set f [open $src "w"]
> puts $f "integer,parameter :: k = &"
> puts $f " selected_real_kind (precision (0.0_8) + 1)"
> puts $f "real(kind=k) :: x"
> puts $f "end"
> close $f
>
> verbose "check_effective_target_fortran_large_real compiling testfile $src" 2
> set lines [${tool}_target_compile $src $exe executable ""]
> file delete $src
>
> if [string match "" $lines] then {
> # No error message, compilation succeeded.
> set et_fortran_large_real_saved 1
> }
> }
>
> return $et_fortran_large_real_saved
> }
>
> # Return 1 if the target supports Fortran integer kinds larger than
> # integer(8), 0 otherwise. Cache the result.
>
> proc check_effective_target_fortran_large_int { } {
> global et_fortran_large_int_saved
> global tool
>
> if [info exists et_fortran_large_int_saved] {
> verbose "check_effective_target_fortran_large_int returning saved $et_fortran_large_int_saved" 2
> } else {
> set et_fortran_large_int_saved 0
>
> # Set up, compile, and execute a test program using large integer
> # kinds. Include the current process ID in the file names to
> # prevent conflicts with invocations for multiple testsuites.
> set src int[pid].f90
> set exe int[pid].x
>
> set f [open $src "w"]
> puts $f "integer,parameter :: k = &"
> puts $f " selected_int_kind (range (0_8) + 1)"
> puts $f "integer(kind=k) :: i"
> puts $f "end"
> close $f
>
> verbose "check_effective_target_fortran_large_int compiling testfile $src" 2
> set lines [${tool}_target_compile $src $exe executable ""]
> file delete $src
>
> if [string match "" $lines] then {
> # No error message, compilation succeeded.
> set et_fortran_large_int_saved 1
> }
> }
>
> return $et_fortran_large_int_saved
> }
>
! { dg-do run }
! { dg-require-effective-target fortran_large_int }
module testmod
integer,parameter :: k = selected_int_kind (range (0_8) + 1)
contains
subroutine testoutput (a,b,length,f)
integer(kind=k),intent(in) :: a
integer(kind=8),intent(in) :: b
integer,intent(in) :: length
character(len=*),intent(in) :: f
character(len=length) :: ca
character(len=length) :: cb
write (ca,f) a
write (cb,f) b
if (ca /= cb) call abort
end subroutine testoutput
subroutine outputstring (a,f,s)
integer(kind=k),intent(in) :: a
character(len=*),intent(in) :: f
character(len=*),intent(in) :: s
character(len=len(s)) :: c
write (c,f) a
if (c /= s) call abort
end subroutine outputstring
end module testmod
! Testing I/O of large integer kinds (larger than kind=8)
program test
use testmod
implicit none
integer(kind=k) :: x
character(len=20) :: c1, c2
end program test
! { dg-do run }
! { dg-require-effective-target fortran_large_real }
module testmod
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
contains
subroutine testoutput (a,b,length,f)
real(kind=k),intent(in) :: a
real(kind=8),intent(in) :: b
integer,intent(in) :: length
character(len=*),intent(in) :: f
character(len=length) :: ca
character(len=length) :: cb
write (ca,f) a
write (cb,f) b
if (ca /= cb) call abort
end subroutine testoutput
subroutine outputstring (a,f,s)
real(kind=k),intent(in) :: a
character(len=*),intent(in) :: f
character(len=*),intent(in) :: s
character(len=len(s)) :: c
write (c,f) a
if (c /= s) call abort
end subroutine outputstring
end module testmod
! Testing I/O of large real kinds (larger than kind=8)
program test
use testmod
implicit none
real(kind=k) :: x
character(len=20) :: c1, c2
call testoutput (0.0_k,0.0_8,40,'(F40.35)')
call testoutput (1.0_k,1.0_8,40,'(F40.35)')
call testoutput (0.1_k,0.1_8,15,'(F15.10)')
call testoutput (1e10_k,1e10_8,15,'(F15.10)')
call testoutput (7.51e100_k,7.51e100_8,15,'(F15.10)')
call testoutput (1e-10_k,1e-10_8,15,'(F15.10)')
call testoutput (7.51e-100_k,7.51e-100_8,15,'(F15.10)')
call testoutput (-1.0_k,-1.0_8,40,'(F40.35)')
call testoutput (-0.1_k,-0.1_8,15,'(F15.10)')
call testoutput (-1e10_k,-1e10_8,15,'(F15.10)')
call testoutput (-7.51e100_k,-7.51e100_8,15,'(F15.10)')
call testoutput (-1e-10_k,-1e-10_8,15,'(F15.10)')
call testoutput (-7.51e-100_k,-7.51e-100_8,15,'(F15.10)')
x = huge(x)
call outputstring (2*x,'(F20.15)',' +Infinity')
call outputstring (-2*x,'(F20.15)',' -Infinity')
write (c1,'(G20.10E5)') x
write (c2,'(G20.10E5)') -x
if (c2(1:1) /= '-') call abort
c2(1:1) = ' '
if (c1 /= c2) call abort
x = tiny(x)
call outputstring (x,'(F20.15)',' 0.000000000000000')
call outputstring (-x,'(F20.15)',' 0.000000000000000')
write (c1,'(G20.10E5)') x
write (c2,'(G20.10E5)') -x
if (c2(1:1) /= '-') call abort
c2(1:1) = ' '
if (c1 /= c2) call abort
end program test
Attachment:
mk-kinds-h.sh
Description: Bourne shell script
2005-06-06 Francois-Xavier Coudert <coudert@clipper.ens.fr> * Makefile.am: Use mk-kinds-h.sh to generate header kinds.h with all Fortran kinds available. * configure.ac: Check for sunmath.h. Check for strtold, log10l, and finitel. * Makefile.in: Regenerate. * aclocal.m4: Regenerate. * configure: Regenerate. * config.h.in: Regenerate. * libgfortran.h: Use generated kinds.h to define GFC_INTEGER_*, GFC_UINTEGER_*, GFC_LOGICAL_*, GFC_REAL_*, GFC_COMPLEX_*. Update prototypes for gfc_itoa and xtoa. * io/io.h: Update prototypes for set_integer and max_value. * io/list_read.c (convert_integer): Use new GFC_(INTEGER|REAL)_LARGEST type. * io/read.c (set_integer): Likewise. (max_value): Likewise. (convert_real): Likewise. (real_l): Likewise. (next_char): Likewise. (read_decimal): Likewise. (read_radix): Likewise. (read_f): Likewise. * io/write.c: Use sunmath.h when available. (extract_int): Use new GFC_INTEGER_LARGEST type. (extract_real): Use new GFC_REAL_LARGEST type. (calculate_exp): Likewise. (calculate_G_format): Likewise. (output_float): Likewise. Use log10l for long double values. Add comment for sprintf format. Use GFC_REAL_LARGEST_FORMAT. (write_l): Use new GFC_INTEGER_LARGEST type. (write_float): Use new GFC_REAL_LARGEST type. Use finitel for long double values when available. (write_int): Remove useless special case for (len < 8). (write_decimal): Use GFC_INTEGER_LARGEST. (otoa): Use GFC_UINTEGER_LARGEST as argument. (btoa): Use GFC_UINTEGER_LARGEST as argument. * runtime/error.c (gfc_itoa): Use GFC_INTEGER_LARGEST as argument. (xtoa): Use GFC_UINTEGER_LARGEST as argument. 2005-06-06 Francois-Xavier Coudert <coudert@clipper.ens.fr> * lib/target-supports.exp: Add check_effective_target_fortran_large_real and check_effective_target_fortran_large_int to check for corresponding effective targets.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |