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

generate exceptions on arithmetic errors

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-10-15 11:06:07 +01:00
parent a5d0b41f3b
commit 8576e67d84
16 changed files with 215 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
C/arith1.c
View File

@ -957,18 +957,29 @@ p_unary_is( USES_REGS1 )
Term t = Deref(ARG2);
Term top;
LOCAL_mathn = 1;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG2, "X is Y");
return FALSE;
}
Yap_ClearExs();
top = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(top, ARG3)) {
return FALSE;
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = top;
return TRUE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top PASS_REGS), Deref(ARG3));
if (!tout)
return FALSE;
Term tout;
Int i;
LOCAL_mathop = i = IntegerOfTerm(t);
tout = eval1(i, top PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = top;
LOCAL_mathop = i;
LOCAL_mathn = 1;
return TRUE;
}
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
@ -989,8 +1000,14 @@ p_unary_is( USES_REGS1 )
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval1(p->FOfEE, top PASS_REGS),Deref(ARG3))))
LOCAL_mathop = p->FOfEE;
out= eval1(p->FOfEE, top PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = top;
LOCAL_mathop = p->FOfEE;
LOCAL_mathn = 1;
return FALSE;
}
return Yap_unify_constant(ARG1,out);
}
return(FALSE);
@ -1020,6 +1037,12 @@ p_unary_op_as_integer( USES_REGS1 )
return(FALSE);
}
Atom
Yap_NameOfUnaryOp(int i)
{
return Yap_LookupAtom(InitUnTab[i].OpName);
}
void
Yap_InitUnaryExps(void)
{

48
C/arith2.c
View File

@ -1151,18 +1151,27 @@ p_binary_is( USES_REGS1 )
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
}
Yap_ClearExs();
t1 = Yap_Eval(Deref(ARG3));
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
return FALSE;
}
LOCAL_mathtt[0] = t1;
t2 = Yap_Eval(Deref(ARG4));
if (!Yap_FoundArithError(t2, ARG4)) {
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t2;
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2 PASS_REGS), 0L);
if (!tout)
return FALSE;
Term tout = eval2(IntOfTerm(t), t1, t2 PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
LOCAL_mathtt[1] = t2;
LOCAL_mathn = 2;
LOCAL_mathop = IntOfTerm(t);
return FALSE;
}
return Yap_unify_constant(ARG1,tout);
}
if (IsAtomTerm(t)) {
@ -1183,13 +1192,21 @@ p_binary_is( USES_REGS1 )
P = FAILCODE;
return(FALSE);
}
if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2 PASS_REGS), 0L)))
out= eval2(p->FOfEE, t1, t2 PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
LOCAL_mathtt[1] = t2;
LOCAL_mathn = 2;
LOCAL_mathop = IntOfTerm(t);
return FALSE;
}
return Yap_unify_constant(ARG1,out);
}
return FALSE;
}
static Int
do_arith23(arith2_op op USES_REGS)
{ /* X is Y */
@ -1197,6 +1214,7 @@ do_arith23(arith2_op op USES_REGS)
Int out;
Term t1, t2;
Yap_ClearExs();
if (IsVarTerm(t)) {
Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y");
return(FALSE);
@ -1207,8 +1225,14 @@ do_arith23(arith2_op op USES_REGS)
t2 = Yap_Eval(Deref(ARG2));
if (t2 == 0L)
return FALSE;
if (!(out=Yap_FoundArithError(eval2(op, t1, t2 PASS_REGS), 0L)))
return FALSE;
out= eval2(op, t1, t2 PASS_REGS);
if (Yap_FoundArithError()) {
LOCAL_mathtt[0] = t1;
LOCAL_mathtt[1] = t2;
LOCAL_mathn = 2;
LOCAL_mathop = op;
return FALSE;
}
return Yap_unify_constant(ARG3,out);
}
@ -1284,6 +1308,12 @@ p_binary_op_as_integer( USES_REGS1 )
return(FALSE);
}
Atom
Yap_NameOfBinaryOp(int i)
{
return Yap_LookupAtom(InitBinTab[i].OpName);
}
void
Yap_InitBinaryExps(void)

60
C/eval.c
View File

@ -171,45 +171,11 @@ Eval(Term t USES_REGS)
}
}
#if HAVE_FENV_H
Term
Yap_InnerEval__(Term t USES_REGS)
{
#pragma STDC FENV_ACCESS ON
int raised;
Term ret;
feclearexcept(FE_ALL_EXCEPT);
ret = Eval(t PASS_REGS);
if ( ret && (raised = fetestexcept( FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW)) ) {
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
LOCAL_Error_TYPE = EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & (FE_INVALID|FE_INEXACT)) {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
} else if (raised & FE_DIVBYZERO) {
LOCAL_Error_TYPE = EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
LOCAL_Error_TYPE = EVALUATION_ERROR_FLOAT_UNDERFLOW;
} else {
LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED;
}
LOCAL_Error_Term = t;
LOCAL_ErrorMessage="Arithmetic Exception";
return 0L;
}
return ret;
}
#else
Term
Yap_InnerEval__(Term t USES_REGS)
{
CACHE_REGS
return Eval(t PASS_REGS);
}
#endif
#ifdef BEAM
Int BEAM_is(void);
@ -248,18 +214,26 @@ static Int
p_is( USES_REGS1 )
{ /* X is Y */
Term out = 0L;
Yap_ClearExs();
while (!(out = Yap_InnerEval(Deref(ARG2)))) {
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_Error(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
if (LOCAL_Error_TYPE == RESOURCE_ERROR_STACK) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, CP)) {
Yap_Error(RESOURCE_ERROR_STACK, ARG2, LOCAL_ErrorMessage);
return FALSE;
}
} else {
LOCAL_mathtt[0] = Deref(ARG2);
LOCAL_mathop = 0;
LOCAL_mathn = 0;
return FALSE;
}
} else {
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
Yap_Error(LOCAL_Error_TYPE, LOCAL_mathtt[0], LOCAL_ErrorMessage);
return FALSE;
}
}
if (Yap_FoundArithError()) {
return TRUE;
}
return Yap_unify_constant(ARG1,out);
}

5
C/signals.c
View File

@ -405,6 +405,11 @@ p_first_signal( USES_REGS1 )
case YAP_USR2_SIGNAL:
at = AtomSigUsr2;
break;
#endif
#ifdef SIGFPE
case YAP_FPE_SIGNAL:
at = AtomSigFPE;
break;
#endif
default:
return FALSE;

127
C/sysbits.c
View File

@ -1416,88 +1416,104 @@ HandleSIGSEGV(int sig, void *sipv, void *uap)
}
#endif /* SIGSEGV */
#if HAVE_SIGFPE
static void
HandleMatherr(int sig, void *sipv, void *uapv)
yap_error_number
Yap_MathException__( USES_REGS1 )
{
CACHE_REGS
int raised;
/* reset the registers so that we don't have trash in abstract machine */
#if HAVE_FETESTEXCEPT
int raised = fetestexcept(FE_ALL_EXCEPT);
#pragma STDC FENV_ACCESS ON
if ((raised = fetestexcept( FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW)) ) {
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(FE_ALL_EXCEPT))
return;
Yap_Error(LOCAL_matherror , TermNil, "Arithmetic Exception");
feclearexcept(FE_ALL_EXCEPT);
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;
}
}
#elif (defined(__svr4__) || defined(__SVR4))
switch(sip->si_code) {
case FPE_INTDIV:
error_no = EVALUATION_ERROR_ZERO_DIVISOR;
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
break;
case FPE_INTOVF:
error_no = EVALUATION_ERROR_INT_OVERFLOW;
LOCAL_matherror = EVALUATION_ERROR_INT_OVERFLOW;
break;
case FPE_FLTDIV:
error_no = EVALUATION_ERROR_ZERO_DIVISOR;
LOCAL_matherror = EVALUATION_ERROR_ZERO_DIVISOR;
break;
case FPE_FLTOVF:
error_no = EVALUATION_ERROR_FLOAT_OVERFLOW;
LOCAL_matherror = EVALUATION_ERROR_FLOAT_OVERFLOW;
break;
case FPE_FLTUND:
error_no = EVALUATION_ERROR_FLOAT_UNDERFLOW;
LOCAL_matherror = EVALUATION_ERROR_FLOAT_UNDERFLOW;
break;
case FPE_FLTRES:
case FPE_FLTINV:
case FPE_FLTSUB:
default:
error_no = EVALUATION_ERROR_UNDEFINED;
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
}
set_fpu_exceptions(0);
Yap_Error(error_no, TermNil, "");
#elif __linux__
#if HAVE_FETESTEXCEPT
/* This should work in Linux, but it doesn't seem to. */
int raised = fetestexcept(FE_ALL_EXCEPT);
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
#endif
LOCAL_matherror = EVALUATION_ERROR_UNDEFINED;
/* something very bad happened on the way to the forum */
set_fpu_exceptions(FALSE);
Yap_Error(LOCAL_matherror , TermNil, "");
#endif
return LOCAL_matherror;
}
static Int
p_fpe_error( USES_REGS1 )
{
if (LOCAL_mathn == 0) {
Yap_Error(LOCAL_matherror, LOCAL_mathtt[0], "arithmetic");
} else if (LOCAL_mathn == 1) {
Term t;
Functor f;
f = Yap_MkFunctor( Yap_NameOfUnaryOp(LOCAL_mathop), 1);
t = Yap_MkApplTerm(f, 1, LOCAL_mathtt);
Yap_Error(LOCAL_matherror, t, "arithmetic");
} else if (LOCAL_mathn == 2) {
Term t;
Functor f;
f = Yap_MkFunctor( Yap_NameOfBinaryOp(LOCAL_mathop), 2);
t = Yap_MkApplTerm(f, 2, LOCAL_mathtt);
Yap_Error(LOCAL_matherror, t, "arithmetic");
}
LOCAL_matherror = YAP_NO_ERROR;
return FALSE;
}
#if HAVE_SIGFPE
static void
HandleMatherr(int sig, void *sipv, void *uapv)
{
CACHE_REGS
LOCAL_matherror = Yap_MathException( );
/* reset the registers so that we don't have trash in abstract machine */
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
}
#endif /* SIGFPE */
typedef void (*signal_handler_t)(int, void *, void *);
#if HAVE_SIGACTION
static void
my_signal_info(int sig, void (*handler)(int, void *, void *))
my_signal_info(int sig, void * handler)
{
struct sigaction sigact;
sigact.sa_handler = (void *)handler;
sigact.sa_handler = handler;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = SA_SIGINFO;
@ -1505,7 +1521,7 @@ my_signal_info(int sig, void (*handler)(int, void *, void *))
}
static void
my_signal(int sig, void (*handler)(int, void *, void *))
my_signal(int sig, void * handler)
{
struct sigaction sigact;
@ -1518,13 +1534,13 @@ my_signal(int sig, void (*handler)(int, void *, void *))
#else
static void
my_signal(int sig, void (*handler)(int, void *, void *))
my_signal(int sig, void *handler)
{
signal(sig, (void *)handler);
signal(sig, void *handler);
}
static void
my_signal_info(int sig, void (*handler)(int, void *, void *))
my_signal_info(int sig, void *handler)
{
if(signal(sig, (void *)handler) == SIG_ERR)
exit(1);
@ -1554,9 +1570,7 @@ ReceiveSignal (int s, void *x, void *y)
#ifndef MPW
#ifdef HAVE_SIGFPE
case SIGFPE:
set_fpu_exceptions(FALSE);
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error (SYSTEM_ERROR, TermNil, "floating point exception ]");
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
break;
#endif
#endif
@ -3018,6 +3032,7 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
Yap_InitCPred ("$address_bits", 1, p_address_bits, SafePredFlag);
Yap_InitCPred ("$expand_file_name", 2, p_expand_file_name, SyncPredFlag);
Yap_InitCPred ("$fpe_error", 0, p_fpe_error, 0);
#ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif

3
H/YapSignals.h
View File

@ -44,6 +44,9 @@ typedef enum
#endif
#ifdef SIGVTALRM
YAP_VTALARM_SIGNAL = SIGVTALRM, /* received SIGVTALARM */
#endif
#ifdef SIGFPE
YAP_FPE_SIGNAL = SIGFPE, /* received SIGFPE */
#endif
YAP_WAKEUP_SIGNAL = (NSIG+1), /* goals to wake up */
YAP_ITI_SIGNAL = (NSIG+2), /* received inter thread signal */

6
H/dlocals.h
View File

@ -306,6 +306,12 @@
#define LOCAL_matherror LOCAL->matherror_
#define REMOTE_matherror(wid) REMOTE(wid)->matherror_
#define LOCAL_mathtt LOCAL->mathtt_
#define REMOTE_mathtt(wid) REMOTE(wid)->mathtt_
#define LOCAL_mathn LOCAL->mathn_
#define REMOTE_mathn(wid) REMOTE(wid)->mathn_
#define LOCAL_mathop LOCAL->mathop_
#define REMOTE_mathop(wid) REMOTE(wid)->mathop_
#define LOCAL_CurrentError LOCAL->CurrentError_
#define REMOTE_CurrentError(wid) REMOTE(wid)->CurrentError_

38
H/eval.h
View File

@ -117,6 +117,9 @@ exceptions:
#ifdef HAVE_LIMITS_H
#include <limits.h>
#endif
#ifdef HAVE_FENV_H
#include <fenv.h>
#endif
#ifdef LONG_MAX
#define Int_MAX LONG_MAX
@ -313,6 +316,8 @@ typedef enum {
op_rdiv
} arith2_op;
yap_error_number
Yap_MathException__(USES_REGS1);
Functor EvalArg(Term);
/* Needed to handle numbers:
@ -363,8 +368,11 @@ Int Yap_ArithError(yap_error_number,Term,char *msg, ...);
#include "inline-only.h"
#define Yap_MathException() Yap_MathException__(PASS_REGS1)
#define Yap_InnerEval(x) Yap_InnerEval__(x PASS_REGS)
#define Yap_Eval(x) Yap_Eval__(x PASS_REGS)
#define Yap_FoundArithError() Yap_FoundArithError__(PASS_REGS1)
INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS);
@ -376,19 +384,25 @@ Yap_Eval__(Term t USES_REGS)
return Yap_InnerEval(t);
}
#ifdef P
inline static Term
Yap_FoundArithError(Term t, Term inp)
{
CACHE_REGS
if (LOCAL_Error_TYPE) {
Yap_Error(LOCAL_Error_TYPE, (inp ? inp : LOCAL_Error_Term), LOCAL_ErrorMessage);
P = FAILCODE;
return 0L;
}
return t;
inline static void
Yap_ClearExs(void)
{
feclearexcept(FE_ALL_EXCEPT);
}
#endif
inline static bool
Yap_FoundArithError__(USES_REGS1)
{
if (Yap_MathException() || LOCAL_Error_TYPE) {
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
regcache->P_ = FAILCODE;
return true;
}
return false;
}
Atom Yap_NameOfUnaryOp(int i);
Atom Yap_NameOfBinaryOp(int i);
#define RINT(v) return(MkIntegerTerm(v))

3
H/hlocals.h
View File

@ -173,6 +173,9 @@ typedef struct worker_local {
struct db_globs* s_dbg_;
yap_error_number matherror_;
Term mathtt_[4];
Int mathn_;
Term mathop_;
yap_error_number CurrentError_;
int heap_overflows_;

1
H/iatoms.h
View File

@ -275,6 +275,7 @@
AtomSigCreep = Yap_LookupAtom("sig_creep");
AtomSigDebug = Yap_LookupAtom("sig_debug");
AtomSigDelayCreep = Yap_LookupAtom("sig_delay_creep");
AtomSigFPE = Yap_LookupAtom("sig_fpe");
AtomSigHup = Yap_LookupAtom("sig_hup");
AtomSigInt = Yap_LookupAtom("sig_int");
AtomSigIti = Yap_LookupAtom("sig_iti");

3
H/ilocals.h
View File

@ -173,6 +173,9 @@ static void InitWorker(int wid) {
REMOTE_matherror(wid) = YAP_NO_ERROR;
REMOTE_mathn(wid) = 0;
REMOTE_mathop(wid) = YAP_NO_ERROR;
REMOTE_CurrentError(wid) = YAP_NO_ERROR;
REMOTE_heap_overflows(wid) = 0;

1
H/ratoms.h
View File

@ -275,6 +275,7 @@
AtomSigCreep = AtomAdjust(AtomSigCreep);
AtomSigDebug = AtomAdjust(AtomSigDebug);
AtomSigDelayCreep = AtomAdjust(AtomSigDelayCreep);
AtomSigFPE = AtomAdjust(AtomSigFPE);
AtomSigHup = AtomAdjust(AtomSigHup);
AtomSigInt = AtomAdjust(AtomSigInt);
AtomSigIti = AtomAdjust(AtomSigIti);

3
H/rlocals.h
View File

@ -186,6 +186,9 @@ static void RestoreWorker(int wid USES_REGS) {
#ifdef LOAD_DYLD
#endif

2
H/tatoms.h
View File

@ -548,6 +548,8 @@
#define AtomSigDebug Yap_heap_regs->AtomSigDebug_
Atom AtomSigDelayCreep_;
#define AtomSigDelayCreep Yap_heap_regs->AtomSigDelayCreep_
Atom AtomSigFPE_;
#define AtomSigFPE Yap_heap_regs->AtomSigFPE_
Atom AtomSigHup_;
#define AtomSigHup Yap_heap_regs->AtomSigHup_
Atom AtomSigInt_;

2
misc/LOCALS
View File

@ -197,7 +197,7 @@ struct db_globs* s_dbg void
yap_error_number matherror =YAP_NO_ERROR
Term mathtt[4] void
Int mathn =0
Term mathop =YAP_NO_ERROR
int mathop =0
yap_error_number CurrentError =YAP_NO_ERROR
//grow.c

5
pl/signals.yap
View File

@ -195,6 +195,9 @@ order of dispatch.
'$continue_signals',
'$hacks':'$stack_dump',
'$execute0'(G,M).
'$do_signal'(sig_fpe, [_M|_G]) :-
start_low_level_trace,
'$fpe_error'.
% Unix signals
'$do_signal'(sig_alarm, G) :-
'$signal_handler'(sig_alarm, G).
@ -257,6 +260,7 @@ order of dispatch.
'$signal_def'(sig_usr1, throw(error(signal(usr1,[]),true))).
'$signal_def'(sig_usr2, throw(error(signal(usr2,[]),true))).
'$signal_def'(sig_pipe, throw(error(signal(pipe,[]),true))).
'$signal_def'(sig_fpe, throw(error(signal(fpe,[]),true))).
% ignore sig_alarm by default
'$signal_def'(sig_alarm, true).
@ -267,6 +271,7 @@ order of dispatch.
'$signal'(sig_pipe).
'$signal'(sig_alarm).
'$signal'(sig_vtalarm).
'$signal'(sig_fpe).
on_signal(Signal,OldAction,NewAction) :-
var(Signal), !,