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

fix arithmetic exceptions

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-10-18 12:28:02 +01:00
parent 98127b7102
commit 468913e38c
6 changed files with 13 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/exec.c
View File

@ -1133,7 +1133,7 @@ exec_absmi(bool top, yap_reset_t reset_mode USES_REGS)
/* must be done here, otherwise siglongjmp will clobber all the registers */ /* must be done here, otherwise siglongjmp will clobber all the registers */
Yap_Error(LOCAL_matherror ,TermNil,NULL); Yap_Error(LOCAL_matherror ,TermNil,NULL);
/* reset the registers so that we don't have trash in abstract machine */ /* reset the registers so that we don't have trash in abstract machine */
Yap_set_fpu_exceptions(true); Yap_set_fpu_exceptions(getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
} }

4
H/YapFlags.h
View File

@ -207,6 +207,10 @@ static inline void setAtomicGlobalPrologFlag(int id, Term v) {
GLOBAL_Flags[id].at = v; GLOBAL_Flags[id].at = v;
} }
static inline Term getAtomicGlobalPrologFlag(int id) {
return GLOBAL_Flags[id].at;
}
static inline void setAtomicLocalPrologFlag(int id, Term v) { static inline void setAtomicLocalPrologFlag(int id, Term v) {
CACHE_REGS CACHE_REGS
check_refs_to_ltable(); check_refs_to_ltable();

2
H/YapGFlagInfo.h
View File

@ -44,7 +44,7 @@ YAP_FLAG( ALLOW_ASSERT_FOR_STATIC_PREDICATES, "allow_assert_for_static_predica
/* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, "allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**< `allow_variable_name_as_functor` */ /* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, "allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**< `allow_variable_name_as_functor` */
/* allow A(X) *\/ */ /* allow A(X) *\/ */
YAP_FLAG( ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p" , NULL ), /** `arithmetic_exceptions ` YAP_FLAG( ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p" , Yap_set_fpu_exceptions ), /** `arithmetic_exceptions `
Read-write flag telling whether arithmetic exceptions generate Read-write flag telling whether arithmetic exceptions generate
Prolog exceptions. If enabled: Prolog exceptions. If enabled:

2
H/Yapproto.h
View File

@ -379,7 +379,7 @@ int Yap_IsOpMaxPrio(Atom);
/* sysbits.c */ /* sysbits.c */
void Yap_InitPageSize(void); void Yap_InitPageSize(void);
bool Yap_set_fpu_exceptions(bool); bool Yap_set_fpu_exceptions(Term);
UInt Yap_cputime(void); UInt Yap_cputime(void);
Int Yap_walltime(void); Int Yap_walltime(void);
int Yap_dir_separator(int); int Yap_dir_separator(int);

18
os/sysbits.c
View File

@ -136,7 +136,7 @@ static void InitRandom(void);
static Int p_alarm( USES_REGS1 ); static Int p_alarm( USES_REGS1 );
static Int p_getenv( USES_REGS1 ); static Int p_getenv( USES_REGS1 );
static Int p_putenv( USES_REGS1 ); static Int p_putenv( USES_REGS1 );
static bool set_fpu_exceptions(bool); static bool set_fpu_exceptions(Term);
static char *expandVars(const char *pattern, char *expanded, int maxlen); static char *expandVars(const char *pattern, char *expanded, int maxlen);
#ifdef MACYAP #ifdef MACYAP
static int chdir(char *); static int chdir(char *);
@ -2134,7 +2134,6 @@ Yap_MathException__( USES_REGS1 )
return EVALUATION_ERROR_UNDEFINED; return EVALUATION_ERROR_UNDEFINED;
} }
if (raised ) { if (raised ) {
feclearexcept(FE_ALL_EXCEPT); feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) { if (raised & FE_OVERFLOW) {
return EVALUATION_ERROR_FLOAT_OVERFLOW; return EVALUATION_ERROR_FLOAT_OVERFLOW;
@ -3238,9 +3237,9 @@ MSCHandleSignal(DWORD dwCtrlType) {
/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */ /* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */
static bool static bool
set_fpu_exceptions(bool flag) set_fpu_exceptions(Term flag)
{ {
if (flag) { if (flag == TermTrue) {
#if HAVE_FESETEXCEPTFLAG #if HAVE_FESETEXCEPTFLAG
fexcept_t excepts; fexcept_t excepts;
return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0; return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0;
@ -3309,19 +3308,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
} }
bool bool
Yap_set_fpu_exceptions(bool flag) Yap_set_fpu_exceptions(Term flag)
{ {
return set_fpu_exceptions(flag); return set_fpu_exceptions(flag);
} }
static Int
p_set_fpu_exceptions( USES_REGS1 ) {
if (Deref(ARG1) == MkAtomTerm(AtomTrue)) {
return set_fpu_exceptions(true);
} else {
return set_fpu_exceptions( false );
}
}
static Int static Int
p_host_type( USES_REGS1 ) { p_host_type( USES_REGS1 ) {
@ -3732,7 +3723,6 @@ MSCHandleSignal(DWORD dwCtrlType) {
Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag); Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$putenv", 2, p_putenv, 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 ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag); Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);

6
pl/errors.yap
View File

@ -259,9 +259,7 @@ to allow user-control.
'$process_error'(error(permission_error(module,redefined,A),B), Level) :- '$process_error'(error(permission_error(module,redefined,A),B), Level) :-
Level \= top, !, Level \= top, !,
throw(error(permission_error(module,redefined,A),B)). throw(error(permission_error(module,redefined,A),B)).
'$process_error'(error(Msg, Where), _) :- !, '$process_error'(error(Msg, Where), _) :-
'$set_fpu_exceptions'(true), print_message(error,error(Msg, Where)), !.
print_message(error,error(Msg, Where)).
'$process_error'(Throw, _) :- '$process_error'(Throw, _) :-
print_message(error,error(unhandled_exception,Throw)). print_message(error,error(unhandled_exception,Throw)).