diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improve support for floating point exceptions.

This commit is contained in:
Vítor Santos Costa 2014-10-14 01:13:31 +01:00
parent 3c7779ec78
commit c95045e14c
8 changed files with 72 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/exec.c
View File

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

85
C/sysbits.c
View File

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

2
H/Yapproto.h
View File

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

9
config.h.in
View File

@ -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 <fenv.h> 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

2
configure vendored
View File

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

2
configure.in
View File

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

1
pl/boot.yap
View File

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

6
pl/flags.yap
View File

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