aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIain Sandoe <iain@sandoe.co.uk>2025-03-15 22:58:46 +0000
committerIain Sandoe <iain@sandoe.co.uk>2025-04-10 11:05:07 +0100
commit95f10974a9190e345776604480a2df0191104308 (patch)
tree93d9d2f876d5f1252a31079f8efa357adf834d5d
parentf1e82c859fc205395e4f413cdc0b95f54a48ce92 (diff)
downloadgcc-95f10974a9190e345776604480a2df0191104308.zip
gcc-95f10974a9190e345776604480a2df0191104308.tar.gz
gcc-95f10974a9190e345776604480a2df0191104308.tar.bz2
libgcobol: Allow libgcobol to use libquadmath [PR119244].
Many of the changes are mechanical: 1. 'GCOB_FP128' in place of _Float128. 2. Using FP128_FUNC to represent the spelling of intrinsics. 3. Using GCOB_FP128_LITERAL() to choose the suffix for literals. This allows for: __float128 and 'q' as the suffix when libquadmath is configured. _Float128 / 'f128' when IEC-60559 is available in libc long double / 'l' when long double is ieee753 128b. Add libquadmath to libgcobol.spec and its dependencies where the platform needs it. PR cobol/119244 libgcobol/ChangeLog: * Makefile.am: Add support for libquadmath. * Makefile.in: Regenerate. * acinclude.m4: Add support for libquadmath. * config.h.in: Regenerate. * configure: Regenerate. * configure.ac: Configure libquadmath support. * gmath.cc: Use GCOB_FP128 to represent the configured 128b floating point type. Use FP128_FUNC to represent the naming of intrinsics in the configure 128b floating point type. Render literals with GCOB_FP128_LITERAL. * intrinsic.cc: Likewise. * libgcobol.cc: Likewise. * libgcobol.h: Likewise. * libgcobol-fp.h: New file. * gfileio.cc: Include libgcobol-fp.h. * libgcobol.spec.in: Add libquadmath configure output. Signed-off-by: Iain Sandoe <iain@sandoe.co.uk>
Diffstat
-rw-r--r--libgcobol/Makefile.am9
-rw-r--r--libgcobol/Makefile.in14
-rw-r--r--libgcobol/acinclude.m4162
-rw-r--r--libgcobol/config.h.in30
-rwxr-xr-xlibgcobol/configure527
-rw-r--r--libgcobol/configure.ac41
-rw-r--r--libgcobol/gfileio.cc1
-rw-r--r--libgcobol/gmath.cc108
-rw-r--r--libgcobol/intrinsic.cc186
-rw-r--r--libgcobol/libgcobol-fp.h50
-rw-r--r--libgcobol/libgcobol.cc186
-rw-r--r--libgcobol/libgcobol.h10
-rw-r--r--libgcobol/libgcobol.spec.in2
13 files changed, 1048 insertions, 278 deletions
diff --git a/libgcobol/Makefile.am b/libgcobol/Makefile.am
index 89d0519..0a17d20 100644
--- a/libgcobol/Makefile.am
+++ b/libgcobol/Makefile.am
@@ -46,7 +46,7 @@ libgcobol_la_SOURCES = \
WARN_CFLAGS = -W -Wall -Wwrite-strings
-AM_CPPFLAGS = -I. -I$(srcdir)
+AM_CPPFLAGS = -I. -I$(srcdir) $(LIBQUADINCLUDE)
AM_CFLAGS = $(XCFLAGS)
AM_CXXFLAGS = $(XCFLAGS)
AM_CXXFLAGS += $(WARN_CFLAGS)
@@ -62,9 +62,8 @@ endif
# We want to link with the c++ runtime.
libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS)
version_arg = -version-info $(LIBGCOBOL_VERSION)
-libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LTLIBICONV) \
- $(extra_ldflags_libgcobol) $(LIBS) \
- $(version_arg)
-libgcobol_la_DEPENDENCIES = libgcobol.spec
+libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \
+ $(extra_ldflags_libgcobol) $(LIBS) $(version_arg)
+libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP)
endif BUILD_LIBGCOBOL
diff --git a/libgcobol/Makefile.in b/libgcobol/Makefile.in
index 88158cb..5fdc42c 100644
--- a/libgcobol/Makefile.in
+++ b/libgcobol/Makefile.in
@@ -288,6 +288,10 @@ LIBGCOBOL_VERSION = @LIBGCOBOL_VERSION@
LIBICONV = @LIBICONV@
LIBM = @LIBM@
LIBOBJS = @LIBOBJS@
+LIBQUADINCLUDE = @LIBQUADINCLUDE@
+LIBQUADLIB = @LIBQUADLIB@
+LIBQUADLIB_DEP = @LIBQUADLIB_DEP@
+LIBQUADSPEC = @LIBQUADSPEC@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
@@ -317,6 +321,7 @@ SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
SPEC_LIBGCOBOL_DEPS = @SPEC_LIBGCOBOL_DEPS@
STRIP = @STRIP@
+USE_IEC_60559 = @USE_IEC_60559@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
@@ -402,7 +407,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
@BUILD_LIBGCOBOL_TRUE@ valconv.cc
@BUILD_LIBGCOBOL_TRUE@WARN_CFLAGS = -W -Wall -Wwrite-strings
-@BUILD_LIBGCOBOL_TRUE@AM_CPPFLAGS = -I. -I$(srcdir)
+@BUILD_LIBGCOBOL_TRUE@AM_CPPFLAGS = -I. -I$(srcdir) $(LIBQUADINCLUDE)
@BUILD_LIBGCOBOL_TRUE@AM_CFLAGS = $(XCFLAGS)
@BUILD_LIBGCOBOL_TRUE@AM_CXXFLAGS = $(XCFLAGS) $(WARN_CFLAGS) \
@BUILD_LIBGCOBOL_TRUE@ -DIN_TARGET_LIBS -fno-strict-aliasing
@@ -410,11 +415,10 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
# We want to link with the c++ runtime.
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS)
@BUILD_LIBGCOBOL_TRUE@version_arg = -version-info $(LIBGCOBOL_VERSION)
-@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LTLIBICONV) \
-@BUILD_LIBGCOBOL_TRUE@ $(extra_ldflags_libgcobol) $(LIBS) \
-@BUILD_LIBGCOBOL_TRUE@ $(version_arg)
+@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \
+@BUILD_LIBGCOBOL_TRUE@ $(extra_ldflags_libgcobol) $(LIBS) $(version_arg)
-@BUILD_LIBGCOBOL_TRUE@libgcobol_la_DEPENDENCIES = libgcobol.spec
+@BUILD_LIBGCOBOL_TRUE@libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP)
all: config.h
$(MAKE) $(AM_MAKEFLAGS) all-am
diff --git a/libgcobol/acinclude.m4 b/libgcobol/acinclude.m4
index ed340c7..aab0895 100644
--- a/libgcobol/acinclude.m4
+++ b/libgcobol/acinclude.m4
@@ -24,3 +24,165 @@ AC_DEFUN([AC_LIBTOOL_DLOPEN],)
AC_DEFUN([AC_LIBLTDL_CONVENIENCE],)
AC_SUBST(LIBTOOL)
])
+
+dnl Check whether we have a __float128 and _Float128 type
+dnl Unashamedly plagiarized from libgfortran.
+
+AC_DEFUN([LIBGCOBOL_CHECK_FLOAT128], [
+ LIBQUADSPEC=
+ LIBQUADLIB=
+ LIBQUADLIB_DEP=
+ LIBQUADINCLUDE=
+ USE_IEC_60559=no
+
+ if test "x$enable_libquadmath_support" = "xno"; then
+ if test "x$have_iec_60559_libc_support" = "xyes"; then
+ AC_DEFINE(USE_IEC_60559, 1, [Define if IEC 60559 *f128 APIs should be used for _Float128.])
+ fi
+ else
+
+ AC_CACHE_CHECK([whether we have a usable _Float128 type],
+ libgcob_cv_have_float128, [
+ GCC_TRY_COMPILE_OR_LINK([
+ _Float128 foo (_Float128 x)
+ {
+ _Complex _Float128 z1, z2;
+
+ z1 = x;
+ z2 = x / 7.F128;
+ z2 /= z1;
+
+ return __real__ z2;
+ }
+
+ _Float128 bar (_Float128 x)
+ {
+ return x * __builtin_huge_valf128 ();
+ }
+
+ __float128 baz (__float128 x)
+ {
+ return x * __builtin_huge_valf128 ();
+ }
+ ],[
+ foo (1.2F128);
+ bar (1.2F128);
+ baz (1.2F128);
+ foo (1.2Q);
+ bar (1.2Q);
+ baz (1.2Q);
+ ],[
+ libgcob_cv_have_float128=yes
+ ],[
+ libgcob_cv_have_float128=no
+])])
+
+ if test "x$have_iec_60559_libc_support$enable_libquadmath_support$libgcob_cv_have_float128" = xyesdefaultyes; then
+ USE_IEC_60559=yes
+ fi
+
+ if test "x$libgcob_cv_have_float128" = xyes; then
+
+ if test "x$USE_IEC_60559" = xyes; then
+ AC_DEFINE(USE_IEC_60559, 1, [Define if IEC 60559 *f128 APIs should be used for _Float128.])
+ else
+ AC_DEFINE(USE_QUADMATH, 1, [Define if *q APIs should be used for __float128.])
+ fi
+ AC_DEFINE(HAVE_FLOAT128, 1, [Define if target has usable _Float128 and __float128 types.])
+
+ dnl Check whether -Wl,--as-needed resp. -Wl,-zignore is supported
+ dnl
+ dnl Turn warnings into error to avoid testsuite breakage. So enable
+ dnl AC_LANG_WERROR, but there's currently (autoconf 2.64) no way to turn
+ dnl it off again. As a workaround, save and restore werror flag like
+ dnl AC_PATH_XTRA.
+ dnl Cf. http://gcc.gnu.org/ml/gcc-patches/2010-05/msg01889.html
+ ac_xsave_[]_AC_LANG_ABBREV[]_werror_flag=$ac_[]_AC_LANG_ABBREV[]_werror_flag
+ AC_CACHE_CHECK([whether --as-needed/-z ignore works],
+ [libgcob_cv_have_as_needed],
+ [
+ # Test for native Solaris options first.
+ # No whitespace after -z to pass it through -Wl.
+ libgcob_cv_as_needed_option="-zignore"
+ libgcob_cv_no_as_needed_option="-zrecord"
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -Wl,$libgcob_cv_as_needed_option -lm -Wl,$libgcob_cv_no_as_needed_option"
+ libgcob_cv_have_as_needed=no
+ AC_LANG_WERROR
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([])],
+ [libgcob_cv_have_as_needed=yes],
+ [libgcob_cv_have_as_needed=no])
+ LDFLAGS="$save_LDFLAGS"
+ if test "x$libgcob_cv_have_as_needed" = xno; then
+ libgcob_cv_as_needed_option="--as-needed"
+ libgcob_cv_no_as_needed_option="--no-as-needed"
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -Wl,$libgcob_cv_as_needed_option -lm -Wl,$libgcob_cv_no_as_needed_option"
+ libgcob_cv_have_as_needed=no
+ AC_LANG_WERROR
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([])],
+ [libgcob_cv_have_as_needed=yes],
+ [libgcob_cv_have_as_needed=no])
+ LDFLAGS="$save_LDFLAGS"
+ fi
+ ac_[]_AC_LANG_ABBREV[]_werror_flag=$ac_xsave_[]_AC_LANG_ABBREV[]_werror_flag
+ ])
+
+ dnl Determine -Bstatic ... -Bdynamic etc. support from gfortran -### stderr.
+ touch conftest1.$ac_objext conftest2.$ac_objext
+ LQUADMATH=-lquadmath
+ $CXX -static-libgcobol -### -o conftest \
+ conftest1.$ac_objext -lgcobol conftest2.$ac_objext 2>&1 >/dev/null \
+ | grep "conftest1.$ac_objext.*conftest2.$ac_objext" > conftest.cmd
+ if grep "conftest1.$ac_objext.* -Bstatic -lgcobol -Bdynamic .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:-Bstatic} -lquadmath %{static-libquadmath:-Bdynamic}"
+ elif grep "conftest1.$ac_objext.* -bstatic -lgcobol -bdynamic .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:-bstatic} -lquadmath %{static-libquadmath:-bdynamic}"
+ elif grep "conftest1.$ac_objext.* -aarchive_shared -lgcobol -adefault .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:-aarchive_shared} -lquadmath %{static-libquadmath:-adefault}"
+ elif grep "conftest1.$ac_objext.*libgcobol.a .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:libquadmath.a%s;:-lquadmath}"
+ fi
+ rm -f conftest1.$ac_objext conftest2.$ac_objext conftest conftest.cmd
+
+ dnl For static libgcobol linkage, depend on libquadmath only if needed.
+ dnl If using *f128 APIs from libc/libm, depend on libquadmath only if needed
+ dnl even for dynamic libgcobol linkage, and don't link libgcobol against
+ dnl -lquadmath.
+ if test "x$libgcob_cv_have_as_needed" = xyes; then
+ if test "x$USE_IEC_60559" = xyes; then
+ LIBQUADSPEC="$libgcob_cv_as_needed_option $LQUADMATH $libgcob_cv_no_as_needed_option"
+ else
+ LIBQUADSPEC="%{static-libgcobol:$libgcob_cv_as_needed_option} $LQUADMATH %{static-libgcobol:$libgcob_cv_no_as_needed_option}"
+ fi
+ else
+ LIBQUADSPEC="$LQUADMATH"
+ fi
+ if test "x$USE_IEC_60559" != xyes; then
+ if test -f ../libquadmath/libquadmath.la; then
+ LIBQUADLIB=../libquadmath/libquadmath.la
+ LIBQUADLIB_DEP=../libquadmath/libquadmath.la
+ LIBQUADINCLUDE='-I$(srcdir)/../libquadmath'
+ else
+ LIBQUADLIB="-lquadmath"
+ fi
+ fi
+ else
+ if test "x$USE_IEC_60559" = xyes; then
+ AC_DEFINE(USE_IEC_60559, 1, [Define if IEC 60559 *f128 APIs should be used for _Float128.])
+ fi
+ fi
+
+ fi
+
+ dnl For the spec file
+ AC_SUBST(LIBQUADSPEC)
+ AC_SUBST(LIBQUADLIB)
+ AC_SUBST(LIBQUADLIB_DEP)
+ AC_SUBST(LIBQUADINCLUDE)
+ AC_SUBST(USE_IEC_60559)
+])
diff --git a/libgcobol/config.h.in b/libgcobol/config.h.in
index d61ff7a..6a53279 100644
--- a/libgcobol/config.h.in
+++ b/libgcobol/config.h.in
@@ -3,12 +3,30 @@
/* Define to 1 if the target assembler supports thread-local storage. */
#undef HAVE_CC_TLS
+/* Define to 1 if you have the <complex.h> header file. */
+#undef HAVE_COMPLEX_H
+
/* Define to 1 if you have the <dlfcn.h> header file. */
#undef HAVE_DLFCN_H
+/* Define to 1 if you have the <fenv.h> header file. */
+#undef HAVE_FENV_H
+
+/* Define if target has usable _Float128 and __float128 types. */
+#undef HAVE_FLOAT128
+
+/* Define to 1 if you have the <floatingpoint.h> header file. */
+#undef HAVE_FLOATINGPOINT_H
+
+/* Define to 1 if you have the <fptrap.h> header file. */
+#undef HAVE_FPTRAP_H
+
/* Define if you have the iconv() function and it works. */
#undef HAVE_ICONV
+/* Define to 1 if you have the <ieeefp.h> header file. */
+#undef HAVE_IEEEFP_H
+
/* Define to 1 if you have the `initstate_r' function. */
#undef HAVE_INITSTATE_R
@@ -36,6 +54,9 @@
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
+/* Define to 1 if you have the `strfromf128' function. */
+#undef HAVE_STRFROMF128
+
/* Define to 1 if you have the `strfromf32' function. */
#undef HAVE_STRFROMF32
@@ -48,6 +69,9 @@
/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H
+/* Define to 1 if you have the `strtof128' function. */
+#undef HAVE_STRTOF128
+
/* Define to 1 if you have the <sys/stat.h> header file. */
#undef HAVE_SYS_STAT_H
@@ -88,6 +112,12 @@
/* Define to 1 if you have the ANSI C header files. */
#undef STDC_HEADERS
+/* Define if IEC 60559 *f128 APIs should be used for _Float128. */
+#undef USE_IEC_60559
+
+/* Define if *q APIs should be used for __float128. */
+#undef USE_QUADMATH
+
/* Enable extensions on AIX 3, Interix. */
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
diff --git a/libgcobol/configure b/libgcobol/configure
index 1715b98..6c2747c 100755
--- a/libgcobol/configure
+++ b/libgcobol/configure
@@ -629,13 +629,21 @@ ac_includes_default="\
# include <unistd.h>
#endif"
+ac_header_list=
ac_func_list=
+ac_cxx_werror_flag=
+ac_cxx_werror_flag=
ac_subst_vars='am__EXEEXT_FALSE
am__EXEEXT_TRUE
LTLIBOBJS
LIBOBJS
SPEC_LIBGCOBOL_DEPS
get_gcc_base_ver
+USE_IEC_60559
+LIBQUADINCLUDE
+LIBQUADLIB_DEP
+LIBQUADLIB
+LIBQUADSPEC
extra_ldflags_libgcobol
LIBGCOBOL_VERSION
BUILD_LIBGCOBOL_FALSE
@@ -793,6 +801,7 @@ with_toolexeclibdir
enable_rpath
with_libiconv_prefix
with_libiconv_type
+enable_libquadmath
with_gcc_major_version_only
'
ac_precious_vars='build_alias
@@ -1445,6 +1454,7 @@ Optional Features:
install libraries with @rpath/library-name, requires
rpaths to be added to executables
--disable-rpath do not hardcode runtime library paths
+ --disable-libquadmath disable libquadmath support for libgcobol
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
@@ -2339,6 +2349,37 @@ rm -f conftest.val
} # ac_fn_cxx_compute_int
+# ac_fn_cxx_check_header_compile LINENO HEADER VAR INCLUDES
+# ---------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_cxx_check_header_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_cxx_check_header_compile
+
# ac_fn_cxx_check_func LINENO FUNC VAR
# ------------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
@@ -2692,12 +2733,20 @@ $as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
+as_fn_append ac_header_list " floatingpoint.h"
+as_fn_append ac_header_list " ieeefp.h"
+as_fn_append ac_header_list " fenv.h"
+as_fn_append ac_header_list " fptrap.h"
+as_fn_append ac_header_list " complex.h"
+as_fn_append ac_header_list " stdlib.h"
as_fn_append ac_func_list " random_r"
as_fn_append ac_func_list " srandom_r"
as_fn_append ac_func_list " initstate_r"
as_fn_append ac_func_list " setstate_r"
as_fn_append ac_func_list " strfromf32"
as_fn_append ac_func_list " strfromf64"
+as_fn_append ac_func_list " strtof128"
+as_fn_append ac_func_list " strfromf128"
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
@@ -11644,7 +11693,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 11647 "configure"
+#line 11696 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -11750,7 +11799,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
-#line 11753 "configure"
+#line 11802 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -16861,9 +16910,102 @@ if test "$ac_res" != no; then :
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing cosf128" >&5
-$as_echo_n "checking for library containing cosf128... " >&6; }
-if ${ac_cv_search_cosf128+:} false; then :
+
+# libgcobol soname version
+LIBGCOBOL_VERSION=1:0:0
+
+
+## added, currently unused.
+# VERSION_SUFFIX=$(echo $LIBGCOBOL_VERSION | tr ':' '.' )
+# AC_SUBST(VERSION_SUFFIX)
+## end added
+
+extra_ldflags_libgcobol=
+case $host in
+ *-*-darwin*)
+ extra_ldflags_libgcobol=-Wl,-U,___cobol_main ;;
+ *) ;;
+esac
+
+
+
+
+
+ for ac_header in $ac_header_list
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_cxx_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# These are GLIBC
+
+
+
+ for ac_func in $ac_func_list
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_cxx_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+
+
+
+
+
+
+
+
+
+# Some functions we check to figure out if the libc Float128 support
+# is adequate.
+
+# These are C23.
+
+
+
+
+
+
+# These are GLIBC.
+
+
+
+
+
+# We need to make sure to check libc before adding libm.
+libgcobol_have_sinf128=no
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing sinf128" >&5
+$as_echo_n "checking for library containing sinf128... " >&6; }
+if ${ac_cv_search_sinf128+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_func_search_save_LIBS=$LIBS
@@ -16876,11 +17018,11 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
#ifdef __cplusplus
extern "C"
#endif
-char cosf128 ();
+char sinf128 ();
int
main ()
{
-return cosf128 ();
+return sinf128 ();
;
return 0;
}
@@ -16896,75 +17038,388 @@ for ac_lib in '' c m; do
as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
fi
if ac_fn_cxx_try_link "$LINENO"; then :
- ac_cv_search_cosf128=$ac_res
+ ac_cv_search_sinf128=$ac_res
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext
- if ${ac_cv_search_cosf128+:} false; then :
+ if ${ac_cv_search_sinf128+:} false; then :
break
fi
done
-if ${ac_cv_search_cosf128+:} false; then :
+if ${ac_cv_search_sinf128+:} false; then :
else
- ac_cv_search_cosf128=no
+ ac_cv_search_sinf128=no
fi
rm conftest.$ac_ext
LIBS=$ac_func_search_save_LIBS
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_cosf128" >&5
-$as_echo "$ac_cv_search_cosf128" >&6; }
-ac_res=$ac_cv_search_cosf128
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_sinf128" >&5
+$as_echo "$ac_cv_search_sinf128" >&6; }
+ac_res=$ac_cv_search_sinf128
if test "$ac_res" != no; then :
test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ libgcobol_have_sinf128=yes
+fi
+
+libgcobol_have_cacosf128=no
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing cacosf128" >&5
+$as_echo_n "checking for library containing cacosf128... " >&6; }
+if ${ac_cv_search_cacosf128+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char cacosf128 ();
+int
+main ()
+{
+return cacosf128 ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' c m; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if test x$gcc_no_link = xyes; then
+ as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+if ac_fn_cxx_try_link "$LINENO"; then :
+ ac_cv_search_cacosf128=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_cacosf128+:} false; then :
+ break
fi
+done
+if ${ac_cv_search_cacosf128+:} false; then :
+else
+ ac_cv_search_cacosf128=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_cacosf128" >&5
+$as_echo "$ac_cv_search_cacosf128" >&6; }
+ac_res=$ac_cv_search_cacosf128
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+ libgcobol_have_cacosf128=yes
+fi
-# libgcobol soname version
-LIBGCOBOL_VERSION=1:0:0
+have_iec_60559_libc_support=no
+if test "x$ac_cv_func_strtof128$ac_cv_func_strfromf128" = xyesyes \
+ && test "x$libgcobol_have_sinf128$libgcobol_have_cacosf128" = xyesyes; then
+ have_iec_60559_libc_support=yes
+fi
-## added, currently unused.
-# VERSION_SUFFIX=$(echo $LIBGCOBOL_VERSION | tr ':' '.' )
-# AC_SUBST(VERSION_SUFFIX)
-## end added
+# Check whether libquadmath should be used
+# Check whether --enable-libquadmath was given.
+if test "${enable_libquadmath+set}" = set; then :
+ enableval=$enable_libquadmath; ENABLE_LIBQUADMATH_SUPPORT=$enableval
+else
+ if test "x$have_iec_60559_libc_support" = xyes; then
+ ENABLE_LIBQUADMATH_SUPPORT=default
+else
+ ENABLE_LIBQUADMATH_SUPPORT=yes
+fi
+fi
-extra_ldflags_libgcobol=
-case $host in
- *-*-darwin*)
- extra_ldflags_libgcobol=-Wl,-U,___cobol_main ;;
- *) ;;
-esac
+enable_libquadmath_support=
+if test "${ENABLE_LIBQUADMATH_SUPPORT}" = "no" ; then
+ enable_libquadmath_support=no
+elif test "${ENABLE_LIBQUADMATH_SUPPORT}" = "default" ; then
+ enable_libquadmath_support=default
+fi
+ LIBQUADSPEC=
+ LIBQUADLIB=
+ LIBQUADLIB_DEP=
+ LIBQUADINCLUDE=
+ USE_IEC_60559=no
-# These are GLIBC
+ if test "x$enable_libquadmath_support" = "xno"; then
+ if test "x$have_iec_60559_libc_support" = "xyes"; then
+$as_echo "#define USE_IEC_60559 1" >>confdefs.h
+ fi
+ else
- for ac_func in $ac_func_list
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_cxx_check_func "$LINENO" "$ac_func" "$as_ac_var"
-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we have a usable _Float128 type" >&5
+$as_echo_n "checking whether we have a usable _Float128 type... " >&6; }
+if ${libgcob_cv_have_float128+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ if test x$gcc_no_link = xyes; then
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ _Float128 foo (_Float128 x)
+ {
+ _Complex _Float128 z1, z2;
+
+ z1 = x;
+ z2 = x / 7.F128;
+ z2 /= z1;
+
+ return __real__ z2;
+ }
+
+ _Float128 bar (_Float128 x)
+ {
+ return x * __builtin_huge_valf128 ();
+ }
+
+ __float128 baz (__float128 x)
+ {
+ return x * __builtin_huge_valf128 ();
+ }
+
+int
+main ()
+{
+
+ foo (1.2F128);
+ bar (1.2F128);
+ baz (1.2F128);
+ foo (1.2Q);
+ bar (1.2Q);
+ baz (1.2Q);
+
+ ;
+ return 0;
+}
_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+
+ libgcob_cv_have_float128=yes
+
+else
+
+ libgcob_cv_have_float128=no
fi
-done
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+ if test x$gcc_no_link = xyes; then
+ as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+ _Float128 foo (_Float128 x)
+ {
+ _Complex _Float128 z1, z2;
+ z1 = x;
+ z2 = x / 7.F128;
+ z2 /= z1;
+ return __real__ z2;
+ }
+ _Float128 bar (_Float128 x)
+ {
+ return x * __builtin_huge_valf128 ();
+ }
+ __float128 baz (__float128 x)
+ {
+ return x * __builtin_huge_valf128 ();
+ }
+int
+main ()
+{
+ foo (1.2F128);
+ bar (1.2F128);
+ baz (1.2F128);
+ foo (1.2Q);
+ bar (1.2Q);
+ baz (1.2Q);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+ libgcob_cv_have_float128=yes
+else
+
+ libgcob_cv_have_float128=no
+
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgcob_cv_have_float128" >&5
+$as_echo "$libgcob_cv_have_float128" >&6; }
+
+ if test "x$have_iec_60559_libc_support$enable_libquadmath_support$libgcob_cv_have_float128" = xyesdefaultyes; then
+ USE_IEC_60559=yes
+ fi
+
+ if test "x$libgcob_cv_have_float128" = xyes; then
+
+ if test "x$USE_IEC_60559" = xyes; then
+
+$as_echo "#define USE_IEC_60559 1" >>confdefs.h
+
+ else
+
+$as_echo "#define USE_QUADMATH 1" >>confdefs.h
+
+ fi
+
+$as_echo "#define HAVE_FLOAT128 1" >>confdefs.h
+
+
+ ac_xsave_cxx_werror_flag=$ac_cxx_werror_flag
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether --as-needed/-z ignore works" >&5
+$as_echo_n "checking whether --as-needed/-z ignore works... " >&6; }
+if ${libgcob_cv_have_as_needed+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ # Test for native Solaris options first.
+ # No whitespace after -z to pass it through -Wl.
+ libgcob_cv_as_needed_option="-zignore"
+ libgcob_cv_no_as_needed_option="-zrecord"
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -Wl,$libgcob_cv_as_needed_option -lm -Wl,$libgcob_cv_no_as_needed_option"
+ libgcob_cv_have_as_needed=no
+
+ac_cxx_werror_flag=yes
+ if test x$gcc_no_link = xyes; then
+ as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+ libgcob_cv_have_as_needed=yes
+else
+ libgcob_cv_have_as_needed=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ LDFLAGS="$save_LDFLAGS"
+ if test "x$libgcob_cv_have_as_needed" = xno; then
+ libgcob_cv_as_needed_option="--as-needed"
+ libgcob_cv_no_as_needed_option="--no-as-needed"
+ save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -Wl,$libgcob_cv_as_needed_option -lm -Wl,$libgcob_cv_no_as_needed_option"
+ libgcob_cv_have_as_needed=no
+
+ac_cxx_werror_flag=yes
+ if test x$gcc_no_link = xyes; then
+ as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_link "$LINENO"; then :
+ libgcob_cv_have_as_needed=yes
+else
+ libgcob_cv_have_as_needed=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ LDFLAGS="$save_LDFLAGS"
+ fi
+ ac_cxx_werror_flag=$ac_xsave_cxx_werror_flag
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $libgcob_cv_have_as_needed" >&5
+$as_echo "$libgcob_cv_have_as_needed" >&6; }
+
+ touch conftest1.$ac_objext conftest2.$ac_objext
+ LQUADMATH=-lquadmath
+ $CXX -static-libgcobol -### -o conftest \
+ conftest1.$ac_objext -lgcobol conftest2.$ac_objext 2>&1 >/dev/null \
+ | grep "conftest1.$ac_objext.*conftest2.$ac_objext" > conftest.cmd
+ if grep "conftest1.$ac_objext.* -Bstatic -lgcobol -Bdynamic .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:-Bstatic} -lquadmath %{static-libquadmath:-Bdynamic}"
+ elif grep "conftest1.$ac_objext.* -bstatic -lgcobol -bdynamic .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:-bstatic} -lquadmath %{static-libquadmath:-bdynamic}"
+ elif grep "conftest1.$ac_objext.* -aarchive_shared -lgcobol -adefault .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:-aarchive_shared} -lquadmath %{static-libquadmath:-adefault}"
+ elif grep "conftest1.$ac_objext.*libgcobol.a .*conftest2.$ac_objext" \
+ conftest.cmd >/dev/null 2>&1; then
+ LQUADMATH="%{static-libquadmath:libquadmath.a%s;:-lquadmath}"
+ fi
+ rm -f conftest1.$ac_objext conftest2.$ac_objext conftest conftest.cmd
+
+ if test "x$libgcob_cv_have_as_needed" = xyes; then
+ if test "x$USE_IEC_60559" = xyes; then
+ LIBQUADSPEC="$libgcob_cv_as_needed_option $LQUADMATH $libgcob_cv_no_as_needed_option"
+ else
+ LIBQUADSPEC="%{static-libgcobol:$libgcob_cv_as_needed_option} $LQUADMATH %{static-libgcobol:$libgcob_cv_no_as_needed_option}"
+ fi
+ else
+ LIBQUADSPEC="$LQUADMATH"
+ fi
+ if test "x$USE_IEC_60559" != xyes; then
+ if test -f ../libquadmath/libquadmath.la; then
+ LIBQUADLIB=../libquadmath/libquadmath.la
+ LIBQUADLIB_DEP=../libquadmath/libquadmath.la
+ LIBQUADINCLUDE='-I$(srcdir)/../libquadmath'
+ else
+ LIBQUADLIB="-lquadmath"
+ fi
+ fi
+ else
+ if test "x$USE_IEC_60559" = xyes; then
+
+$as_echo "#define USE_IEC_60559 1" >>confdefs.h
+
+ fi
+ fi
+
+ fi
-# These are C23, and might not be available in libc.
diff --git a/libgcobol/configure.ac b/libgcobol/configure.ac
index ca56997..a1e9513 100644
--- a/libgcobol/configure.ac
+++ b/libgcobol/configure.ac
@@ -169,7 +169,6 @@ AM_CONDITIONAL(BUILD_LIBGCOBOL, [test "x$LIBGCOBOL_SUPPORTED" = xyes && test "x$
# Check if functions are available in libc before adding extra libs.
AC_SEARCH_LIBS([malloc], [c])
AC_SEARCH_LIBS([clock_gettime], [c rt])
-AC_SEARCH_LIBS([cosf128], [c m])
# libgcobol soname version
LIBGCOBOL_VERSION=1:0:0
@@ -188,12 +187,50 @@ case $host in
esac
AC_SUBST(extra_ldflags_libgcobol)
+AC_CHECK_HEADERS_ONCE(floatingpoint.h ieeefp.h fenv.h fptrap.h \
+complex.h stdlib.h)
+
# These are GLIBC
AC_CHECK_FUNCS_ONCE(random_r srandom_r initstate_r setstate_r)
-# These are C23, and might not be available in libc.
+# Some functions we check to figure out if the libc Float128 support
+# is adequate.
+
+# These are C23.
AC_CHECK_FUNCS_ONCE(strfromf32 strfromf64)
+# These are GLIBC.
+AC_CHECK_FUNCS_ONCE(strtof128 strfromf128)
+# We need to make sure to check libc before adding libm.
+libgcobol_have_sinf128=no
+AC_SEARCH_LIBS([sinf128], [c m], libgcobol_have_sinf128=yes)
+libgcobol_have_cacosf128=no
+AC_SEARCH_LIBS([cacosf128], [c m], libgcobol_have_cacosf128=yes)
+
+have_iec_60559_libc_support=no
+if test "x$ac_cv_func_strtof128$ac_cv_func_strfromf128" = xyesyes \
+ && test "x$libgcobol_have_sinf128$libgcobol_have_cacosf128" = xyesyes; then
+ have_iec_60559_libc_support=yes
+fi
+
+# Check whether libquadmath should be used
+AC_ARG_ENABLE(libquadmath,
+AS_HELP_STRING([--disable-libquadmath],
+ [disable libquadmath support for libgcobol]),
+ENABLE_LIBQUADMATH_SUPPORT=$enableval,
+if test "x$have_iec_60559_libc_support" = xyes; then
+ ENABLE_LIBQUADMATH_SUPPORT=default
+else
+ ENABLE_LIBQUADMATH_SUPPORT=yes
+fi)
+enable_libquadmath_support=
+if test "${ENABLE_LIBQUADMATH_SUPPORT}" = "no" ; then
+ enable_libquadmath_support=no
+elif test "${ENABLE_LIBQUADMATH_SUPPORT}" = "default" ; then
+ enable_libquadmath_support=default
+fi
+LIBGCOBOL_CHECK_FLOAT128
+
if test "${multilib}" = "yes"; then
multilib_arg="--enable-multilib"
else
diff --git a/libgcobol/gfileio.cc b/libgcobol/gfileio.cc
index ed250c4..e297e95 100644
--- a/libgcobol/gfileio.cc
+++ b/libgcobol/gfileio.cc
@@ -41,6 +41,7 @@
#include <algorithm>
#include "config.h"
+#include "libgcobol-fp.h"
#include "ec.h"
#include "io.h"
diff --git a/libgcobol/gmath.cc b/libgcobol/gmath.cc
index fb2eae3..3fe2bbb 100644
--- a/libgcobol/gmath.cc
+++ b/libgcobol/gmath.cc
@@ -40,6 +40,7 @@
#include <algorithm>
#include "config.h"
+#include "libgcobol-fp.h"
#include "ec.h"
#include "common-defs.h"
@@ -54,10 +55,6 @@
#include <sys/stat.h>
#include <sys/types.h>
-#ifdef __aarch64__
-#define __float128 _Float128
-#endif
-
#define MAX_INTERMEDIATE_BITS 126
#define MAX_INTERMEDIATE_DECIMALS 16
@@ -114,7 +111,7 @@ conditional_stash( cblc_field_t *destination,
size_t destination_o,
size_t destination_s,
bool on_error_flag,
- _Float128 value,
+ GCOB_FP128 value,
cbl_round_t rounded)
{
int retval = compute_error_none;
@@ -150,15 +147,10 @@ conditional_stash( cblc_field_t *destination,
return retval;
}
-
-#if defined(__aarch64__)
-# define __float128 _Float128 /* double */
-#endif
-
static
-_Float128
-divide_helper_float(_Float128 a_value,
- _Float128 b_value,
+GCOB_FP128
+divide_helper_float(GCOB_FP128 a_value,
+ GCOB_FP128 b_value,
int *compute_error)
{
if( b_value == 0 )
@@ -187,9 +179,9 @@ divide_helper_float(_Float128 a_value,
}
static
-_Float128
-multiply_helper_float(_Float128 a_value,
- _Float128 b_value,
+GCOB_FP128
+multiply_helper_float(GCOB_FP128 a_value,
+ GCOB_FP128 b_value,
int *compute_error)
{
a_value *= b_value;
@@ -210,9 +202,9 @@ multiply_helper_float(_Float128 a_value,
}
static
-_Float128
-addition_helper_float(_Float128 a_value,
- _Float128 b_value,
+GCOB_FP128
+addition_helper_float(GCOB_FP128 a_value,
+ GCOB_FP128 b_value,
int *compute_error)
{
a_value += b_value;
@@ -233,9 +225,9 @@ addition_helper_float(_Float128 a_value,
}
static
-_Float128
-subtraction_helper_float(_Float128 a_value,
- _Float128 b_value,
+GCOB_FP128
+subtraction_helper_float(GCOB_FP128 a_value,
+ GCOB_FP128 b_value,
int *compute_error)
{
a_value -= b_value;
@@ -276,9 +268,9 @@ __gg__pow( cbl_arith_format_t,
size_t *C_o = __gg__treeplet_3o;
size_t *C_s = __gg__treeplet_3s;
- _Float128 avalue = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
- _Float128 bvalue = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
- _Float128 tgt_value;
+ GCOB_FP128 avalue = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
+ GCOB_FP128 bvalue = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+ GCOB_FP128 tgt_value;
if( avalue == 0 && bvalue == 0 )
{
@@ -295,7 +287,7 @@ __gg__pow( cbl_arith_format_t,
// Calculate our answer, in floating point:
errno = 0;
feclearexcept(FE_ALL_EXCEPT);
- tgt_value = powf128(avalue, bvalue);
+ tgt_value = FP128_FUNC(pow)(avalue, bvalue);
if( errno || fetestexcept(FE_INVALID | FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW) )
{
// One of a large number of errors took place. See math_error(7) and
@@ -568,7 +560,7 @@ get_int256_from_qualified_field(int256 &var,
static int256 phase1_result;
static int phase1_rdigits;
-static _Float128 phase1_result_float;
+static GCOB_FP128 phase1_result_float;
extern "C"
void
@@ -654,11 +646,11 @@ __gg__addf1_fixed_phase2( cbl_arith_format_t ,
// proceed accordingly.
// Convert the intermediate
- _Float128 value_a = (_Float128)phase1_result.i128[0];
+ GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
value_a /= __gg__power_of_ten(phase1_rdigits);
// Pick up the target
- _Float128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+ GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
value_a += value_b;
@@ -740,7 +732,7 @@ __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
// proceed accordingly.
// Convert the intermediate
- _Float128 value_a = (_Float128)phase1_result.i128[0];
+ GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
value_a /= __gg__power_of_ten(phase1_rdigits);
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
@@ -796,7 +788,7 @@ __gg__add_float_phase1( cbl_arith_format_t ,
for( size_t i=1; i<nA; i++ )
{
- _Float128 temp = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
+ GCOB_FP128 temp = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
phase1_result_float = addition_helper_float(phase1_result_float,
temp,
compute_error);
@@ -822,7 +814,7 @@ __gg__addf1_float_phase2( cbl_arith_format_t ,
// This is the assignment phase of an ADD Format 2
// We take phase1_result and accumulate it into C
- _Float128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+ GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
temp = addition_helper_float(temp, phase1_result_float, compute_error);
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
@@ -883,8 +875,8 @@ __gg__addf3(cbl_arith_format_t ,
{
if( A[i]->type == FldFloat || C[i]->type == FldFloat )
{
- _Float128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
- _Float128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
+ GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
+ GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
value_a = addition_helper_float(value_a, value_b, compute_error);
@@ -966,11 +958,11 @@ __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
// proceed accordingly.
// Convert the intermediate
- _Float128 value_a = (_Float128)phase1_result.i128[0];
+ GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
value_a /= __gg__power_of_ten(phase1_rdigits);
// Pick up the target
- _Float128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+ GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
value_b -= value_a;
@@ -1106,7 +1098,7 @@ __gg__subtractf1_float_phase2(cbl_arith_format_t ,
// This is the assignment phase of an ADD Format 2
// We take phase1_result and subtract it from C
- _Float128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+ GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
temp = subtraction_helper_float(temp, phase1_result_float, compute_error);
*compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
on_size_error,
@@ -1143,7 +1135,7 @@ __gg__subtractf2_float_phase1(cbl_arith_format_t ,
);
// Subtract that from the B value:
- _Float128 value_b = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+ GCOB_FP128 value_b = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
// The two numbers have the same number of rdigits. It's now safe to add
// them.
@@ -1177,8 +1169,8 @@ __gg__subtractf3( cbl_arith_format_t ,
{
if( A[i]->type == FldFloat || C[i]->type == FldFloat)
{
- _Float128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
- _Float128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
+ GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
+ GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
value_b = subtraction_helper_float(value_b, value_a, compute_error);
@@ -1235,7 +1227,7 @@ __gg__subtractf3( cbl_arith_format_t ,
}
static bool multiply_intermediate_is_float;
-static _Float128 multiply_intermediate_float;
+static GCOB_FP128 multiply_intermediate_float;
static __int128 multiply_intermediate_int128;
static int multiply_intermediate_rdigits;
@@ -1351,8 +1343,8 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
int error_this_time=0;
- _Float128 a_value;
- _Float128 b_value;
+ GCOB_FP128 a_value;
+ GCOB_FP128 b_value;
if( multiply_intermediate_is_float )
{
@@ -1374,10 +1366,10 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
if( C[0]->type == FldFloat )
{
// gixed * float
- a_value = (_Float128) multiply_intermediate_int128;
+ a_value = (GCOB_FP128) multiply_intermediate_int128;
if( multiply_intermediate_rdigits )
{
- a_value /= (_Float128)__gg__power_of_ten(multiply_intermediate_rdigits);
+ a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
}
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
@@ -1457,14 +1449,14 @@ __gg__multiplyf2( cbl_arith_format_t ,
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
bool got_float = false;
- _Float128 product_float;
+ GCOB_FP128 product_float;
int256 product_fix;
int product_fix_digits;
if( A[0]->type == FldFloat || B[0]->type == FldFloat )
{
- _Float128 a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
- _Float128 b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+ GCOB_FP128 a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
+ GCOB_FP128 b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
product_float = multiply_helper_float(a_value, b_value, compute_error);
got_float = true;
}
@@ -1834,8 +1826,8 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
int error_this_time=0;
- _Float128 a_value;
- _Float128 b_value;
+ GCOB_FP128 a_value;
+ GCOB_FP128 b_value;
if( multiply_intermediate_is_float )
{
@@ -1857,10 +1849,10 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
if( C[0]->type == FldFloat )
{
// gixed * float
- a_value = (_Float128) multiply_intermediate_int128;
+ a_value = (GCOB_FP128) multiply_intermediate_int128;
if( multiply_intermediate_rdigits )
{
- a_value /= (_Float128)__gg__power_of_ten(multiply_intermediate_rdigits);
+ a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
}
b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
goto float_float;
@@ -1948,9 +1940,9 @@ __gg__dividef23(cbl_arith_format_t ,
if( A[0]->type == FldFloat || B[0]->type == FldFloat )
{
- _Float128 a_value;
- _Float128 b_value;
- _Float128 c_value;
+ GCOB_FP128 a_value;
+ GCOB_FP128 b_value;
+ GCOB_FP128 c_value;
a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
c_value = divide_helper_float(a_value, b_value, &error_this_time);
@@ -2029,9 +2021,9 @@ __gg__dividef45(cbl_arith_format_t ,
if( A[0]->type == FldFloat || B[0]->type == FldFloat )
{
- _Float128 a_value;
- _Float128 b_value;
- _Float128 c_value;
+ GCOB_FP128 a_value;
+ GCOB_FP128 b_value;
+ GCOB_FP128 c_value;
a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
c_value = divide_helper_float(a_value, b_value, &error_this_time);
diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
index e0bd333..844cd38 100644
--- a/libgcobol/intrinsic.cc
+++ b/libgcobol/intrinsic.cc
@@ -45,6 +45,7 @@
#include <string.h>
#include "config.h"
+#include "libgcobol-fp.h"
#include "ec.h"
#include "common-defs.h"
@@ -53,6 +54,15 @@
#include "libgcobol.h"
#include "charmaps.h"
+
+#if !defined (HAVE_STRTOF128)
+# if USE_QUADMATH
+# define strtof128 strtoflt128
+# else
+# error "no available string to float 128"
+# endif
+#endif
+
#pragma GCC diagnostic ignored "-Wformat-truncation"
#define JD_OF_1601_01_02 2305812.5
@@ -406,7 +416,7 @@ get_value_as_double_from_qualified_field( cblc_field_t *input,
}
static
-_Float128 kahan_summation(size_t ncount,
+GCOB_FP128 kahan_summation(size_t ncount,
cblc_field_t **source,
size_t *source_o,
size_t *source_s,
@@ -420,11 +430,11 @@ _Float128 kahan_summation(size_t ncount,
// an aggressive optimizing compiler from just making it go away.
*k_count = 0;
- _Float128 sum = 0;
- volatile _Float128 kahan_c = 0;
- _Float128 input;
- _Float128 y;
- _Float128 t;
+ GCOB_FP128 sum = 0;
+ volatile GCOB_FP128 kahan_c = 0;
+ GCOB_FP128 input;
+ GCOB_FP128 y;
+ GCOB_FP128 t;
for(size_t i=0; i<ncount; i++)
{
@@ -452,7 +462,7 @@ _Float128 kahan_summation(size_t ncount,
}
static
-_Float128
+GCOB_FP128
variance( size_t ncount,
cblc_field_t **source,
size_t *source_o,
@@ -463,13 +473,13 @@ variance( size_t ncount,
// algorithm that is a bit wasteful of time, but is described as particularly
// robust.
- _Float128 retval = 0;
+ GCOB_FP128 retval = 0;
if( ncount )
{
// First, we calculate the mean of the input variables, which we will use
// as an offset in the second stage:
size_t k_count;
- _Float128 offset = kahan_summation( ncount,
+ GCOB_FP128 offset = kahan_summation( ncount,
source,
source_o,
source_s,
@@ -480,11 +490,11 @@ variance( size_t ncount,
// Next, we use Welford's algorithm on the residuals:
size_t count = 0;
- _Float128 mean = 0;
- _Float128 M2 = 0;
- _Float128 delta;
- _Float128 delta2;
- _Float128 newValue;
+ GCOB_FP128 mean = 0;
+ GCOB_FP128 M2 = 0;
+ GCOB_FP128 delta;
+ GCOB_FP128 delta2;
+ GCOB_FP128 newValue;
for(size_t i=0; i<ncount; i++)
{
@@ -958,7 +968,7 @@ __gg__abs(cblc_field_t *dest,
size_t source_size)
{
// FUNCTION ABS
- _Float128 value;
+ GCOB_FP128 value;
value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
@@ -980,17 +990,17 @@ __gg__acos( cblc_field_t *dest,
size_t source_size)
{
// FUNCTION ACOS
- _Float128 value;
+ GCOB_FP128 value;
value = __gg__float128_from_qualified_field(source, source_offset, source_size);
- if( value < -1.00Q || value > +1.00Q )
+ if( value < GCOB_FP128_LITERAL(-1.00) || value > GCOB_FP128_LITERAL(+1.00) )
{
exception_raise(ec_argument_function_e);
value = WEIRD_TRANSCENDENT_RETURN_VALUE;
}
else
{
- value = acosf128(value);
+ value = FP128_FUNC(acos)(value);
}
__gg__float128_to_field( dest,
@@ -1011,12 +1021,12 @@ __gg__annuity(cblc_field_t *dest,
{
// FUNCTION ANNUITY
- _Float128 retval = 0;
+ GCOB_FP128 retval = 0;
- _Float128 val1 = fabsf128(__gg__float128_from_qualified_field(arg1,
+ GCOB_FP128 val1 = FP128_FUNC(fabs)(__gg__float128_from_qualified_field(arg1,
arg1_offset,
arg1_size));
- _Float128 val2 = fabsf128(__gg__float128_from_qualified_field(arg2,
+ GCOB_FP128 val2 = FP128_FUNC(fabs)(__gg__float128_from_qualified_field(arg2,
arg2_offset,
arg2_size));
if( val2 > 0)
@@ -1031,7 +1041,7 @@ __gg__annuity(cblc_field_t *dest,
}
else
{
- retval = val1 / (1- powf128( (1+val1), -val2 ));
+ retval = val1 / (1- FP128_FUNC(pow)( (1+val1), -val2 ));
}
}
else
@@ -1053,19 +1063,19 @@ __gg__asin( cblc_field_t *dest,
{
// FUNCTION ASIN
- _Float128 value;
+ GCOB_FP128 value;
value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- if( value < -1.0Q || value > +1.00Q )
+ if( value < GCOB_FP128_LITERAL(-1.0) || value > GCOB_FP128_LITERAL(+1.00) )
{
exception_raise(ec_argument_function_e);
value = WEIRD_TRANSCENDENT_RETURN_VALUE;
}
else
{
- value = asinf128(value);
+ value = FP128_FUNC(asin)(value);
}
__gg__float128_to_field( dest,
@@ -1083,12 +1093,12 @@ __gg__atan( cblc_field_t *dest,
{
// FUNCTION ATAN
- _Float128 value;
+ GCOB_FP128 value;
value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = atanf128(value);
+ value = FP128_FUNC(atan)(value);
__gg__float128_to_field( dest,
value,
@@ -1195,10 +1205,10 @@ __gg__cos(cblc_field_t *dest,
{
// FUNCTION COS
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = cosf128(value);
+ value = FP128_FUNC(cos)(value);
__gg__float128_to_field(dest,
value,
truncation_e,
@@ -1368,7 +1378,8 @@ void
__gg__e(cblc_field_t *dest)
{
// FUNCTION E
- static _Float128 e = 2.7182818284590452353602874713526624977572Q;
+ static GCOB_FP128 e
+ = GCOB_FP128_LITERAL(2.7182818284590452353602874713526624977572);
__gg__float128_to_field(dest,
e,
truncation_e,
@@ -1384,10 +1395,10 @@ __gg__exp(cblc_field_t *dest,
{
// FUNCTION EXP
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = expf128(value);
+ value = FP128_FUNC(exp)(value);
__gg__float128_to_field(dest,
value,
truncation_e,
@@ -1403,10 +1414,10 @@ __gg__exp10(cblc_field_t *dest,
{
// FUNCTION EXP10
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = powf128(10.0Q, value);
+ value = FP128_FUNC(pow)(GCOB_FP128_LITERAL(10.0), value);
__gg__float128_to_field(dest,
value,
truncation_e,
@@ -1658,10 +1669,10 @@ __gg__integer(cblc_field_t *dest,
size_t source_size)
{
// FUNCTION INTEGER
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = floorf128(value);
+ value = FP128_FUNC(floor)(value);
__gg__float128_to_field(dest,
value,
truncation_e,
@@ -1758,10 +1769,10 @@ __gg__integer_part( cblc_field_t *dest,
size_t source_size)
{
// FUNCTION INTEGER-PART
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- _Float128 retval = floorf128(fabsf128(value));
+ GCOB_FP128 retval = FP128_FUNC(floor)(FP128_FUNC(fabs)(value));
if( value < 0 )
{
@@ -1781,7 +1792,7 @@ __gg__fraction_part(cblc_field_t *dest,
size_t source_size)
{
// FUNCTION INTEGER-PART
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
bool is_negative = false;
@@ -1791,7 +1802,7 @@ __gg__fraction_part(cblc_field_t *dest,
value = -value;
}
- _Float128 retval = value - floorf128(value);
+ GCOB_FP128 retval = value - FP128_FUNC(floor)(value);
if( is_negative )
{
@@ -1811,7 +1822,7 @@ __gg__log( cblc_field_t *dest,
size_t source_size)
{
// FUNCTION LOG
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
if( value <= 0.00 )
@@ -1820,7 +1831,7 @@ __gg__log( cblc_field_t *dest,
}
else
{
- _Float128 retval = logf128(value);
+ GCOB_FP128 retval = FP128_FUNC(log)(value);
__gg__float128_to_field(dest,
retval,
truncation_e,
@@ -1836,7 +1847,7 @@ __gg__log10( cblc_field_t *dest,
size_t source_size)
{
// FUNCTION LOG10
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
if( value <= 0.00 )
@@ -1845,7 +1856,7 @@ __gg__log10( cblc_field_t *dest,
}
else
{
- _Float128 retval = log10f128(value);
+ GCOB_FP128 retval = FP128_FUNC(log10)(value);
__gg__float128_to_field(dest,
retval,
truncation_e,
@@ -1931,7 +1942,7 @@ __gg__max(cblc_field_t *dest,
}
else
{
- _Float128 retval;
+ GCOB_FP128 retval;
bool first_time = true;
assert(ncount);
for(size_t i=0; i<ncount; i++)
@@ -1948,7 +1959,7 @@ __gg__max(cblc_field_t *dest,
}
else
{
- _Float128 candidate = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
+ GCOB_FP128 candidate = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
if( candidate >= retval )
{
retval = candidate;
@@ -1992,7 +2003,7 @@ __gg__mean( cblc_field_t *dest,
{
// FUNCTION MEAN
size_t k_count;
- _Float128 sum = kahan_summation(ninputs,
+ GCOB_FP128 sum = kahan_summation(ninputs,
__gg__treeplet_1f,
__gg__treeplet_1o,
__gg__treeplet_1s,
@@ -2021,7 +2032,7 @@ __gg__median( cblc_field_t *dest,
size_t list_size = 1;
- _Float128 *the_list = (_Float128 *)malloc(list_size *sizeof(_Float128));
+ GCOB_FP128 *the_list = (GCOB_FP128 *)malloc(list_size *sizeof(GCOB_FP128));
size_t k_count = 0;
assert(ncount);
for(size_t i=0; i<ncount; i++)
@@ -2034,7 +2045,7 @@ __gg__median( cblc_field_t *dest,
if(k_count >= list_size)
{
list_size *= 2;
- the_list = (_Float128 *)realloc(the_list, list_size *sizeof(_Float128));
+ the_list = (GCOB_FP128 *)realloc(the_list, list_size *sizeof(GCOB_FP128));
}
the_list[k_count] = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
@@ -2050,7 +2061,7 @@ __gg__median( cblc_field_t *dest,
}
std::sort(the_list, the_list+k_count);
- _Float128 retval;
+ GCOB_FP128 retval;
size_t i=k_count/2;
if( k_count & 1 )
{
@@ -2073,9 +2084,9 @@ __gg__midrange( cblc_field_t *dest,
size_t ncount)
{
// FUNCTION MIDRANGE
- _Float128 val;
- _Float128 min=0;
- _Float128 max=0;
+ GCOB_FP128 val;
+ GCOB_FP128 min=0;
+ GCOB_FP128 max=0;
bool first_time = true;
assert(ncount);
for(size_t i=0; i<ncount; i++)
@@ -2102,7 +2113,7 @@ __gg__midrange( cblc_field_t *dest,
}
}
}
- _Float128 retval = (min + max)/2.0;
+ GCOB_FP128 retval = (min + max)/2.0;
__gg__float128_to_field(dest,
retval,
truncation_e,
@@ -2187,7 +2198,7 @@ __gg__min(cblc_field_t *dest,
}
else
{
- _Float128 retval;
+ GCOB_FP128 retval;
bool first_time = true;
assert(ncount);
for(size_t i=0; i<ncount; i++)
@@ -2204,7 +2215,7 @@ __gg__min(cblc_field_t *dest,
}
else
{
- _Float128 candidate = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
+ GCOB_FP128 candidate = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
if( candidate < retval )
{
retval = candidate;
@@ -2576,7 +2587,7 @@ numval_c( cblc_field_t *dest,
char *pend = pstart + src_size;
char *p = pstart;
- _Float128 retval = 0;
+ GCOB_FP128 retval = 0;
int sign = 0;
int rdigits = 0;
int rdigit_bump = 0;
@@ -3146,7 +3157,8 @@ __gg__pi(cblc_field_t *dest)
{
// FUNCTION PI
- static _Float128 pi = 3.141592653589793238462643383279502884Q;
+ static GCOB_FP128 pi
+ = GCOB_FP128_LITERAL(3.141592653589793238462643383279502884);
__gg__float128_to_field(dest,
pi,
truncation_e,
@@ -3158,10 +3170,10 @@ void
__gg__present_value(cblc_field_t *dest,
size_t ncount)
{
- _Float128 discount = 0;;
- _Float128 denom = 1;
+ GCOB_FP128 discount = 0;;
+ GCOB_FP128 denom = 1;
- _Float128 retval = 0;
+ GCOB_FP128 retval = 0;
bool first_time = true;
for(size_t i=0; i<ncount; i++)
{
@@ -3172,19 +3184,19 @@ __gg__present_value(cblc_field_t *dest,
if(first_time)
{
first_time = false;
- _Float128 arg1 = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
+ GCOB_FP128 arg1 = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
__gg__treeplet_1o[i],
__gg__treeplet_1s[i]);
- if( arg1 <= -1.0Q )
+ if( arg1 <= GCOB_FP128_LITERAL(-1.0) )
{
exception_raise(ec_argument_function_e);
break;
}
- discount = 1.0Q / (1.0Q + arg1);
+ discount = GCOB_FP128_LITERAL(1.0) / (GCOB_FP128_LITERAL(1.0) + arg1);
}
else
{
- _Float128 arg = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
+ GCOB_FP128 arg = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
__gg__treeplet_1o[i],
__gg__treeplet_1s[i]);
denom *= discount;
@@ -3210,9 +3222,9 @@ __gg__range(cblc_field_t *dest,
{
// FUNCTION RANGE
bool first_time = true;
- _Float128 val;
- _Float128 min;
- _Float128 max;
+ GCOB_FP128 val;
+ GCOB_FP128 min;
+ GCOB_FP128 max;
assert(ncount > 0);
for(size_t i=0; i<ncount; i++)
@@ -3240,7 +3252,7 @@ __gg__range(cblc_field_t *dest,
}
}
- _Float128 retval = max - min;
+ GCOB_FP128 retval = max - min;
__gg__float128_to_field(dest,
retval,
truncation_e,
@@ -3264,15 +3276,15 @@ __gg__rem(cblc_field_t *dest,
// The ISO spec says:
// ((argument-1) – ((argument-2) * FUNCTION INTEGER-PART ((argument-1) / (argument-2))))
- _Float128 arg1 = __gg__float128_from_qualified_field( par1,
+ GCOB_FP128 arg1 = __gg__float128_from_qualified_field( par1,
par1_offset,
par1_size);
- _Float128 arg2 = __gg__float128_from_qualified_field( par2,
+ GCOB_FP128 arg2 = __gg__float128_from_qualified_field( par2,
par2_offset,
par2_size);
- _Float128 intpart;
- _Float128 retval;
+ GCOB_FP128 intpart;
+ GCOB_FP128 retval;
if( arg2 == 0 )
{
exception_raise(ec_argument_function_e);
@@ -3280,7 +3292,7 @@ __gg__rem(cblc_field_t *dest,
}
else
{
- modff128(arg1 / arg2, &intpart);
+ FP128_FUNC(modf)(arg1 / arg2, &intpart);
retval = arg1 - arg2 * intpart;
}
@@ -3500,7 +3512,7 @@ __gg__sign( cblc_field_t *dest,
{
// FUNCTION SIGN
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
@@ -3533,11 +3545,11 @@ __gg__sin(cblc_field_t *dest,
{
// FUNCTION SIN
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = sinf128(value);
+ value = FP128_FUNC(sin)(value);
__gg__float128_to_field(dest,
value,
@@ -3554,17 +3566,17 @@ __gg__sqrt( cblc_field_t *dest,
{
// FUNCTION SQRT
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- if( value <= 0.0Q )
+ if( value <= GCOB_FP128_LITERAL(0.0) )
{
exception_raise(ec_argument_function_e);
}
else
{
- value = sqrtf128(value);
+ value = FP128_FUNC(sqrt)(value);
}
__gg__float128_to_field(dest,
@@ -3579,12 +3591,12 @@ __gg__standard_deviation( cblc_field_t *dest,
size_t ninputs)
{
// FUNCTION STANDARD-DEVIATION
- _Float128 retval = variance(ninputs,
+ GCOB_FP128 retval = variance(ninputs,
__gg__treeplet_1f,
__gg__treeplet_1o,
__gg__treeplet_1s,
__gg__fourplet_flags);
- retval = sqrtf128(retval);
+ retval = FP128_FUNC(sqrt)(retval);
__gg__float128_to_field(dest,
retval,
@@ -3599,7 +3611,7 @@ __gg__sum(cblc_field_t *dest,
{
// FUNCTION SUM
size_t k_count;
- _Float128 sum = kahan_summation(ninputs,
+ GCOB_FP128 sum = kahan_summation(ninputs,
__gg__treeplet_1f,
__gg__treeplet_1o,
__gg__treeplet_1s,
@@ -3620,10 +3632,10 @@ __gg__tan(cblc_field_t *dest,
{
// FUNCTION TAN
- _Float128 value = __gg__float128_from_qualified_field(source,
+ GCOB_FP128 value = __gg__float128_from_qualified_field(source,
source_offset,
source_size);
- value = tanf128(value);
+ value = FP128_FUNC(tan)(value);
__gg__float128_to_field(dest,
value,
truncation_e,
@@ -3743,7 +3755,7 @@ __gg__variance( cblc_field_t *dest,
size_t ncount)
{
// FUNCTION VARIANCE
- _Float128 retval = variance(ncount,
+ GCOB_FP128 retval = variance(ncount,
__gg__treeplet_1f,
__gg__treeplet_1o,
__gg__treeplet_1s,
@@ -4980,7 +4992,7 @@ __gg__numval_f( cblc_field_t *dest,
size_t source_offset,
size_t source_size)
{
- _Float128 value = 0;
+ GCOB_FP128 value = 0;
char *data = (char * )(source->data + source_offset);
char *data_end = data + source_size;
diff --git a/libgcobol/libgcobol-fp.h b/libgcobol/libgcobol-fp.h
new file mode 100644
index 0000000..bd443f3
--- /dev/null
+++ b/libgcobol/libgcobol-fp.h
@@ -0,0 +1,50 @@
+/* Copyright The GNU Toolchain Authors. */
+
+/* This file is part of the GNU COBOL runtime library (libgcobol).
+
+libgcobol is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+libgcobol is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+/* You must include "config.h" before this file. */
+
+#if __LDBL_MANT_DIG__ == 113 && __LDBL_MIN_EXP__ == -16381
+// Use long double, l suffix on calls, l or L suffix in literals
+# define GCOB_FP128 long double
+# define GCOB_FP128_LITERAL(lit) (lit ## l)
+# define FP128_FUNC(funcname) funcname ## l
+#elif __FLT128_MANT_DIG__ == 113 && __FLT128_MIN_EXP__ == -16381 \
+ && defined(USE_IEC_60559)
+// Use _Float128, f128 suffix on calls, f128 or F128 suffix on literals
+# define GCOB_FP128 _Float128
+# define GCOB_FP128_LITERAL(lit) (lit ## f128)
+# define FP128_FUNC(funcname) funcname ## f128
+#elif __FLT128_MANT_DIG__ == 113 && __FLT128_MIN_EXP__ == -16381
+// Use __float128, q suffix on calls, q or Q suffix on literals
+# define GCOB_FP128 __float128
+# define GCOB_FP128_LITERAL(lit) (lit ## q)
+# define FP128_FUNC(funcname) funcname ## q
+#else
+# error "libgcobol requires 128b floating point"
+#endif
+
+#if USE_QUADMATH
+/* We will assume that unless we found the 128 to/from string and some
+ representative trig functions, we need libquadmath to support those. */
+# include "quadmath.h"
+#endif
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index f7fa7a7..d912ea3 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -50,6 +50,7 @@
#include <sys/resource.h>
#include "config.h"
+#include "libgcobol-fp.h"
#include "ec.h"
#include "common-defs.h"
@@ -92,6 +93,20 @@ strfromf64 (char *s, size_t n, const char *f, double v)
# endif
#endif
+#if !defined (HAVE_STRFROMF128)
+# if !USE_QUADMATH
+# error "no available float 128 to string"
+# endif
+#endif
+
+#if !defined (HAVE_STRTOF128)
+# if USE_QUADMATH
+# define strtof128 strtoflt128
+# else
+# error "no available string to float 128"
+# endif
+#endif
+
// This couldn't be defined in symbols.h because it conflicts with a LEVEL66
// in parse.h
#define LEVEL66 (66)
@@ -881,10 +896,12 @@ int128_to_int128_rounded( cbl_round_t rounded,
int *compute_error)
{
// value is signed, and is scaled to the target
- _Float128 fpart = _Float128(remainder) / _Float128(factor);
+ GCOB_FP128 fpart = ((GCOB_FP128)remainder) / ((GCOB_FP128)factor);
__int128 retval = value;
- if(rounded == nearest_even_e && fpart != -0.5Q && fpart != 0.5Q )
+ if(rounded == nearest_even_e
+ && fpart != GCOB_FP128_LITERAL (-0.5)
+ && fpart != GCOB_FP128_LITERAL (0.5))
{
// "bankers rounding" has been requested.
//
@@ -905,14 +922,14 @@ int128_to_int128_rounded( cbl_round_t rounded,
// 0.5 through 0.9 becomes 1
if( value < 0 )
{
- if( fpart <= -0.5Q )
+ if( fpart <= GCOB_FP128_LITERAL(-0.5) )
{
retval -= 1;
}
}
else
{
- if( fpart >= 0.5Q )
+ if( fpart >= GCOB_FP128_LITERAL(0.5) )
{
retval += 1;
}
@@ -946,14 +963,14 @@ int128_to_int128_rounded( cbl_round_t rounded,
// 0.6 through 0.9 becomes 1
if( value < 0 )
{
- if( fpart < -0.5Q )
+ if( fpart < GCOB_FP128_LITERAL(-0.5) )
{
retval -= 1;
}
}
else
{
- if( fpart > 0.5Q )
+ if( fpart > GCOB_FP128_LITERAL(0.5) )
{
retval += 1;
}
@@ -1035,15 +1052,17 @@ int128_to_int128_rounded( cbl_round_t rounded,
static __int128
f128_to_i128_rounded( cbl_round_t rounded,
- _Float128 value,
+ GCOB_FP128 value,
int *compute_error)
{
// value is signed, and is scaled to the target
- _Float128 ipart;
- _Float128 fpart = modff128(value, &ipart);
+ GCOB_FP128 ipart;
+ GCOB_FP128 fpart = FP128_FUNC(modf)(value, &ipart);
__int128 retval = (__int128)ipart;
- if(rounded == nearest_even_e && fpart != -0.5Q && fpart != 0.5Q )
+ if(rounded == nearest_even_e
+ && fpart != GCOB_FP128_LITERAL (-0.5)
+ && fpart != GCOB_FP128_LITERAL (0.5))
{
// "bankers rounding" has been requested.
//
@@ -1064,14 +1083,14 @@ f128_to_i128_rounded( cbl_round_t rounded,
// 0.5 through 0.9 becomes 1
if( value < 0 )
{
- if( fpart <= -0.5Q )
+ if( fpart <= GCOB_FP128_LITERAL (-0.5) )
{
retval -= 1;
}
}
else
{
- if( fpart >= 0.5Q )
+ if( fpart >= GCOB_FP128_LITERAL (0.5) )
{
retval += 1;
}
@@ -1105,14 +1124,14 @@ f128_to_i128_rounded( cbl_round_t rounded,
// 0.6 through 0.9 becomes 1
if( value < 0 )
{
- if( fpart < -0.5Q )
+ if( fpart < GCOB_FP128_LITERAL (-0.5) )
{
retval -= 1;
}
}
else
{
- if( fpart > 0.5Q )
+ if( fpart > GCOB_FP128_LITERAL (0.5) )
{
retval += 1;
}
@@ -1276,8 +1295,8 @@ int128_to_field(cblc_field_t *var,
{
value = -value;
}
- _Float128 tvalue = (_Float128 )value;
- tvalue /= (_Float128 )__gg__power_of_ten(source_rdigits);
+ GCOB_FP128 tvalue = (GCOB_FP128 )value;
+ tvalue /= (GCOB_FP128 )__gg__power_of_ten(source_rdigits);
// *(_Float128 *)location = tvalue;
// memcpy because *(_Float128 *) requires a 16-byte boundary.
memcpy(location, &tvalue, 16);
@@ -2573,7 +2592,7 @@ __gg__dirty_to_binary_internal( const char *dirty,
}
extern "C"
-_Float128
+GCOB_FP128
__gg__dirty_to_float( const char *dirty,
int length)
{
@@ -2589,7 +2608,7 @@ __gg__dirty_to_float( const char *dirty,
// It also can handle 12345E-2 notation.
- _Float128 retval = 0;
+ GCOB_FP128 retval = 0;
int rdigits = 0;
int hyphen = 0;
@@ -3244,9 +3263,13 @@ format_for_display_internal(char **dest,
// We can't use *(_Float64 *)actual_location;
// That uses the SSE registers, which won't work if the source isn't
// on a 16-bit boundary.
- _Float128 floatval;
+ GCOB_FP128 floatval;
memcpy(&floatval, actual_location, 16);
+#if !defined (HAVE_STRFROMF128) && USE_QUADMATH
+ quadmath_snprintf(ach, sizeof(ach), "%.36QE", floatval);
+#else
strfromf128(ach, sizeof(ach), "%.36E", floatval);
+#endif
char *p = strchr(ach, 'E');
if( !p )
{
@@ -3268,8 +3291,13 @@ format_for_display_internal(char **dest,
int precision = 36 - exp;
char achFormat[24];
+#if !defined (HAVE_STRFROMF128) && USE_QUADMATH
+ sprintf(achFormat, "%%.%dQf", precision);
+ quadmath_snprintf(ach, sizeof(ach), achFormat, floatval);
+#else
sprintf(achFormat, "%%.%df", precision);
strfromf128(ach, sizeof(ach), achFormat, floatval);
+#endif
}
__gg__remove_trailing_zeroes(ach);
__gg__realloc_if_necessary(dest, dest_size, strlen(ach)+1);
@@ -3481,11 +3509,11 @@ compare_88( const char *list,
return cmpval;
}
-static _Float128
+static GCOB_FP128
get_float128( cblc_field_t *field,
unsigned char *location )
{
- _Float128 retval=0;
+ GCOB_FP128 retval=0;
if(field->type == FldFloat )
{
switch( field->capacity )
@@ -3710,7 +3738,7 @@ compare_field_class(cblc_field_t *conditional,
case FldFloat:
{
- _Float128 value = get_float128(conditional, conditional_location) ;
+ GCOB_FP128 value = get_float128(conditional, conditional_location) ;
char *walker = list->initial;
while(*walker)
{
@@ -3734,7 +3762,7 @@ compare_field_class(cblc_field_t *conditional,
walker = right + right_len;
- _Float128 left_value;
+ GCOB_FP128 left_value;
if( left_flag == 'F' && left[0] == 'Z' )
{
left_value = 0;
@@ -3745,7 +3773,7 @@ compare_field_class(cblc_field_t *conditional,
left_len);
}
- _Float128 right_value;
+ GCOB_FP128 right_value;
if( right_flag == 'F' && right[0] == 'Z' )
{
right_value = 0;
@@ -4100,7 +4128,7 @@ __gg__compare_2(cblc_field_t *left_side,
case FldFloat:
{
- _Float128 value = __gg__float128_from_location(left_side,
+ GCOB_FP128 value = __gg__float128_from_location(left_side,
left_location);
retval = 0;
retval = value < 0 ? -1 : retval;
@@ -4157,8 +4185,8 @@ __gg__compare_2(cblc_field_t *left_side,
if( left_side->type == FldFloat && right_side->type == FldFloat )
{
// One or the other of the numerics is a FldFloat
- _Float128 left_value = __gg__float128_from_location(left_side, left_location);
- _Float128 right_value = __gg__float128_from_location(right_side, right_location);
+ GCOB_FP128 left_value = __gg__float128_from_location(left_side, left_location);
+ GCOB_FP128 right_value = __gg__float128_from_location(right_side, right_location);
retval = 0;
retval = left_value < right_value ? -1 : retval;
retval = left_value > right_value ? 1 : retval;
@@ -4170,8 +4198,8 @@ __gg__compare_2(cblc_field_t *left_side,
{
// The left side is a FldFloat; the other is another type of numeric:
int rdecimals;
- _Float128 left_value;
- _Float128 right_value;
+ GCOB_FP128 left_value;
+ GCOB_FP128 right_value;
if( right_side->type == FldLiteralN)
{
@@ -4203,7 +4231,7 @@ __gg__compare_2(cblc_field_t *left_side,
case 4:
{
_Float32 left_value = *(_Float32 *)left_location;
- _Float32 right_value = strtof32(buffer, NULL);
+ _Float32 right_value = strtof(buffer, NULL);
retval = 0;
retval = left_value < right_value ? -1 : retval;
retval = left_value > right_value ? 1 : retval;
@@ -4212,7 +4240,7 @@ __gg__compare_2(cblc_field_t *left_side,
case 8:
{
_Float64 left_value = *(_Float64 *)left_location;
- _Float64 right_value = strtof64(buffer, NULL);
+ _Float64 right_value = strtod(buffer, NULL);
retval = 0;
retval = left_value < right_value ? -1 : retval;
retval = left_value > right_value ? 1 : retval;
@@ -4221,9 +4249,9 @@ __gg__compare_2(cblc_field_t *left_side,
case 16:
{
//_Float128 left_value = *(_Float128 *)left_location;
- _Float128 left_value;
+ GCOB_FP128 left_value;
memcpy(&left_value, left_location, 16);
- _Float128 right_value = strtof128(buffer, NULL);
+ GCOB_FP128 right_value = strtof128(buffer, NULL);
retval = 0;
retval = left_value < right_value ? -1 : retval;
retval = left_value > right_value ? 1 : retval;
@@ -5725,7 +5753,7 @@ __gg__move( cblc_field_t *fdest,
case 16:
{
//_Float128 val = *(_Float128 *)(fsource->data+source_offset);
- _Float128 val;
+ GCOB_FP128 val;
memcpy(&val, fsource->data+source_offset, 16);
if(val < 0)
{
@@ -5813,7 +5841,7 @@ __gg__move( cblc_field_t *fdest,
// We are converted a floating-point value fixed-point
rdigits = get_scaled_rdigits(fdest);
- _Float128 value=0;
+ GCOB_FP128 value=0;
switch(fsource->capacity)
{
case 4:
@@ -5963,18 +5991,18 @@ __gg__move( cblc_field_t *fdest,
{
case 4:
{
- *(float *)(fdest->data+dest_offset) = strtof32(ach, NULL);
+ *(float *)(fdest->data+dest_offset) = strtof(ach, NULL);
break;
}
case 8:
{
- *(double *)(fdest->data+dest_offset) = strtof64(ach, NULL);
+ *(double *)(fdest->data+dest_offset) = strtod(ach, NULL);
break;
}
case 16:
{
//*(_Float128 *)(fdest->data+dest_offset) = strtof128(ach, NULL);
- _Float128 t = strtof128(ach, NULL);
+ GCOB_FP128 t = strtof128(ach, NULL);
memcpy(fdest->data+dest_offset, &t, 16);
break;
}
@@ -6133,17 +6161,17 @@ __gg__move_literala(cblc_field_t *field,
{
case 4:
{
- *(float *)(field->data+field_offset) = strtof32(ach, NULL);
+ *(float *)(field->data+field_offset) = strtof(ach, NULL);
break;
}
case 8:
{
- *(double *)(field->data+field_offset) = strtof64(ach, NULL);
+ *(double *)(field->data+field_offset) = strtod(ach, NULL);
break;
}
case 16:
{
- _Float128 t = strtof128(ach, NULL);
+ GCOB_FP128 t = strtof128(ach, NULL);
memcpy(field->data+field_offset, &t, 16);
break;
}
@@ -9127,10 +9155,10 @@ __gg__binary_value_from_qualified_field(int *rdigits,
}
extern "C"
-_Float128
+GCOB_FP128
__gg__float128_from_field( cblc_field_t *field )
{
- _Float128 retval=0;
+ GCOB_FP128 retval=0;
if( field->type == FldFloat || field->type == FldLiteralN )
{
retval = get_float128(field, field->data);
@@ -9138,20 +9166,20 @@ __gg__float128_from_field( cblc_field_t *field )
else
{
int rdigits;
- retval = (_Float128)__gg__binary_value_from_field(&rdigits, field);
+ retval = (GCOB_FP128)__gg__binary_value_from_field(&rdigits, field);
if( rdigits )
{
- retval /= (_Float128)__gg__power_of_ten(rdigits);
+ retval /= (GCOB_FP128)__gg__power_of_ten(rdigits);
}
}
return retval;
}
extern "C"
-_Float128
+GCOB_FP128
__gg__float128_from_qualified_field( cblc_field_t *field, size_t offset, size_t size)
{
- _Float128 retval=0;
+ GCOB_FP128 retval=0;
if( field->type == FldFloat || field->type == FldLiteralN )
{
retval = get_float128(field, field->data+offset);
@@ -9159,10 +9187,10 @@ __gg__float128_from_qualified_field( cblc_field_t *field, size_t offset, size_t
else
{
int rdigits;
- retval = (_Float128)__gg__binary_value_from_qualified_field(&rdigits, field, offset, size);
+ retval = (GCOB_FP128)__gg__binary_value_from_qualified_field(&rdigits, field, offset, size);
if( rdigits )
{
- retval /= (_Float128)__gg__power_of_ten(rdigits);
+ retval /= (GCOB_FP128)__gg__power_of_ten(rdigits);
}
}
return retval;
@@ -9228,7 +9256,7 @@ __gg__int128_to_qualified_field(cblc_field_t *tgt,
static __int128
float128_to_int128( int *rdigits,
cblc_field_t *field,
- _Float128 value,
+ GCOB_FP128 value,
cbl_round_t rounded,
int *compute_error)
{
@@ -9253,7 +9281,7 @@ float128_to_int128( int *rdigits,
// get away with.
// Calculate the number of digits to the left of the decimal point:
- int digits = (int)(floorf128(logf128(fabsf128(value)))+1);
+ int digits = (int)(FP128_FUNC(floor)(FP128_FUNC(log)(FP128_FUNC(fabs)(value)))+1);
// Make sure it is not a negative number
digits = std::max(0, digits);
@@ -9270,12 +9298,12 @@ float128_to_int128( int *rdigits,
// We now multiply our value by 10**rdigits, in order to make the
// floating-point value have the same magnitude as our target __int128
- value *= powf128(10.0Q, (_Float128)(*rdigits));
+ value *= FP128_FUNC(pow)(GCOB_FP128_LITERAL (10.0), (GCOB_FP128)(*rdigits));
// We are ready to cast value to an __int128. But this value could be
// too large to fit, which is an error condition we want to flag:
- if( fabsf128(value) >= 1.0E38Q )
+ if( FP128_FUNC(fabs)(value) >= GCOB_FP128_LITERAL (1.0E38) )
{
*compute_error = compute_error_overflow;
}
@@ -9292,7 +9320,7 @@ static void
float128_to_location( cblc_field_t *tgt,
unsigned char *data,
size_t size,
- _Float128 value,
+ GCOB_FP128 value,
enum cbl_round_t rounded,
int *compute_error)
{
@@ -9303,8 +9331,8 @@ float128_to_location( cblc_field_t *tgt,
switch(tgt->capacity)
{
case 4:
- if( fabsf128(value) == (_Float128)INFINITY
- || fabsf128(value) > 3.4028235E38Q )
+ if( FP128_FUNC(fabs)(value) == (GCOB_FP128)INFINITY
+ || FP128_FUNC(fabs)(value) > GCOB_FP128_LITERAL (3.4028235E38) )
{
if( compute_error )
{
@@ -9326,8 +9354,8 @@ float128_to_location( cblc_field_t *tgt,
break;
case 8:
- if( fabsf128(value) == (_Float128)INFINITY
- || fabsf128(value) > 1.7976931348623157E308Q )
+ if( FP128_FUNC(fabs)(value) == (GCOB_FP128)INFINITY
+ || FP128_FUNC(fabs)(value) > GCOB_FP128_LITERAL (1.7976931348623157E308) )
{
if( compute_error )
{
@@ -9349,7 +9377,7 @@ float128_to_location( cblc_field_t *tgt,
break;
case 16:
- if( fabsf128(value) == (_Float128)INFINITY )
+ if( FP128_FUNC(fabs)(value) == (GCOB_FP128)INFINITY )
{
if( compute_error )
{
@@ -9378,7 +9406,7 @@ float128_to_location( cblc_field_t *tgt,
digits = tgt->digits;
}
- _Float128 maximum;
+ GCOB_FP128 maximum;
if( digits )
{
@@ -9387,7 +9415,7 @@ float128_to_location( cblc_field_t *tgt,
// When digits is zero, this is a binary value without a PICTURE string.
// we don't truncate in that case
- if( digits && fabsf128(value) >= maximum )
+ if( digits && FP128_FUNC(fabs)(value) >= maximum )
{
*compute_error |= compute_error_truncate;
}
@@ -9415,7 +9443,7 @@ float128_to_location( cblc_field_t *tgt,
extern "C"
void
__gg__float128_to_field(cblc_field_t *tgt,
- _Float128 value,
+ GCOB_FP128 value,
enum cbl_round_t rounded,
int *compute_error)
{
@@ -9431,7 +9459,7 @@ extern "C"
void
__gg__float128_to_qualified_field(cblc_field_t *tgt,
size_t tgt_offset,
- _Float128 value,
+ GCOB_FP128 value,
enum cbl_round_t rounded,
int *compute_error)
{
@@ -10409,7 +10437,7 @@ __gg__fetch_call_by_value_value(cblc_field_t *field,
case 16:
// *(_Float128 *)(&retval) = double(*(_Float128 *)data);
- _Float128 t;
+ GCOB_FP128 t;
memcpy(&t, data, 16);
memcpy(&retval, &t, 16);
break;
@@ -10470,7 +10498,7 @@ __gg__assign_value_from_stack(cblc_field_t *dest, __int128 parameter)
case 16:
// *(_Float128 *)(dest->data) = *(_Float128 *)&parameter;
- _Float128 t;
+ GCOB_FP128 t;
memcpy(&t, &parameter, 16);
memcpy(dest->data, &t, 16);
break;
@@ -11306,10 +11334,10 @@ __gg__pseudo_return_flush()
}
extern "C"
-_Float128
+GCOB_FP128
__gg__float128_from_location(cblc_field_t *var, unsigned char *location)
{
- _Float128 retval = 0;
+ GCOB_FP128 retval = 0;
switch( var->capacity )
{
case 4:
@@ -11338,9 +11366,9 @@ extern "C"
__int128
__gg__integer_from_float128(cblc_field_t *field)
{
- _Float128 fvalue = __gg__float128_from_location(field, field->data);
+ GCOB_FP128 fvalue = __gg__float128_from_location(field, field->data);
// we round() to take care of the possible 2.99999999999... problem.
- fvalue = roundf128(fvalue);
+ fvalue = FP128_FUNC(round)(fvalue);
return (__int128)fvalue;
}
@@ -11566,13 +11594,13 @@ __gg__float32_from_int128(cblc_field_t *destination,
int *size_error)
{
int rdigits;
- _Float128 value = get_binary_value_local( &rdigits,
+ GCOB_FP128 value = get_binary_value_local( &rdigits,
source,
source->data + source_offset,
source->capacity);
value /= __gg__power_of_ten(rdigits);
- if( fabsf128(value) > 3.4028235E38Q )
+ if( FP128_FUNC(fabs)(value) > GCOB_FP128_LITERAL (3.4028235E38) )
{
if(size_error)
{
@@ -11607,7 +11635,7 @@ __gg__float64_from_int128(cblc_field_t *destination,
*size_error = 0;
}
int rdigits;
- _Float128 value = get_binary_value_local( &rdigits,
+ GCOB_FP128 value = get_binary_value_local( &rdigits,
source,
source->data + source_offset,
source->capacity);
@@ -11630,7 +11658,7 @@ __gg__float128_from_int128(cblc_field_t *destination,
{
if(size_error) *size_error = 0;
int rdigits;
- _Float128 value = get_binary_value_local( &rdigits,
+ GCOB_FP128 value = get_binary_value_local( &rdigits,
source,
source->data + source_offset,
source->capacity);
@@ -11657,7 +11685,7 @@ __gg__is_float_infinite(cblc_field_t *source, size_t offset)
break;
case 16:
// retval = *(_Float128*)(source->data+offset) == INFINITY;
- _Float128 t;
+ GCOB_FP128 t;
memcpy(&t, source->data+offset, 16);
retval = t == INFINITY;
break;
@@ -11674,9 +11702,9 @@ __gg__float32_from_128( cblc_field_t *dest,
{
int retval = 0;
//_Float128 value = *(_Float128*)(source->data+source_offset);
- _Float128 value;
+ GCOB_FP128 value;
memcpy(&value, source->data+source_offset, 16);
- if( fabsf128(value) > 3.4028235E38Q )
+ if( FP128_FUNC(fabs)(value) > GCOB_FP128_LITERAL (3.4028235E38) )
{
retval = 1;
}
@@ -11696,7 +11724,7 @@ __gg__float32_from_64( cblc_field_t *dest,
{
int retval = 0;
_Float64 value = *(_Float64*)(source->data+source_offset);
- if( fabsf128(value) > 3.4028235E38Q )
+ if( FP128_FUNC(fabs)(value) > GCOB_FP128_LITERAL (3.4028235E38) )
{
retval = 1;
}
@@ -11716,9 +11744,9 @@ __gg__float64_from_128( cblc_field_t *dest,
{
int retval = 0;
// _Float128 value = *(_Float128*)(source->data+source_offset);
- _Float128 value;
+ GCOB_FP128 value;
memcpy(&value, source->data+source_offset, 16);
- if( fabsf128(value) > 1.7976931348623157E308 )
+ if( FP128_FUNC(fabs)(value) > 1.7976931348623157E308 )
{
retval = 1;
}
diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h
index 246ef51..f35987d 100644
--- a/libgcobol/libgcobol.h
+++ b/libgcobol/libgcobol.h
@@ -67,7 +67,7 @@ extern "C" void __gg__int128_to_field(cblc_field_t *tgt,
enum cbl_round_t rounded,
int *compute_error);
extern "C" void __gg__float128_to_field(cblc_field_t *tgt,
- _Float128 value,
+ GCOB_FP128 value,
enum cbl_round_t rounded,
int *compute_error);
extern "C" void __gg__int128_to_qualified_field(cblc_field_t *tgt,
@@ -79,10 +79,9 @@ extern "C" void __gg__int128_to_qualified_field(cblc_field_t *tgt,
int *compute_error);
extern "C" void __gg__float128_to_qualified_field(cblc_field_t *tgt,
size_t tgt_offset,
- _Float128 value,
+ GCOB_FP128 value,
enum cbl_round_t rounded,
int *compute_error);
-
extern "C" void __gg__double_to_target( cblc_field_t *tgt,
double tgt_value,
cbl_round_t rounded);
@@ -91,7 +90,8 @@ extern "C" char __gg__get_decimal_point();
extern "C" char * __gg__get_default_currency_string();
extern "C" void __gg__clock_gettime(clockid_t clk_id, struct timespec *tp);
-extern "C" _Float128 __gg__float128_from_location(cblc_field_t *var,
+
+extern "C" GCOB_FP128 __gg__float128_from_location(cblc_field_t *var,
unsigned char *location);
extern "C" void __gg__adjust_dest_size(cblc_field_t *dest, size_t ncount);
@@ -104,7 +104,7 @@ extern "C" __int128 __gg__binary_value_from_qualified_field(int *rdigits,
cblc_field_t *var,
size_t offset,
size_t size);
-extern "C" _Float128 __gg__float128_from_qualified_field(cblc_field_t *field,
+extern "C" GCOB_FP128 __gg__float128_from_qualified_field(cblc_field_t *field,
size_t offset,
size_t size);
extern "C" __int128 __gg__integer_from_qualified_field(cblc_field_t *var,
diff --git a/libgcobol/libgcobol.spec.in b/libgcobol/libgcobol.spec.in
index e8ccc0d..461587d 100644
--- a/libgcobol/libgcobol.spec.in
+++ b/libgcobol/libgcobol.spec.in
@@ -5,4 +5,4 @@
#
%rename lib liborig
-*lib: @LIBM@ %(liborig)
+*lib: @LIBQUADSPEC@ @LIBM@ %(liborig)
generated by cgit v1.1 at 2025-09-07 10:32:22 +0000