diff options
author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2005-06-23 20:50:25 +0200 |
---|---|---|
committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2005-06-23 18:50:25 +0000 |
commit | 32aa3bffc3be895994b3fa8a35c4c7d66e5fc8c6 (patch) | |
tree | ff58180369190fdcfc2adfcd84037e51fead61ad /libgfortran/intrinsics | |
parent | 462ec41561b714df3641e9b0f54e9f0b8bac4ef1 (diff) | |
download | gcc-32aa3bffc3be895994b3fa8a35c4c7d66e5fc8c6.zip gcc-32aa3bffc3be895994b3fa8a35c4c7d66e5fc8c6.tar.gz gcc-32aa3bffc3be895994b3fa8a35c4c7d66e5fc8c6.tar.bz2 |
c99_functions.c (log10l): New log10l function for systems where this is not available.
* intrinsics/c99_functions.c (log10l): New log10l function for
systems where this is not available.
* c99_protos.h: Prototype for log10l function.
* 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 (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.
(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.
* Makefile.am: Use mk-kinds-h.sh to generate header kinds.h
with all Fortran kinds available.
* configure.ac: Check for strtold and log10l.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* configure: Regenerate.
* config.h.in: Regenerate.
* mk-kinds-h.sh: Configuration script for available integer
and real kinds.
* lib/target-supports.exp: Add
check_effective_target_fortran_large_real and
check_effective_target_fortran_large_int to check for
corresponding effective targets.
* gfortran.dg/large_integer_kind_1.f90: New test.
* gfortran.dg/large_real_kind_1.f90: New test.
From-SVN: r101274
Diffstat (limited to 'libgfortran/intrinsics')
-rw-r--r-- | libgfortran/intrinsics/c99_functions.c | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/libgfortran/intrinsics/c99_functions.c b/libgfortran/intrinsics/c99_functions.c index dfdb71e..c4b5720 100644 --- a/libgfortran/intrinsics/c99_functions.c +++ b/libgfortran/intrinsics/c99_functions.c @@ -371,3 +371,41 @@ roundf(float x) } } #endif + +#ifndef HAVE_LOG10L +/* log10 function for long double variables. The version provided here + reduces the argument until it fits into a double, then use log10. */ +long double +log10l(long double x) +{ +#if LDBL_MAX_EXP > DBL_MAX_EXP + if (x > DBL_MAX) + { + double val; + int p2_result = 0; + if (x > 0x1p16383L) { p2_result += 16383; x /= 0x1p16383L; } + if (x > 0x1p8191L) { p2_result += 8191; x /= 0x1p8191L; } + if (x > 0x1p4095L) { p2_result += 4095; x /= 0x1p4095L; } + if (x > 0x1p2047L) { p2_result += 2047; x /= 0x1p2047L; } + if (x > 0x1p1023L) { p2_result += 1023; x /= 0x1p1023L; } + val = log10 ((double) x); + return (val + p2_result * .30102999566398119521373889472449302L); + } +#endif +#if LDBL_MIN_EXP < DBL_MIN_EXP + if (x < DBL_MIN) + { + double val; + int p2_result = 0; + if (x < 0x1p-16380L) { p2_result += 16380; x /= 0x1p-16380L; } + if (x < 0x1p-8189L) { p2_result += 8189; x /= 0x1p-8189L; } + if (x < 0x1p-4093L) { p2_result += 4093; x /= 0x1p-4093L; } + if (x < 0x1p-2045L) { p2_result += 2045; x /= 0x1p-2045L; } + if (x < 0x1p-1021L) { p2_result += 1021; x /= 0x1p-1021L; } + val = fabs(log10 ((double) x)); + return (- val - p2_result * .30102999566398119521373889472449302L); + } +#endif + return log10 (x); +} +#endif |