fix arithmetic exceptions
This commit is contained in:
parent
98127b7102
commit
468913e38c
2
C/exec.c
2
C/exec.c
@ -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 */
|
||||
Yap_Error(LOCAL_matherror ,TermNil,NULL);
|
||||
/* 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;
|
||||
LOCAL_PrologMode = UserMode;
|
||||
}
|
||||
|
@ -207,6 +207,10 @@ static inline void setAtomicGlobalPrologFlag(int id, Term 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) {
|
||||
CACHE_REGS
|
||||
check_refs_to_ltable();
|
||||
|
@ -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` */
|
||||
|
||||
/* 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
|
||||
Prolog exceptions. If enabled:
|
||||
|
@ -379,7 +379,7 @@ int Yap_IsOpMaxPrio(Atom);
|
||||
|
||||
/* sysbits.c */
|
||||
void Yap_InitPageSize(void);
|
||||
bool Yap_set_fpu_exceptions(bool);
|
||||
bool Yap_set_fpu_exceptions(Term);
|
||||
UInt Yap_cputime(void);
|
||||
Int Yap_walltime(void);
|
||||
int Yap_dir_separator(int);
|
||||
|
18
os/sysbits.c
18
os/sysbits.c
@ -136,7 +136,7 @@ static void InitRandom(void);
|
||||
static Int p_alarm( USES_REGS1 );
|
||||
static Int p_getenv( 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);
|
||||
#ifdef MACYAP
|
||||
static int chdir(char *);
|
||||
@ -2134,7 +2134,6 @@ Yap_MathException__( USES_REGS1 )
|
||||
return EVALUATION_ERROR_UNDEFINED;
|
||||
}
|
||||
if (raised ) {
|
||||
|
||||
feclearexcept(FE_ALL_EXCEPT);
|
||||
if (raised & FE_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. */
|
||||
static bool
|
||||
set_fpu_exceptions(bool flag)
|
||||
set_fpu_exceptions(Term flag)
|
||||
{
|
||||
if (flag) {
|
||||
if (flag == TermTrue) {
|
||||
#if HAVE_FESETEXCEPTFLAG
|
||||
fexcept_t excepts;
|
||||
return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0;
|
||||
@ -3309,19 +3308,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
|
||||
}
|
||||
|
||||
bool
|
||||
Yap_set_fpu_exceptions(bool flag)
|
||||
Yap_set_fpu_exceptions(Term 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
|
||||
p_host_type( USES_REGS1 ) {
|
||||
@ -3732,7 +3723,6 @@ MSCHandleSignal(DWORD dwCtrlType) {
|
||||
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",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);
|
||||
|
@ -259,9 +259,7 @@ to allow user-control.
|
||||
'$process_error'(error(permission_error(module,redefined,A),B), Level) :-
|
||||
Level \= top, !,
|
||||
throw(error(permission_error(module,redefined,A),B)).
|
||||
'$process_error'(error(Msg, Where), _) :- !,
|
||||
'$set_fpu_exceptions'(true),
|
||||
print_message(error,error(Msg, Where)).
|
||||
'$process_error'(error(Msg, Where), _) :-
|
||||
print_message(error,error(Msg, Where)), !.
|
||||
'$process_error'(Throw, _) :-
|
||||
print_message(error,error(unhandled_exception,Throw)).
|
||||
|
||||
|
Reference in New Issue
Block a user