Skip to content

R
riscv-gcc-1
Commit 82a4f54c by Tobias Burnus Committed by Tobias Burnus
Options

re PR libfortran/35862 ([F2003] Implement new rounding modes for run time) 

2013-07-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/35862
        * libgfortran.h (GFC_FPE_DOWNWARD, GFC_FPE_TONEAREST,
        GFC_FPE_TOWARDZERO, GFC_FPE_UPWARD): New defines.

2013-07-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/35862
        * libgfortran.h (set_fpu_rounding_mode,
        get_fpu_rounding_mode): New prototypes.
        * config/fpu-387.h (set_fpu_rounding_mode,
        get_fpu_rounding_mode): New functions.
        * config/fpu-aix.h (set_fpu_rounding_mode,
        get_fpu_rounding_mode): Ditto.
        * config/fpu-generic.h (set_fpu_rounding_mode,
        get_fpu_rounding_mode): Ditto.
        * config/fpu-glibc.h (set_fpu_rounding_mode,
        get_fpu_rounding_mode): Ditto.
        * config/fpu-sysv.h (set_fpu_rounding_mode,
        get_fpu_rounding_mode): Ditto.
        * configure.ac: Check for fp_rnd and fp_rnd_t.
        * io/io.h (enum unit_round): Use GFC_FPE_* for the value.
        * io/read.c (convert_real): Set FP ronding mode.
        * Makefile.in: Regenerate.
        * aclocal.m4: Regenerate.
        * config.h.in: Regenerate.
        * configure: Regenerate.

2013-07-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/35862
        * gfortran.dg/round_4.f90: New.


Co-Authored-By: Uros Bizjak <ubizjak@gmail.com>

From-SVN: r201093
parent 3b833dcd
Showing with 571 additions and 88 deletions
gcc/fortran/ChangeLog
2013-07-21 Tobias Burnus <burnus@net-b.de>
PR fortran/35862
* libgfortran.h (GFC_FPE_DOWNWARD, GFC_FPE_TONEAREST,
GFC_FPE_TOWARDZERO, GFC_FPE_UPWARD): New defines.
2013-07-21 Tobias Burnus <burnus@net-b.de>
PR fortran/57894
* check.c (min_max_args): Add keyword= check.
......
gcc/fortran/libgfortran.h
......@@ -43,6 +43,12 @@ along with GCC; see the file COPYING3. If not see
#define GFC_FPE_UNDERFLOW (1<<4)
#define GFC_FPE_INEXACT (1<<5)
/* Defines for floating-point rounding modes. */
#define GFC_FPE_DOWNWARD 1
#define GFC_FPE_TONEAREST 2
#define GFC_FPE_TOWARDZERO 3
#define GFC_FPE_UPWARD 4
/* Bitmasks for the various runtime checks that can be enabled. */
#define GFC_RTCHECK_BOUNDS (1<<0)
......
gcc/testsuite/ChangeLog
2013-07-21 Tobias Burnus <burnus@net-b.de>
PR fortran/35862
* gfortran.dg/round_4.f90: New.
2013-07-21 Tobias Burnus <burnus@net-b.de>
PR fortran/57894
* gfortran.dg/min_max_conformance_2.f90: New.
......
gcc/testsuite/gfortran.dg/round_4.f90 0 → 100644
! { dg-do run }
! { dg-add-options ieee }
!
! PR fortran/35862
!
! Test whether I/O rounding works. Uses internally (libgfortran) strtod
! for the conversion - and sets the CPU rounding mode accordingly.
!
! If it doesn't work on your system, please check whether strtod handles
! rounding and whether your system is supported in libgfortran/config/fpu*.c
!
! Please only add ... run { target { ! { triplets } } } if it is unfixable
! on your target - and a note why (strtod doesn't handle it, no rounding
! support, etc.)
!
program main
use iso_fortran_env
implicit none
! The following uses kinds=10 and 16 if available or
! 8 and 10 - or 8 and 16 - or 4 and 8.
integer, parameter :: xp = real_kinds(ubound(real_kinds,dim=1)-1)
integer, parameter :: qp = real_kinds(ubound(real_kinds,dim=1))
real(4) :: r4p, r4m, ref4u, ref4d
real(8) :: r8p, r8m, ref8u, ref8d
real(xp) :: r10p, r10m, ref10u, ref10d
real(qp) :: r16p, r16m, ref16u, ref16d
character(len=20) :: str, round
ref4u = 0.100000001_4
ref8u = 0.10000000000000001_8
if (xp == 4) then
ref10u = 0.100000001_xp
elseif (xp == 8) then
ref10u = 0.10000000000000001_xp
else ! xp == 10
ref10u = 0.1000000000000000000014_xp
end if
if (qp == 8) then
ref16u = 0.10000000000000001_qp
elseif (qp == 10) then
ref16u = 0.1000000000000000000014_qp
else ! qp == 16
ref16u = 0.10000000000000000000000000000000000481_qp
end if
! ref*d = 9.999999...
ref4d = nearest (ref4u, -1.0_4)
ref8d = nearest (ref8u, -1.0_8)
ref10d = nearest (ref10u, -1.0_xp)
ref16d = nearest (ref16u, -1.0_qp)
round = 'up'
call t()
if (r4p /= ref4u .or. r4m /= -ref4d) call abort()
if (r8p /= ref8u .or. r8m /= -ref8d) call abort()
if (r10p /= ref10u .or. r10m /= -ref10d) call abort()
if (r16p /= ref16u .or. r16m /= -ref16d) call abort()
round = 'down'
call t()
if (r4p /= ref4d .or. r4m /= -ref4u) call abort()
if (r8p /= ref8d .or. r8m /= -ref8u) call abort()
if (r10p /= ref10d .or. r10m /= -ref10u) call abort()
if (r16p /= ref16d .or. r16m /= -ref16u) call abort()
round = 'zero'
call t()
if (r4p /= ref4d .or. r4m /= -ref4d) call abort()
if (r8p /= ref8d .or. r8m /= -ref8d) call abort()
if (r10p /= ref10d .or. r10m /= -ref10d) call abort()
if (r16p /= ref16d .or. r16m /= -ref16d) call abort()
round = 'nearest'
call t()
if (r4p /= ref4u .or. r4m /= -ref4u) call abort()
if (r8p /= ref8u .or. r8m /= -ref8u) call abort()
if (r10p /= ref10u .or. r10m /= -ref10u) call abort()
if (r16p /= ref16u .or. r16m /= -ref16u) call abort()
! Same as nearest (but rounding towards zero if there is a tie
! [does not apply here])
round = 'compatible'
call t()
if (r4p /= ref4u .or. r4m /= -ref4u) call abort()
if (r8p /= ref8u .or. r8m /= -ref8u) call abort()
if (r10p /= ref10u .or. r10m /= -ref10u) call abort()
if (r16p /= ref16u .or. r16m /= -ref16u) call abort()
contains
subroutine t()
! print *, round
str = "0.1 0.1 0.1 0.1"
read (str, *,round=round) r4p, r8p, r10p, r16p
! write (*, '(*(g0:" "))') r4p, r8p, r10p, r16p
str = "-0.1 -0.1 -0.1 -0.1"
read (str, *,round=round) r4m, r8m, r10m, r16m
! write (*, *) r4m, r8m, r10m, r16m
end subroutine t
end program main
libgfortran/ChangeLog
2013-07-21 Tobias Burnus <burnus@net-b.de>
Uros Bizjak <ubizjak@gmail.com>
PR fortran/35862
* libgfortran.h (set_fpu_rounding_mode,
get_fpu_rounding_mode): New prototypes.
* config/fpu-387.h (set_fpu_rounding_mode,
get_fpu_rounding_mode): New functions.
* config/fpu-aix.h (set_fpu_rounding_mode,
get_fpu_rounding_mode): Ditto.
* config/fpu-generic.h (set_fpu_rounding_mode,
get_fpu_rounding_mode): Ditto.
* config/fpu-glibc.h (set_fpu_rounding_mode,
get_fpu_rounding_mode): Ditto.
* config/fpu-sysv.h (set_fpu_rounding_mode,
get_fpu_rounding_mode): Ditto.
* configure.ac: Check for fp_rnd and fp_rnd_t.
* io/io.h (enum unit_round): Use GFC_FPE_* for the value.
* io/read.c (convert_real): Set FP ronding mode.
* Makefile.in: Regenerate.
* aclocal.m4: Regenerate.
* config.h.in: Regenerate.
* configure: Regenerate.
2013-06-24 Tobias Burnus <burnus@net-b.de>
* configure.ac: Check for fp_except and fp_except_t.
......
libgfortran/Makefile.in
# Makefile.in generated by automake 1.11.3 from Makefile.am.
# Makefile.in generated by automake 1.11.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
# 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software
# Foundation, Inc.
# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
# Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
......@@ -87,12 +87,6 @@ am__nobase_list = $(am__nobase_strip_setup); \
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(cafexeclibdir)" \
"$(DESTDIR)$(myexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" \
"$(DESTDIR)$(toolexeclibdir)"
......@@ -1282,7 +1276,7 @@ all: $(BUILT_SOURCES) config.h
.SUFFIXES:
.SUFFIXES: .F90 .c .f90 .lo .o .obj
am--refresh: Makefile
am--refresh:
@:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
......@@ -1318,8 +1312,10 @@ $(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
$(am__aclocal_m4_deps):
config.h: stamp-h1
@if test ! -f $@; then rm -f stamp-h1; else :; fi
@if test ! -f $@; then $(MAKE) $(AM_MAKEFLAGS) stamp-h1; else :; fi
@if test ! -f $@; then \
rm -f stamp-h1; \
$(MAKE) $(AM_MAKEFLAGS) stamp-h1; \
else :; fi
stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status
@rm -f stamp-h1
......@@ -1426,11 +1422,11 @@ clean-toolexeclibLTLIBRARIES:
echo "rm -f \"$${dir}/so_locations\""; \
rm -f "$${dir}/so_locations"; \
done
libcaf_single.la: $(libcaf_single_la_OBJECTS) $(libcaf_single_la_DEPENDENCIES) $(EXTRA_libcaf_single_la_DEPENDENCIES)
libcaf_single.la: $(libcaf_single_la_OBJECTS) $(libcaf_single_la_DEPENDENCIES)
$(libcaf_single_la_LINK) -rpath $(cafexeclibdir) $(libcaf_single_la_OBJECTS) $(libcaf_single_la_LIBADD) $(LIBS)
libgfortran.la: $(libgfortran_la_OBJECTS) $(libgfortran_la_DEPENDENCIES) $(EXTRA_libgfortran_la_DEPENDENCIES)
libgfortran.la: $(libgfortran_la_OBJECTS) $(libgfortran_la_DEPENDENCIES)
$(libgfortran_la_LINK) -rpath $(toolexeclibdir) $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) $(LIBS)
libgfortranbegin.la: $(libgfortranbegin_la_OBJECTS) $(libgfortranbegin_la_DEPENDENCIES) $(EXTRA_libgfortranbegin_la_DEPENDENCIES)
libgfortranbegin.la: $(libgfortranbegin_la_OBJECTS) $(libgfortranbegin_la_DEPENDENCIES)
$(libgfortranbegin_la_LINK) -rpath $(myexeclibdir) $(libgfortranbegin_la_OBJECTS) $(libgfortranbegin_la_LIBADD) $(LIBS)
mostlyclean-compile:
......@@ -5690,7 +5686,9 @@ uninstall-toolexeclibDATA:
@$(NORMAL_UNINSTALL)
@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir)
test -n "$$files" || exit 0; \
echo " ( cd '$(DESTDIR)$(toolexeclibdir)' && rm -f" $$files ")"; \
cd "$(DESTDIR)$(toolexeclibdir)" && rm -f $$files
ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
......@@ -5762,15 +5760,10 @@ install-am: all-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
`test -z '$(STRIP)' || \
echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
mostlyclean-generic:
clean-generic:
......
libgfortran/config.h.in
......@@ -411,6 +411,12 @@
/* Define to 1 if the system has the type `fp_except_t'. */
#undef HAVE_FP_EXCEPT_T
/* Define to 1 if the system has the type `fp_rnd'. */
#undef HAVE_FP_RND
/* Define to 1 if the system has the type `fp_rnd_t'. */
#undef HAVE_FP_RND_T
/* fp_trap is present */
#undef HAVE_FP_TRAP
......
libgfortran/config/fpu-387.h
......@@ -88,7 +88,7 @@ has_sse (void)
#endif
}
/* i387 -- see linux <fpu_control.h> header file for details. */
/* i387 exceptions -- see linux <fpu_control.h> header file for details. */
#define _FPU_MASK_IM 0x01
#define _FPU_MASK_DM 0x02
#define _FPU_MASK_ZM 0x04
......@@ -99,7 +99,18 @@ has_sse (void)
#define _FPU_EX_ALL 0x3f
void set_fpu (void)
/* i387 rounding modes. */
#define _FPU_RC_NEAREST 0x0
#define _FPU_RC_DOWN 0x400
#define _FPU_RC_UP 0x800
#define _FPU_RC_ZERO 0xc00
#define _FPU_RC_MASK 0xc00
void
set_fpu (void)
{
int excepts = 0;
unsigned short cw;
......@@ -164,3 +175,72 @@ get_fpu_except_flags (void)
return result;
}
void
set_fpu_rounding_mode (int round)
{
int round_mode;
unsigned short cw;
switch (round)
{
case GFC_FPE_TONEAREST:
round_mode = _FPU_RC_NEAREST;
break;
case GFC_FPE_UPWARD:
round_mode = _FPU_RC_UP;
break;
case GFC_FPE_DOWNWARD:
round_mode = _FPU_RC_DOWN;
break;
case GFC_FPE_TOWARDZERO:
round_mode = _FPU_RC_ZERO;
break;
default:
return; /* Should be unreachable. */
}
__asm__ __volatile__ ("fnstcw\t%0" : "=m" (cw));
cw &= ~FPU_RC_MASK;
cw |= round_mode;
__asm__ __volatile__ ("fldcw\t%0" : : "m" (cw));
if (has_sse())
{
unsigned int cw_sse;
__asm__ __volatile__ ("%vstmxcsr\t%0" : "=m" (cw_sse));
/* The SSE round control bits are shifted by 3 bits. */
cw_sse &= ~(FPU_RC_MASK << 3);
cw_sse |= round_mode << 3;
__asm__ __volatile__ ("%vldmxcsr\t%0" : : "m" (cw_sse));
}
}
int
get_fpu_rounding_mode (void)
{
unsigned short cw;
__asm__ __volatile__ ("fnstcw\t%0" : "=m" (cw));
cw &= FPU_RC_MASK;
switch (cw)
{
case _FPU_RC_NEAREST:
return GFC_FPE_TONEAREST;
case _FPU_RC_UP:
return GFC_FPE_UPWARD;
case _FPU_RC_DOWN:
return GFC_FPE_DOWNWARD;
case _FPU_RC_ZERO:
return GFC_FPE_TOWARDZERO;
default:
return GFC_FPE_INVALID; /* Should be unreachable. */
}
}
libgfortran/config/fpu-aix.h
......@@ -116,3 +116,75 @@ get_fpu_except_flags (void)
return result;
}
int
get_fpu_rounding_mode (void)
{
int rnd_mode;
rnd_mode = fegetround ();
switch (rnd_mode)
{
#ifdef FE_TONEAREST
case FE_TONEAREST:
return GFC_FPE_TONEAREST;
#endif
#ifdef FE_UPWARD
case FE_UPWARD:
return GFC_FPE_UPWARD;
#endif
#ifdef FE_DOWNWARD
case FE_DOWNWARD:
return GFC_FPE_DOWNWARD;
#endif
#ifdef FE_TOWARDZERO
case FE_TOWARDZERO:
return GFC_FPE_TOWARDZERO;
#endif
default:
return GFC_FPE_INVALID;
}
}
void
set_fpu_rounding_mode (int mode)
{
int rnd_mode;
switch (mode)
{
#ifdef FE_TONEAREST
case GFC_FPE_TONEAREST:
rnd_mode = FE_TONEAREST;
break;
#endif
#ifdef FE_UPWARD
case GFC_FPE_UPWARD:
rnd_mode = FE_UPWARD;
break;
#endif
#ifdef FE_DOWNWARD
case GFC_FPE_DOWNWARD:
rnd_mode = FE_DOWNWARD;
break;
#endif
#ifdef FE_TOWARDZERO
case GFC_FPE_TOWARDZERO:
rnd_mode = FE_TOWARDZERO;
break;
#endif
default:
return;
}
fesetround (rnd_mode);
}
libgfortran/config/fpu-generic.h
......@@ -56,3 +56,16 @@ get_fpu_except_flags (void)
{
return 0;
}
int
get_fpu_rounding_mode (void)
{
return 0;
}
void
set_fpu_rounding_mode (int round __attribute__((unused)))
{
}
libgfortran/config/fpu-glibc.h
......@@ -127,3 +127,75 @@ get_fpu_except_flags (void)
return result;
}
int
get_fpu_rounding_mode (void)
{
int rnd_mode;
rnd_mode = fegetround ();
switch (rnd_mode)
{
#ifdef FE_TONEAREST
case FE_TONEAREST:
return GFC_FPE_TONEAREST;
#endif
#ifdef FE_UPWARD
case FE_UPWARD:
return GFC_FPE_UPWARD;
#endif
#ifdef FE_DOWNWARD
case FE_DOWNWARD:
return GFC_FPE_DOWNWARD;
#endif
#ifdef FE_TOWARDZERO
case FE_TOWARDZERO:
return GFC_FPE_TOWARDZERO;
#endif
default:
return GFC_FPE_INVALID;
}
}
void
set_fpu_rounding_mode (int mode)
{
int rnd_mode;
switch (mode)
{
#ifdef FE_TONEAREST
case GFC_FPE_TONEAREST:
rnd_mode = FE_TONEAREST;
break;
#endif
#ifdef FE_UPWARD
case GFC_FPE_UPWARD:
rnd_mode = FE_UPWARD;
break;
#endif
#ifdef FE_DOWNWARD
case GFC_FPE_DOWNWARD:
rnd_mode = FE_DOWNWARD;
break;
#endif
#ifdef FE_TOWARDZERO
case GFC_FPE_TOWARDZERO:
rnd_mode = FE_TOWARDZERO;
break;
#endif
default:
return;
}
fesetround (rnd_mode);
}
libgfortran/config/fpu-sysv.h
......@@ -128,3 +128,76 @@ get_fpu_except_flags (void)
return result;
}
int
get_fpu_rounding_mode (void)
{
switch (fpgetround ())
{
#ifdef FP_RN
case FP_RN:
return GFC_FPE_TONEAREST;
#endif
#ifdef FP_RP
case FP_RP:
return GFC_FPE_UPWARD;
#endif
#ifdef FP_RM
case FP_RM:
return GFC_FPE_DOWNWARD;
#endif
#ifdef FP_RZ
case FP_RZ:
return GFC_FPE_TOWARDZERO;
#endif
default:
return GFC_FPE_INVALID;
}
}
void
set_fpu_rounding_mode (int mode)
{
#if HAVE_FP_RND
fp_rnd rnd_mode;
#elif HAVE_FP_RND_T
fp_rnd_t rnd_mode;
#else
choke me
#endif
switch (mode)
{
#ifdef FP_RN
case GFC_FPE_TONEAREST:
rnd_mode = FP_RN;
break;
#endif
#ifdef FP_RP
case GFC_FPE_UPWARD:
rnd_mode = FP_RP;
break;
#endif
#ifdef FP_RM
case GFC_FPE_DOWNWARD:
rnd_mode = FP_RM;
break;
#endif
#ifdef FP_RZ
case GFC_FPE_TOWARDZERO:
rnd_mode = FP_RZ;
break;
#endif
default:
return;
}
fpsetround (rnd_mode);
}
libgfortran/configure
......@@ -654,7 +654,6 @@ CPP
am__fastdepCC_FALSE
am__fastdepCC_TRUE
CCDEPMODE
am__nodep
AMDEPBACKSLASH
AMDEP_FALSE
AMDEP_TRUE
......@@ -3387,11 +3386,11 @@ MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
# We need awk for the "check" target. The system "awk" is bad on
# some platforms.
# Always define AMTAR for backward compatibility. Yes, it's still used
# in the wild :-( We should find a proper way to deprecate it ...
AMTAR='$${TAR-tar}'
# Always define AMTAR for backward compatibility.
am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'
AMTAR=${AMTAR-"${am_missing_run}tar"}
am__tar='${AMTAR} chof - "$$tardir"'; am__untar='${AMTAR} xf -'
......@@ -3524,7 +3523,6 @@ fi
if test "x$enable_dependency_tracking" != xno; then
am_depcomp="$ac_aux_dir/depcomp"
AMDEPBACKSLASH='\'
am__nodep='_no'
fi
if test "x$enable_dependency_tracking" != xno; then
AMDEP_TRUE=
......@@ -4342,7 +4340,6 @@ else
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named `D' -- because `-MD' means `put the output
# in D'.
rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
......@@ -4402,7 +4399,7 @@ else
break
fi
;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys)
msvisualcpp | msvcmsys)
# This compiler won't grok `-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
......@@ -5518,7 +5515,6 @@ else
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named `D' -- because `-MD' means `put the output
# in D'.
rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
......@@ -5578,7 +5574,7 @@ else
break
fi
;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys)
msvisualcpp | msvcmsys)
# This compiler won't grok `-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
......@@ -12335,7 +12331,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line 12338 "configure"
#line 12334 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
......@@ -12441,7 +12437,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line 12444 "configure"
#line 12440 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
......@@ -26032,6 +26028,27 @@ _ACEOF
fi
ac_fn_c_check_type "$LINENO" "fp_rnd" "ac_cv_type_fp_rnd" "#include <ieeefp.h>
"
if test "x$ac_cv_type_fp_rnd" = x""yes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_FP_RND 1
_ACEOF
fi
ac_fn_c_check_type "$LINENO" "fp_rnd_t" "ac_cv_type_fp_rnd_t" "#include <ieeefp.h>
"
if test "x$ac_cv_type_fp_rnd_t" = x""yes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_FP_RND_T 1
_ACEOF
fi
# Check for AIX fp_trap and fp_enable
ac_fn_c_check_func "$LINENO" "fp_trap" "ac_cv_func_fp_trap"
......
libgfortran/configure.ac
......@@ -513,6 +513,7 @@ fi
# Check for SysV fpsetmask
LIBGFOR_CHECK_FPSETMASK
AC_CHECK_TYPES([fp_except,fp_except_t], [], [], [[#include <ieeefp.h>]])
AC_CHECK_TYPES([fp_rnd,fp_rnd_t], [], [], [[#include <ieeefp.h>]])
# Check for AIX fp_trap and fp_enable
AC_CHECK_FUNC([fp_trap],[have_fp_trap=yes AC_DEFINE([HAVE_FP_TRAP],[1],[fp_trap is present])])
......
libgfortran/io/io.h
......@@ -186,8 +186,14 @@ typedef enum
unit_encoding;
typedef enum
{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
{ ROUND_UP = GFC_FPE_UPWARD,
ROUND_DOWN = GFC_FPE_DOWNWARD,
ROUND_ZERO = GFC_FPE_TOWARDZERO,
ROUND_NEAREST = GFC_FPE_TONEAREST,
ROUND_COMPATIBLE = 10, /* round away from zero. */
ROUND_PROCDEFINED, /* Here as ROUND_NEAREST. */
ROUND_UNSPECIFIED /* Should never occur. */
}
unit_round;
/* NOTE: unit_sign must correspond with the sign_status enumerator in
......
libgfortran/io/read.c
......@@ -129,6 +129,24 @@ int
convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
{
char *endptr = NULL;
int round_mode, old_round_mode;
switch (dtp->u.p.current_unit->round_status)
{
case ROUND_COMPATIBLE:
/* FIXME: As NEAREST but round away from zero for a tie. */
case ROUND_UNSPECIFIED:
/* Should not occur. */
case ROUND_PROCDEFINED:
round_mode = ROUND_NEAREST;
break;
default:
round_mode = dtp->u.p.current_unit->round_status;
break;
}
old_round_mode = get_fpu_rounding_mode();
set_fpu_rounding_mode (round_mode);
switch (length)
{
......@@ -167,6 +185,8 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
internal_error (&dtp->common, "Unsupported real kind during IO");
}
set_fpu_rounding_mode (old_round_mode);
if (buffer == endptr)
{
generate_error (&dtp->common, LIBERROR_READ_VALUE,
......
libgfortran/libgfortran.h
......@@ -743,9 +743,16 @@ internal_proto(gf_strerror);
extern void set_fpu (void);
internal_proto(set_fpu);
extern int get_fpu_except_flags (void);
internal_proto(get_fpu_except_flags);
extern void set_fpu_rounding_mode (int round);
internal_proto(set_fpu_rounding_mode);
extern int get_fpu_rounding_mode (void);
internal_proto(get_fpu_rounding_mode);
/* memory.c */
extern void *xmalloc (size_t) __attribute__ ((malloc));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment