aboutsummaryrefslogtreecommitdiff
path: root/libgcobol
diff options
context:
space:
mode:
Diffstat (limited to 'libgcobol')
-rw-r--r--libgcobol/ChangeLog85
-rw-r--r--libgcobol/Makefile.am9
-rw-r--r--libgcobol/Makefile.in14
-rw-r--r--libgcobol/acinclude.m4162
-rw-r--r--libgcobol/config.h.in33
-rwxr-xr-xlibgcobol/configure605
-rw-r--r--libgcobol/configure.ac44
-rw-r--r--libgcobol/configure.tgt7
-rw-r--r--libgcobol/gfileio.cc32
-rw-r--r--libgcobol/gmath.cc108
-rw-r--r--libgcobol/intrinsic.cc184
-rw-r--r--libgcobol/libgcobol-fp.h59
-rw-r--r--libgcobol/libgcobol.cc225
-rw-r--r--libgcobol/libgcobol.h10
-rw-r--r--libgcobol/libgcobol.spec.in2
-rw-r--r--libgcobol/valconv.cc6
16 files changed, 1220 insertions, 365 deletions
diff --git a/libgcobol/ChangeLog b/libgcobol/ChangeLog
index 28cd912..9de1714 100644
--- a/libgcobol/ChangeLog
+++ b/libgcobol/ChangeLog
@@ -1,3 +1,88 @@
+2025-04-21 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
+
+ * configure.ac: Check for struct tm.tm_zone.
+ * configure, config.h.in: Regenerate.
+ * intrinsic.cc (__gg__formatted_current_date): Guard tm.tm_zone
+ use with HAVE_STRUCT_TM_TM_ZONE.
+
+2025-04-15 Andreas Schwab <schwab@suse.de>
+
+ * configure.tgt: Set LIBGCOBOL_SUPPORTED for riscv64-*-linux* with
+ 64-bit multilib.
+
+2025-04-15 Jakub Jelinek <jakub@redhat.com>
+ Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
+
+ PR cobol/119244
+ * acinclude.m4 (LIBGCOBOL_CHECK_FLOAT128): Ensure
+ libgcob_cv_have_float128 is not yes on targets with IEEE quad
+ long double. Don't check for --as-needed nor set LIBQUADSPEC
+ on targets which USE_IEC_60559.
+ * libgcobol-fp.h (FP128_FMT, strtofp128, strfromfp128): Define.
+ * intrinsic.cc (strtof128): Don't redefine.
+ (WEIRD_TRANSCENDENT_RETURN_VALUE): Use GCOB_FP128_LITERAL macro.
+ (__gg__numval_f): Use strtofp128 instead of strtof128.
+ * libgcobol.cc (strtof128): Don't redefine.
+ (format_for_display_internal): Use strfromfp128 instead of
+ strfromf128 or quadmath_snprintf and use FP128_FMT in the format
+ string.
+ (get_float128, __gg__compare_2, __gg__move, __gg__move_literala):
+ Use strtofp128 instead of strtof128.
+ * configure: Regenerate.
+
+2025-04-14 Andreas Schwab <schwab@suse.de>
+
+ * libgcobol.cc (__gg__float64_from_128): Mark literal as float128
+ literal.
+
+2025-04-13 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
+
+ * valconv.cc (__gg__string_to_numeric_edited): Use strchr instead
+ of index.
+
+2025-04-12 Bob Dubner <rdubner@symas.com>
+
+ PR cobol/119694
+ * gfileio.cc: Eliminate getenv() calls.
+ * libgcobol.cc: Likewise.
+
+2025-04-10 Iain Sandoe <iain@sandoe.co.uk>
+
+ * configure.tgt: Enable for x86_64 Darwin.
+
+2025-04-10 Iain Sandoe <iain@sandoe.co.uk>
+
+ PR cobol/119244
+ * 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.
+
+2025-04-09 Bob Dubner <rdubner@symas.com>
+
+ PR cobol/119682
+ * common-defs.h: Define the REFER_T_REFMOD constant.
+ * intrinsic.cc: (__gg__max): Change the calls to __gg__compare_2(),
+ (__gg__min): Likewise, (__gg__ord_min): Likewise,
+ (__gg__ord_max): Likewise.
+ * libgcobol.cc: (__gg__compare_2): Change definition of calling
+ parameters, eliminate separate flag bit for ALL and ADDRESS_OF,
+ change comparison of alphanumeric to numeric when the numeric
+ is a refmod.
+ * libgcobol.h: Change declaration of __gg__compare_2.
+
2025-04-05 Iain Sandoe <iain@sandoe.co.uk>
* Makefile.am: Add libgcobol.spec and dependency.
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..0e81b10 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([
+#if __LDBL_MANT_DIG__ == 113 && __LDBL_MIN_EXP__ == -16381
+#error "long double is IEEE quad, no need for libquadmath"
+#endif
+
+ _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.])
+
+ if test "x$USE_IEC_60559" != xyes; then
+ 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
+
+ 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 -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..fdf5e3e 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,12 @@
/* 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 `tm_zone' is a member of `struct tm'. */
+#undef HAVE_STRUCT_TM_TM_ZONE
+
/* Define to 1 if you have the <sys/stat.h> header file. */
#undef HAVE_SYS_STAT_H
@@ -88,6 +115,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..6821591 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
@@ -2408,6 +2449,63 @@ $as_echo "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_cxx_check_func
+
+# ac_fn_cxx_check_member LINENO AGGR MEMBER VAR INCLUDES
+# ------------------------------------------------------
+# Tries to find if the field MEMBER exists in type AGGR, after including
+# INCLUDES, setting cache variable VAR accordingly.
+ac_fn_cxx_check_member ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
+$as_echo_n "checking for $2.$3... " >&6; }
+if eval \${$4+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (sizeof ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_cxx_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ eval "$4=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$4
+ { $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_member
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
@@ -2692,12 +2790,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 +11750,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 11753 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -11750,7 +11856,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 11859 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@@ -16861,9 +16967,162 @@ 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
+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 sinf128 ();
+int
+main ()
+{
+return sinf128 ();
+ ;
+ 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_sinf128=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_sinf128+:} false; then :
+ break
+fi
+done
+if ${ac_cv_search_sinf128+:} false; then :
+
+else
+ 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_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
@@ -16876,11 +17135,11 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
#ifdef __cplusplus
extern "C"
#endif
-char cosf128 ();
+char cacosf128 ();
int
main ()
{
-return cosf128 ();
+return cacosf128 ();
;
return 0;
}
@@ -16896,80 +17155,354 @@ 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_cacosf128=$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_cacosf128+:} false; then :
break
fi
done
-if ${ac_cv_search_cosf128+:} false; then :
+if ${ac_cv_search_cacosf128+:} false; then :
else
- ac_cv_search_cosf128=no
+ 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_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_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
+
+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
+# 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
-# libgcobol soname version
-LIBGCOBOL_VERSION=1:0:0
+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
-## added, currently unused.
-# VERSION_SUFFIX=$(echo $LIBGCOBOL_VERSION | tr ':' '.' )
-# AC_SUBST(VERSION_SUFFIX)
-## end added
+ if test "x$enable_libquadmath_support" = "xno"; then
+ if test "x$have_iec_60559_libc_support" = "xyes"; then
-extra_ldflags_libgcobol=
-case $host in
- *-*-darwin*)
- extra_ldflags_libgcobol=-Wl,-U,___cobol_main ;;
- *) ;;
-esac
+$as_echo "#define USE_IEC_60559 1" >>confdefs.h
+ fi
+ else
-# These are GLIBC
+ { $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. */
+#if __LDBL_MANT_DIG__ == 113 && __LDBL_MIN_EXP__ == -16381
+#error "long double is IEEE quad, no need for libquadmath"
+#endif
- 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
+ _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. */
+
+#if __LDBL_MANT_DIG__ == 113 && __LDBL_MIN_EXP__ == -16381
+#error "long double is IEEE quad, no need for libquadmath"
+#endif
+
+ _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
+
+
+ if test "x$USE_IEC_60559" != xyes; then
+ 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 -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.
+# struct tm tm_zone is a POSIX.1-2024 addition.
+ac_fn_cxx_check_member "$LINENO" "struct tm" "tm_zone" "ac_cv_member_struct_tm_tm_zone" "#include <time.h>
+"
+if test "x$ac_cv_member_struct_tm_tm_zone" = xyes; then :
+cat >>confdefs.h <<_ACEOF
+#define HAVE_STRUCT_TM_TM_ZONE 1
+_ACEOF
+fi
+
if test "${multilib}" = "yes"; then
multilib_arg="--enable-multilib"
diff --git a/libgcobol/configure.ac b/libgcobol/configure.ac
index ca56997..4bb6905 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,53 @@ 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
+
+# struct tm tm_zone is a POSIX.1-2024 addition.
+AC_CHECK_MEMBERS([struct tm.tm_zone],,,[#include <time.h>])
+
if test "${multilib}" = "yes"; then
multilib_arg="--enable-multilib"
else
diff --git a/libgcobol/configure.tgt b/libgcobol/configure.tgt
index c5e263a..a239252 100644
--- a/libgcobol/configure.tgt
+++ b/libgcobol/configure.tgt
@@ -34,7 +34,12 @@ case "${target}" in
LIBGCOBOL_SUPPORTED=yes
fi
;;
- x86_64-*-linux* | i?86-*-linux*)
+ riscv64-*-linux*)
+ if test x$ac_cv_sizeof_void_p = x8; then
+ LIBGCOBOL_SUPPORTED=yes
+ fi
+ ;;
+ x86_64-*-linux* | i?86-*-linux* | x86_64-*-darwin*)
if test x$ac_cv_sizeof_void_p = x8; then
LIBGCOBOL_SUPPORTED=yes
fi
diff --git a/libgcobol/gfileio.cc b/libgcobol/gfileio.cc
index ed250c4..e6ad03fc 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"
@@ -4054,34 +4055,6 @@ file_indexed_close(cblc_file_t *file)
file->supplemental = NULL;
}
-static void
-report_open_failure(const char *type,
- const char *structure_name,
- const char *filename)
- {
- bool quiet = true;
- if( !quiet )
- {
- if( getenv(filename) )
- {
- fprintf(stderr,
- "Trying to 'OPEN %s %s %s -> \"%s\"', which doesn't exist\n",
- type,
- structure_name,
- filename,
- getenv(filename));
- }
- else
- {
- fprintf(stderr,
- "Trying to 'OPEN %s %s \"%s\"', which doesn't exist\n",
- type,
- structure_name,
- filename);
- }
- }
- }
-
extern "C"
void
__gg__file_reopen(cblc_file_t *file, int mode_char)
@@ -4210,7 +4183,6 @@ __gg__file_reopen(cblc_file_t *file, int mode_char)
}
else
{
- report_open_failure("INPUT", file->name, trimmed_name);
file->io_status = FsNoFile; // "35"
goto done;
}
@@ -4252,7 +4224,6 @@ __gg__file_reopen(cblc_file_t *file, int mode_char)
else
{
// Trying to extend a non-optional non-existing file is against the rules
- report_open_failure("EXTEND", file->name, trimmed_name);
file->io_status = FsNoFile; // "35"
goto done;
}
@@ -4268,7 +4239,6 @@ __gg__file_reopen(cblc_file_t *file, int mode_char)
}
else
{
- report_open_failure("I-O", file->name, trimmed_name);
file->io_status = FsNoFile; // "35"
goto done;
}
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..97f2bdc 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,11 +54,12 @@
#include "libgcobol.h"
#include "charmaps.h"
+
#pragma GCC diagnostic ignored "-Wformat-truncation"
#define JD_OF_1601_01_02 2305812.5
-#define WEIRD_TRANSCENDENT_RETURN_VALUE (0.0Q)
+#define WEIRD_TRANSCENDENT_RETURN_VALUE GCOB_FP128_LITERAL (0.0)
#define NO_RDIGITS (0)
struct cobol_tm
@@ -406,7 +408,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 +422,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 +454,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 +465,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 +482,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 +960,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 +982,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 +1013,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 +1033,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 +1055,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 +1085,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 +1197,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 +1370,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 +1387,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 +1406,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,
@@ -1479,7 +1482,9 @@ __gg__formatted_current_date( cblc_field_t *dest, // Destination string
__gg__clock_gettime(CLOCK_REALTIME, &ts);
struct tm tm = {};
+#ifdef HAVE_STRUCT_TM_TM_ZONE
tm.tm_zone = "GMT";
+#endif
if( is_zulu )
{
gmtime_r(&ts.tv_sec, &tm);
@@ -1658,10 +1663,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 +1763,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 +1786,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 +1796,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 +1816,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 +1825,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 +1841,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 +1850,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 +1936,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 +1953,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 +1997,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 +2026,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 +2039,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 +2055,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 +2078,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 +2107,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 +2192,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 +2209,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 +2581,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 +3151,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 +3164,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 +3178,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 +3216,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 +3246,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 +3270,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 +3286,7 @@ __gg__rem(cblc_field_t *dest,
}
else
{
- modff128(arg1 / arg2, &intpart);
+ FP128_FUNC(modf)(arg1 / arg2, &intpart);
retval = arg1 - arg2 * intpart;
}
@@ -3500,7 +3506,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 +3539,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 +3560,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 +3585,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 +3605,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 +3626,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 +3749,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 +4986,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;
@@ -5004,7 +5010,7 @@ __gg__numval_f( cblc_field_t *dest,
}
}
*p++ = '\0';
- value = strtof128(ach, NULL);
+ value = strtofp128(ach, NULL);
}
__gg__float128_to_field(dest,
value,
diff --git a/libgcobol/libgcobol-fp.h b/libgcobol/libgcobol-fp.h
new file mode 100644
index 0000000..fcfa0a7
--- /dev/null
+++ b/libgcobol/libgcobol-fp.h
@@ -0,0 +1,59 @@
+/* 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
+# define FP128_FMT "L"
+# define strtofp128(nptr, endptr) strtold(nptr, endptr)
+# define strfromfp128(str, n, format, fp) snprintf(str, n, format, fp)
+#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
+# define FP128_FMT ""
+# define strtofp128(nptr, endptr) strtof128(nptr, endptr)
+# define strfromfp128(str, n, format, fp) strfromf128(str, n, format, fp)
+#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
+# define FP128_FMT "Q"
+# define strtofp128(nptr, endptr) strtoflt128(nptr, endptr)
+# define strfromfp128(str, n, format, fp) quadmath_snprintf(str, n, format, fp)
+#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..c438d6b 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"
@@ -216,12 +217,16 @@ local_ec_type_descr( ec_type_t type ) {
return p;
}
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wunused-function"
+// Keep this debugging function around for when it is needed
static const char *
local_ec_type_str( ec_type_t type ) {
if( type == ec_none_e ) return "EC-NONE";
auto p = local_ec_type_descr(type);
return p->name;
}
+#pragma GCC diagnostic pop
ec_status_t& ec_status_t::update() {
handled = ec_type_t(__gg__exception_handled);
@@ -233,13 +238,6 @@ ec_status_t& ec_status_t::update() {
snprintf(statement, sizeof(statement), "%s", __gg__exception_statement);
}
- if( type != ec_none_e && getenv("match_declarative") ) {
- warnx( "ec_status_t::update:%d: EC %s by %s handled %02X " , __LINE__,
- local_ec_type_str(type),
- __gg__exception_statement? statement : "<none>",
- handled ); // might be file-status, not ec_type_t
- }
-
return *this;
}
@@ -881,10 +879,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 +905,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 +946,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 +1035,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 +1066,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 +1107,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 +1278,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);
@@ -2202,7 +2204,7 @@ extern "C"
void
__gg__clock_gettime(clockid_t clk_id, struct timespec *tp)
{
- const char *p = getenv("COB_CURRENT_DATE");
+ const char *p = getenv("GCOBOL_CURRENT_DATE");
if( p )
{
@@ -2573,7 +2575,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 +2591,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 +3246,9 @@ 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);
- strfromf128(ach, sizeof(ach), "%.36E", floatval);
+ strfromfp128(ach, sizeof(ach), "%.36" FP128_FMT "E", floatval);
char *p = strchr(ach, 'E');
if( !p )
{
@@ -3268,8 +3270,8 @@ format_for_display_internal(char **dest,
int precision = 36 - exp;
char achFormat[24];
- sprintf(achFormat, "%%.%df", precision);
- strfromf128(ach, sizeof(ach), achFormat, floatval);
+ sprintf(achFormat, "%%.%d" FP128_FMT "f", precision);
+ strfromfp128(ach, sizeof(ach), achFormat, floatval);
}
__gg__remove_trailing_zeroes(ach);
__gg__realloc_if_necessary(dest, dest_size, strlen(ach)+1);
@@ -3481,11 +3483,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 )
@@ -3508,7 +3510,7 @@ get_float128( cblc_field_t *field,
{
if( __gg__decimal_point == '.' )
{
- retval = strtof128(field->initial, NULL);
+ retval = strtofp128(field->initial, NULL);
}
else
{
@@ -3526,7 +3528,7 @@ get_float128( cblc_field_t *field,
{
*p = '.';
}
- retval = strtof128(buffer, NULL);
+ retval = strtofp128(buffer, NULL);
}
}
else
@@ -3710,7 +3712,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 +3736,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 +3747,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 +4102,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 +4159,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 +4172,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 +4205,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 +4214,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 +4223,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 = strtofp128(buffer, NULL);
retval = 0;
retval = left_value < right_value ? -1 : retval;
retval = left_value > right_value ? 1 : retval;
@@ -5725,7 +5727,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 +5815,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 +5965,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);
+ //*(_Float128 *)(fdest->data+dest_offset) = strtofp128(ach, NULL);
+ GCOB_FP128 t = strtofp128(ach, NULL);
memcpy(fdest->data+dest_offset, &t, 16);
break;
}
@@ -6133,17 +6135,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 = strtofp128(ach, NULL);
memcpy(field->data+field_offset, &t, 16);
break;
}
@@ -9127,10 +9129,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 +9140,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 +9161,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 +9230,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 +9255,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 +9272,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 +9294,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 +9305,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 +9328,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 +9351,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 +9380,7 @@ float128_to_location( cblc_field_t *tgt,
digits = tgt->digits;
}
- _Float128 maximum;
+ GCOB_FP128 maximum;
if( digits )
{
@@ -9387,7 +9389,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 +9417,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 +9433,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 +10411,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 +10472,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;
@@ -10983,13 +10985,6 @@ class match_file_declarative {
bool operator()( const cbl_declarative_t& dcl ) {
- if( getenv("match_declarative") && oops.type) {
- warnx("match_file_declarative: checking: oops %s dcl %s (handled %s) ",
- local_ec_type_str(oops.type),
- local_ec_type_str(dcl.type),
- local_ec_type_str(handled_type));
- }
-
// Declarative is for the raised exception and not handled by the statement.
if( handled() ) return false;
bool matches = enabled_ECs.match(dcl.type);
@@ -11003,13 +10998,6 @@ class match_file_declarative {
}
}
- if( matches && getenv("match_declarative") ) {
- warnx(" matches exception %s (file %zu mode %s)",
- local_ec_type_str(oops.type),
- oops.file,
- cbl_file_mode_str(oops.mode));
- }
-
return matches;
}
};
@@ -11209,25 +11197,12 @@ __gg__match_exception( cblc_field_t *index,
p = std::find_if( dcls + 1, eodcls, [ec] (const cbl_declarative_t& dcl) {
if( ! enabled_ECs.match(dcl.type) ) return false;
if( ! ec_cmp(ec, dcl.type) ) return false;
-
- if( getenv("match_declarative") ) {
- warnx("__gg__match_exception:%d: matched "
- "%s against mask %s for section #%zu",
- __LINE__,
- local_ec_type_str(ec), local_ec_type_str(dcl.type),
- dcl.section);
- }
return true;
} );
if( p == eodcls ) {
default_exception_handler(ec);
}
} else { // not enabled
- if( getenv("match_declarative") ) {
- warnx("__gg__match_exception:%d: raised exception "
- "%s is disabled (%zu enabled)", __LINE__,
- local_ec_type_str(ec), enabled_ECs.nec);
- }
}
}
@@ -11306,10 +11281,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 +11313,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;
}
@@ -11459,10 +11434,6 @@ extern "C"
void
__gg__set_exception_file(cblc_file_t *file)
{
- if( getenv("match_declarative") )
- {
- warnx("%s: %s", __func__, file->name);
- }
recent_file = file;
ec_type_t ec = local_ec_type_of( file->io_status );
if( ec )
@@ -11519,10 +11490,6 @@ extern "C"
void
__gg__set_exception_code(ec_type_t ec, int from_raise_statement)
{
- if( getenv("match_declarative") )
- {
- warnx("%s: raised %02x", __func__, ec);
- }
sv_from_raise_statement = from_raise_statement;
__gg__exception_code = ec;
@@ -11566,13 +11533,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 +11574,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 +11597,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 +11624,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 +11641,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 +11663,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 +11683,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) > GCOB_FP128_LITERAL(1.7976931348623157E308) )
{
retval = 1;
}
@@ -11970,7 +11937,7 @@ __gg__function_handle_from_cobpath( char *unmangled_name, char *mangled_name)
}
if( !retval )
{
- const char *COBPATH = getenv("COBPATH");
+ const char *COBPATH = getenv("GCOBOL_LIBRARY_PATH");
retval = find_in_dirs(COBPATH, unmangled_name, mangled_name);
}
if( !retval )
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)
diff --git a/libgcobol/valconv.cc b/libgcobol/valconv.cc
index 33d9a0d..7e58301 100644
--- a/libgcobol/valconv.cc
+++ b/libgcobol/valconv.cc
@@ -853,14 +853,14 @@ got_float:
}
else
{
- const char *decimal_location = index(dest, __gg__decimal_point);
+ const char *decimal_location = strchr(dest, __gg__decimal_point);
if( !decimal_location )
{
- decimal_location = index(dest, ascii_v);
+ decimal_location = strchr(dest, ascii_v);
}
if( !decimal_location )
{
- decimal_location = index(dest, ascii_V);
+ decimal_location = strchr(dest, ascii_V);
}
if( !decimal_location )
{
generated by cgit v1.1 at 2025-04-22 19:55:49 +0000