From c95045e14cac3bc1a458397d9a1f2d9e16d6e013 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 14 Oct 2014 01:13:31 +0100 Subject: [PATCH] improve support for floating point exceptions. --- C/exec.c | 2 +- C/sysbits.c | 85 +++++++++++++++++++++++++++++++++------------------- H/Yapproto.h | 2 +- config.h.in | 9 ++++++ configure | 2 +- configure.in | 2 +- pl/boot.yap | 1 + pl/flags.yap | 6 ++-- 8 files changed, 72 insertions(+), 37 deletions(-) diff --git a/C/exec.c b/C/exec.c index 6ed04403d..1e0214d90 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1078,7 +1078,7 @@ exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) /* must be done here, otherwise siglongjmp will clobber all the registers */ Yap_Error(LOCAL_matherror ,TermNil,NULL); /* reset the registers so that we don't have trash in abstract machine */ - Yap_set_fpu_exceptions(yap_flags[LANGUAGE_MODE_FLAG] == 1); + Yap_set_fpu_exceptions(true); P = (yamop *)FAILCODE; LOCAL_PrologMode = UserMode; } diff --git a/C/sysbits.c b/C/sysbits.c index b48e6fc33..3f38689b2 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -107,7 +107,7 @@ static Int p_srandom( USES_REGS1 ); static Int p_alarm( USES_REGS1 ); static Int p_getenv( USES_REGS1 ); static Int p_putenv( USES_REGS1 ); -static void set_fpu_exceptions(int); +static bool set_fpu_exceptions(bool); #ifdef MACYAP static int chdir(char *); /* #define signal skel_signal */ @@ -1424,8 +1424,23 @@ HandleMatherr(int sig, void *sipv, void *uapv) yap_error_number error_no; /* reset the registers so that we don't have trash in abstract machine */ +#if HAVE_FETESTEXCEPT + int raised = fetestexcept(FE_ALL_EXCEPT); -#if (defined(__svr4__) || defined(__SVR4)) + if (raised & FE_OVERFLOW) { + LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW; + } else if (raised & (FE_INVALID|FE_INEXACT)) { + LOCAL_matherror = EVALUATION_ERROR_UNDEFINED; + } else if (raised & FE_DIVBYZERO) { + LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR; + } else if (raised & FE_UNDERFLOW) { + LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW; + } else + LOCAL_matherror = EVALUATION_ERROR_UNDEFINED; + if (!feclearexcept()) + return; + Yap_Error(LOCAL_matherror , TermNil, "Arithmetic Exception"); +#elif (defined(__svr4__) || defined(__SVR4)) switch(sip->si_code) { case FPE_INTDIV: error_no = EVALUATION_ERROR_ZERO_DIVISOR; @@ -2164,10 +2179,7 @@ p_system ( USES_REGS1 ) /* Rename a file */ /** @pred rename(+ _F_,+ _G_) - Renames file _F_ to _G_. - - */ static Int p_mv ( USES_REGS1 ) @@ -2526,14 +2538,20 @@ p_virtual_alarm( USES_REGS1 ) #endif /* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */ -static void -set_fpu_exceptions(int flag) +static bool +set_fpu_exceptions(bool flag) { if (flag) { -#if defined(__hpux) +#if HAVE_FESETEXCEPTFLAG + fexcept_t excepts; + return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0; +#elif HAVE_FEENABLEEXCEPT + /* I shall ignore de-normalization and precision errors */ + feenableexcept(FE_DIVBYZERO| FE_INVALID|FE_OVERFLOW); +#elif defined(__hpux) # if HAVE_FESETTRAPENABLE /* From HP-UX 11.0 onwards: */ - fesettrapenable(FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW); + fesettrapenable(FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW); # else /* Up until HP-UX 10.20: @@ -2544,53 +2562,60 @@ set_fpu_exceptions(int flag) FP_X_IMP imprecise (inexact result) FP_X_CLEAR simply zero to clear all flags */ - fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL); + fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL); # endif #endif /* __hpux */ #if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__) - /* I shall ignore denormalization and precision errors */ - int v = _FPU_IEEE & ~(_FPU_MASK_IM|_FPU_MASK_ZM|_FPU_MASK_OM|_FPU_MASK_UM); - _FPU_SETCW(v); + /* I shall ignore denormalization and precision errors */ + int v = _FPU_IEEE & ~(_FPU_MASK_IM|_FPU_MASK_ZM|_FPU_MASK_OM|_FPU_MASK_UM); + _FPU_SETCW(v); #endif #if HAVE_FETESTEXCEPT - feclearexcept(FE_ALL_EXCEPT); + feclearexcept(FE_ALL_EXCEPT); #endif #ifdef HAVE_SIGFPE - my_signal (SIGFPE, HandleMatherr); + my_signal (SIGFPE, HandleMatherr); #endif } else { /* do IEEE arithmetic in the way the big boys do */ -#if defined(__hpux) +#if HAVE_FESETEXCEPTFLAG + fexcept_t excepts; + return fesetexceptflag(&excepts, 0) == 0; +#elif HAVE_FEENABLEEXCEPT + /* I shall ignore de-normalization and precision errors */ + feenableexcept(0); +#elif defined(__hpux) # if HAVE_FESETTRAPENABLE - fesettrapenable(FE_ALL_EXCEPT); + fesettrapenable(FE_ALL_EXCEPT); # else - fpsetmask(FP_X_CLEAR); + fpsetmask(FP_X_CLEAR); # endif #endif /* __hpux */ #if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__) - /* this will probably not work in older releases of Linux */ - int v = _FPU_IEEE; - _FPU_SETCW(v); + /* this will probably not work in older releases of Linux */ + int v = _FPU_IEEE; + _FPU_SETCW(v); #endif #ifdef HAVE_SIGFPE - my_signal (SIGFPE, SIG_IGN); + my_signal (SIGFPE, SIG_IGN); #endif } + return true; } -void -Yap_set_fpu_exceptions(int flag) +bool +Yap_set_fpu_exceptions(bool flag) { - set_fpu_exceptions(flag); + return set_fpu_exceptions(flag); } + static Int p_set_fpu_exceptions( USES_REGS1 ) { - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { - set_fpu_exceptions(FALSE); /* can't make it work right */ + if (Deref(ARG1) == MkAtomTerm(AtomTrue)) { + return set_fpu_exceptions(true); } else { - set_fpu_exceptions(FALSE); + return set_fpu_exceptions( false ); } - return(TRUE); } static Int @@ -2989,7 +3014,7 @@ Yap_InitSysPreds(void) Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag); Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$set_fpu_exceptions", 1, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag); Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); diff --git a/H/Yapproto.h b/H/Yapproto.h index 83acf11bb..8ec1f9264 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -364,7 +364,7 @@ int Yap_IsOpMaxPrio(Atom); /* sysbits.c */ void Yap_InitPageSize(void); -void Yap_set_fpu_exceptions(int); +bool Yap_set_fpu_exceptions(bool); UInt Yap_cputime(void); Int Yap_walltime(void); int Yap_dir_separator(int); diff --git a/config.h.in b/config.h.in index 2970b2ce7..f28c82975 100644 --- a/config.h.in +++ b/config.h.in @@ -226,9 +226,18 @@ /* Define to 1 if you have the `feclearexcept' function. */ #undef HAVE_FECLEAREXCEPT +/* Define to 1 if you have the `feenableexcept' function. */ +#undef HAVE_FEENABLEEXCEPT + /* Define to 1 if you have the header file. */ #undef HAVE_FENV_H +/* Define to 1 if you have the `fesetexceptflag' function. */ +#undef HAVE_FESETEXCEPTFLAG + +/* Define to 1 if you have the `fesetround' function. */ +#undef HAVE_FESETROUND + /* Define to 1 if you have the `fesettrapenable' function. */ #undef HAVE_FESETTRAPENABLE diff --git a/configure b/configure index 95861b84c..0458fd12d 100755 --- a/configure +++ b/configure @@ -9546,7 +9546,7 @@ _ACEOF fi done -for ac_func in fesettrapenable ffsl ffsll fgetpos finite +for ac_func in feenableexcept fesetexceptflag fesettrapenable fesetround ffsl ffsll fgetpos finite do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" diff --git a/configure.in b/configure.in index 881d3bd52..cfd404258 100755 --- a/configure.in +++ b/configure.in @@ -1639,7 +1639,7 @@ AC_CHECK_FUNCS(_NSGetEnviron _chsize_s access acosh) AC_CHECK_FUNCS(alloca asinh atanh chdir clock clock_gettime) AC_CHECK_FUNCS(ctime dlopen dup2) AC_CHECK_FUNCS(erf feclearexcept) -AC_CHECK_FUNCS(fesettrapenable ffsl ffsll fgetpos finite) +AC_CHECK_FUNCS(feenableexcept fesetexceptflag fesettrapenable fesetround ffsl ffsll fgetpos finite) AC_CHECK_FUNCS(flsl flsll fpclass ftime ftruncate getcwd getenv) AC_CHECK_FUNCS(getexecname) AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname) diff --git a/pl/boot.yap b/pl/boot.yap index e5c43d958..4f3365c65 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -329,6 +329,7 @@ true :- true. '$init_system' :- get_value('$yap_inited', true), !. '$init_system' :- + '$set_fpu_exceptions'(true), set_value('$yap_inited', true), % do catch as early as possible ( diff --git a/pl/flags.yap b/pl/flags.yap index 0412ebfdd..0507d3aaa 100644 --- a/pl/flags.yap +++ b/pl/flags.yap @@ -1147,7 +1147,7 @@ yap_flag(max_threads,X) :- '$syntax_check_multiple'(_,off), '$swi_set_prolog_flag'(character_escapes, false), % disable character escapes. '$set_yap_flags'(14,1), - '$set_fpu_exceptions', +% '$set_fpu_exceptions'(false), unknown(_,fail). '$adjust_language'(sicstus) :- '$switch_log_upd'(1), @@ -1162,7 +1162,7 @@ yap_flag(max_threads,X) :- '$set_yap_flags'(14,0), % CHARACTER_ESCAPE '$swi_set_prolog_flag'(character_escapes, true), % disable character escapes. - '$set_fpu_exceptions', + '$set_fpu_exceptions'(true), '$swi_set_prolog_flag'(fileerrors, true), unknown(_,error). '$adjust_language'(iso) :- @@ -1177,7 +1177,7 @@ yap_flag(max_threads,X) :- '$set_yap_flags'(14,0), % CHARACTER_ESCAPE '$swi_set_prolog_flag'(character_escapes, true), % disable character escapes. - '$set_fpu_exceptions', + '$set_fpu_exceptions'(true), unknown(_,error).