Tested on hppa64-hp-hpux11.11. Okay?
Dave --- libgfortran: Implement c99 functions strnlen, frexpl and scalbnl Fixes libgfortran build and gfortran test failures on hppa64-hp-hpux11.11. These functions are required for minimal REAL16 support. The frexpl and scalbnl functions are derived from libquadmath implementations. 2026-06-10 John David Anglin <[email protected]> libgfortran/ChangeLog: PR libfortran/125623 * c99_protos.h: (strnlen, frexpl, scalbnl): Declare if HAVE_STRNLEN, HAVE_FREXPL, HAVE_SCALBNL aren't defined, respectively. * intrinsics/c99_functions.c (strnlen, frexpl, scalbnl): Implement. * libgfortran.h: Include string.h if HAVE_STRING_H. diff --git a/libgfortran/c99_protos.h b/libgfortran/c99_protos.h index fb439bcb555..952b251c31a 100644 --- a/libgfortran/c99_protos.h +++ b/libgfortran/c99_protos.h @@ -25,6 +25,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #ifndef C99_PROTOS_H #define C99_PROTOS_H 1 +/* string functions */ +#ifndef HAVE_STRNLEN +#define HAVE_STRNLEN 1 +extern size_t strnlen(const char *, size_t); +#endif + /* float variants of libm functions */ #ifndef HAVE_ACOSF #define HAVE_ACOSF 1 @@ -136,6 +142,11 @@ extern long double fmodl (long double x, long double y); extern float frexpf(float, int *); #endif +#ifndef HAVE_FREXPL +#define HAVE_FREXPL 1 +extern long double frexpl(long double, int *); +#endif + #ifndef HAVE_HYPOTF #define HAVE_HYPOTF 1 extern float hypotf(float, float); @@ -161,6 +172,11 @@ extern double scalbn(double, int); extern float scalbnf(float, int); #endif +#ifndef HAVE_SCALBNL +#define HAVE_SCALBNL 1 +extern long double scalbnl(long double, int); +#endif + #ifndef HAVE_SINF #define HAVE_SINF 1 extern float sinf(float); diff --git a/libgfortran/intrinsics/c99_functions.c b/libgfortran/intrinsics/c99_functions.c index 20ac200323a..28acadb5f9f 100644 --- a/libgfortran/intrinsics/c99_functions.c +++ b/libgfortran/intrinsics/c99_functions.c @@ -45,10 +45,154 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #define IMAGPART(z) (__imag__(z)) #define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);} - /* Prototypes are included to silence -Wstrict-prototypes -Wmissing-prototypes. */ +/* Main union type we use to manipulate the floating-point type. */ +typedef union +{ + long double value; + + struct +#ifdef __MINGW32__ + /* On mingw targets the ms-bitfields option is active by default. + Therefore enforce gnu-bitfield style. */ + __attribute__ ((gcc_struct)) +#endif + { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + unsigned negative:1; + unsigned exponent:15; + unsigned mantissa0:16; + unsigned mantissa1:32; + unsigned mantissa2:32; + unsigned mantissa3:32; +#else + unsigned mantissa3:32; + unsigned mantissa2:32; + unsigned mantissa1:32; + unsigned mantissa0:16; + unsigned exponent:15; + unsigned negative:1; +#endif + } ieee; + + struct + { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + uint64_t high; + uint64_t low; +#else + uint64_t low; + uint64_t high; +#endif + } words64; + + struct + { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + uint32_t w0; + uint32_t w1; + uint32_t w2; + uint32_t w3; +#else + uint32_t w3; + uint32_t w2; + uint32_t w1; + uint32_t w0; +#endif + } words32; + + struct +#ifdef __MINGW32__ + /* Make sure we are using gnu-style bitfield handling. */ + __attribute__ ((gcc_struct)) +#endif + { +#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ + unsigned negative:1; + unsigned exponent:15; + unsigned quiet_nan:1; + unsigned mantissa0:15; + unsigned mantissa1:32; + unsigned mantissa2:32; + unsigned mantissa3:32; +#else + unsigned mantissa3:32; + unsigned mantissa2:32; + unsigned mantissa1:32; + unsigned mantissa0:15; + unsigned quiet_nan:1; + unsigned exponent:15; + unsigned negative:1; +#endif + } ieee_nan; + +} ieee754_long_double; + + +/* Get two 64 bit ints from a long double. */ +#define GET_LDOUBLE_WORDS64(ix0,ix1,d) \ +do { \ + ieee754_long_double u; \ + u.value = (d); \ + (ix0) = u.words64.high; \ + (ix1) = u.words64.low; \ +} while (0) + +/* Set a long double from two 64 bit ints. */ +#define SET_LDOUBLE_WORDS64(d,ix0,ix1) \ +do { \ + ieee754_long_double u; \ + u.words64.high = (ix0); \ + u.words64.low = (ix1); \ + (d) = u.value; \ +} while (0) + +/* Get the more significant 64 bits of a long double mantissa. */ +#define GET_LDOUBLE_MSW64(v,d) \ +do { \ + ieee754_long_double u; \ + u.value = (d); \ + (v) = u.words64.high; \ +} while (0) + +/* Set the more significant 64 bits of a long double mantissa from an int. */ +#define SET_LDOUBLE_MSW64(d,v) \ +do { \ + ieee754_long_double u; \ + u.value = (d); \ + u.words64.high = (v); \ + (d) = u.value; \ +} while (0) + +/* Get the least significant 64 bits of a long double mantissa. */ +#define GET_LDOUBLE_LSW64(v,d) \ +do { \ + ieee754_long_double u; \ + u.value = (d); \ + (v) = u.words64.low; \ +} while (0) + +static const long double +two114 = 2.0769187434139310514121985316880384E+34L, /* 0x4071000000000000, 0 */ +twom114 = 4.8148248609680896326399448564623183E-35L, /* 0x3F8D000000000000, 0 */ +huge = 1.0E+4900L, +tiny = 1.0E-4900L; + +/* Wrapper for systems without strnlen function. */ + +#ifndef HAVE_STRNLEN +#define HAVE_STRNLEN 1 +size_t strnlen (const char *, size_t); + +size_t +strnlen (const char *str, size_t maxlen) +{ + const char *found = memchr (str, '\0', maxlen); + return found ? (size_t) (found - str) : maxlen; +} +#endif /* Wrappers for systems without the various C99 single precision Bessel functions. */ @@ -361,6 +505,57 @@ frexpf (float x, int *exp) } #endif +#if !defined(HAVE_FREXPL) +#define HAVE_FREXPL 1 +long double frexpl (long double x, int *eptr); + +/* s_frexpl.c -- long double version of s_frexp.c. + * Conversion to IEEE quad long double by Jakub Jelinek, [email protected]. + */ + +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +long double +frexpl (long double x, int *eptr) +{ + if (sizeof (long double) == 16) + { + uint64_t hx, lx, ix; + + GET_LDOUBLE_WORDS64(hx,lx,x); + ix = 0x7fffffffffffffffULL&hx; + *eptr = 0; + if(ix >= 0x7fff000000000000ULL || ((ix|lx) == 0)) + /* 0,inf,nan */ + return x + x; + if (ix < 0x0001000000000000ULL) + { + /* subnormal */ + x *= two114; + GET_LDOUBLE_MSW64(hx,x); + ix = hx & 0x7fffffffffffffffULL; + *eptr = -114; + } + *eptr += (ix>>48) - 16382; + hx = (hx & 0x8000ffffffffffffULL) | 0x3ffe000000000000ULL; + SET_LDOUBLE_MSW64(x,hx); + return x; + } + else + /* Intel 80 bit */ + abort(); +} +#endif + #ifndef HAVE_HYPOTF #define HAVE_HYPOTF 1 float hypotf (float x, float y); @@ -420,6 +615,76 @@ scalbnf (float x, int y) } #endif +#if !defined(HAVE_SCALBNL) +#define HAVE_SCALBNL 1 +long double scalbnl (long double x, int n); + +/* s_scalbnl.c -- long double version of s_scalbn.c. + * Conversion to IEEE quad long double by Jakub Jelinek, [email protected]. + */ + +/* @(#)s_scalbn.c 5.1 93/09/24 */ +/* + * ==================================================== + * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + * + * Developed at SunPro, a Sun Microsystems, Inc. business. + * Permission to use, copy, modify, and distribute this + * software is freely granted, provided that this notice + * is preserved. + * ==================================================== + */ + +long double +scalbnl (long double x, int n) +{ + if (sizeof (long double) == 16) + { + int64_t k, hx, lx; + + GET_LDOUBLE_WORDS64(hx,lx,x); + + /* extract exponent */ + k = (hx >> 48) & 0x7fff; + if (k == 0) + { + /* 0 or subnormal x */ + if ((lx | (hx & 0x7fffffffffffffffULL)) == 0) + return x; /* +-0 */ + x *= two114; + GET_LDOUBLE_MSW64(hx,x); + k = ((hx >> 48) & 0x7fff) - 114; + } + if (k == 0x7fff) + /* NaN or Inf */ + return x+x; + if (n < -50000) + /*underflow*/ + return tiny * copysignl (tiny, x); + if (n > 50000 || k + n > 0x7ffe) + /* overflow */ + return huge * copysignl (huge, x); + /* Now k and n are bounded we know that k = k+n does not overflow. */ + k = k + n; + if (k > 0) + { + /* normal result */ + SET_LDOUBLE_MSW64(x,(hx&0x8000ffffffffffffULL)|(k<<48)); + return x; + } + if (k <= -114) + /*underflow*/ + return tiny * copysignl (tiny, x); + k += 114; /* subnormal result */ + SET_LDOUBLE_MSW64(x,(hx&0x8000ffffffffffffULL)|(k<<48)); + return x * twom114; + } + else + /* Intel 80 bit */ + abort(); +} +#endif + #ifndef HAVE_SINF #define HAVE_SINF 1 float sinf (float x); diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 10c5313e1bc..1c585ba0522 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -47,6 +56,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <stdarg.h> #include <stdbool.h> +#if HAVE_STRING_H +#include <string.h> +#endif + #if HAVE_COMPLEX_H /* Must appear before math.h on VMS systems. */ # include <complex.h>
signature.asc
Description: PGP signature
