procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

libgcobol: Allow libgcobol to use libquadmath [PR119244].

Browse source 
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>
This commit is contained in:
Iain Sandoe 2025-03-15 22:58:46 +00:00
parent f1e82c859f
commit 95f10974a9
13 changed files with 1074 additions and 304 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
libgcobol/Makefile.am
View file

@ -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

14
libgcobol/Makefile.in
View file

@ -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

162
libgcobol/acinclude.m4
View file

@ -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)
])

30
libgcobol/config.h.in
View file

@ -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

579
libgcobol/configure vendored
View file

@ -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,65 +16910,6 @@ 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 :
$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 cosf128 ();
int
main ()
{
return cosf128 ();
;
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_cosf128=$ac_res
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext
if ${ac_cv_search_cosf128+:} false; then :
break
fi
done
if ${ac_cv_search_cosf128+:} false; then :
else
ac_cv_search_cosf128=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
if test "$ac_res" != no; then :
test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
fi
# libgcobol soname version
LIBGCOBOL_VERSION=1:0:0
@ -16938,6 +16928,37 @@ case $host in
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
@ -16964,7 +16985,441 @@ done
# 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.
# 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
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
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
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
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
{ $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
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

41
libgcobol/configure.ac
View file

@ -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

1
libgcobol/gfileio.cc
View file

@ -41,6 +41,7 @@
#include <algorithm>
#include "config.h"
#include "libgcobol-fp.h"
#include "ec.h"
#include "io.h"

108
libgcobol/gmath.cc
View file

@ -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);

186
libgcobol/intrinsic.cc
View file

@ -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;

50
libgcobol/libgcobol-fp.h Normal file
View file

@ -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

186
libgcobol/libgcobol.cc
View file

@ -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;
}

10
libgcobol/libgcobol.h
View file

@ -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,

2
libgcobol/libgcobol.spec.in
View file

@ -5,4 +5,4 @@
#
%rename lib liborig
*lib: @LIBM@ %(liborig)
*lib: @LIBQUADSPEC@ @LIBM@ %(liborig)