From 9852f7781d6ed977431f4016dc5faeebeff84925 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 22 May 2009 11:21:39 -0500 Subject: [PATCH] - simplify error handling in arithmetic and handle infinite terms (#46) --- C/arith1.c | 120 ++++++++++++---------------------------- C/arith2.c | 112 +++++++++++-------------------------- C/eval.c | 108 +++++++++++++++++++++++------------- C/gmp_support.c | 12 ++-- H/arith2.h | 143 +++++++++--------------------------------------- H/eval.h | 13 +++++ 6 files changed, 182 insertions(+), 326 deletions(-) diff --git a/C/arith1.c b/C/arith1.c index 3d7879a02..8c2e4fd49 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -48,7 +48,7 @@ float_to_int(Float v) #define RBIG_FL(v) return(float_to_int(v)) #if USE_GMP -static void +static Term process_iso_error(MP_INT *big, Term t, char *operation) { /* iso */ Int sz = 2+mpz_sizeinbase(big,10); @@ -56,12 +56,11 @@ process_iso_error(MP_INT *big, Term t, char *operation) if (s != NULL) { mpz_get_str(s, 10, big); - Yap_Error(TYPE_ERROR_FLOAT, t, "X is %s(%s)", operation, s); + Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is %s(%s)", operation, s); Yap_FreeCodeSpace(s); - P = (yamop *)FAILCODE; + RERROR(); } else { - Yap_Error(TYPE_ERROR_FLOAT, t, "X is %s(t)",operation); - P = (yamop *)FAILCODE; + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is %s(t)",operation); } } #endif @@ -145,10 +144,8 @@ msb(Int inp) /* calculate the most significant bit for an integer */ int off = sizeof(CELL)*4; if (inp < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), + return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), "msb/1 received %d", inp); - P = (yamop *)FAILCODE; - return(0); } while (off) { @@ -206,9 +203,7 @@ eval1(Int fi, Term t) { case long_int_e: RINT(~IntegerOfTerm(t)); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP { @@ -230,9 +225,7 @@ eval1(Int fi, Term t) { if (dbl >= 0) { RFLOAT(log(dbl)); } else { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); } } case op_log10: @@ -241,9 +234,7 @@ eval1(Int fi, Term t) { if (dbl >= 0) { RFLOAT(log10(dbl)); } else { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); } } case op_sqrt: @@ -252,9 +243,7 @@ eval1(Int fi, Term t) { out = sqrt(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl); } #endif RFLOAT(out); @@ -303,9 +292,7 @@ eval1(Int fi, Term t) { out = asin(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -318,9 +305,7 @@ eval1(Int fi, Term t) { out = acos(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -333,9 +318,7 @@ eval1(Int fi, Term t) { out = atan(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -348,9 +331,7 @@ eval1(Int fi, Term t) { out = asinh(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -363,9 +344,7 @@ eval1(Int fi, Term t) { out = acosh(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -378,9 +357,7 @@ eval1(Int fi, Term t) { out = atanh(dbl); #if HAVE_ISNAN if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); } #endif RFLOAT(out); @@ -411,9 +388,7 @@ eval1(Int fi, Term t) { switch (ETypeOfTerm(t)) { case long_int_e: if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t)); } else { RFLOAT(IntegerOfTerm(t)); } @@ -429,14 +404,11 @@ eval1(Int fi, Term t) { if (s != NULL) { mpz_get_str(s, 10, big); - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s); - P = (yamop *)FAILCODE; + Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s); Yap_FreeCodeSpace(s); RERROR(); } else { - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is floor(t)"); } } else { dbl = mpz_get_d(Yap_BigIntOfTerm(t)); @@ -458,9 +430,7 @@ eval1(Int fi, Term t) { switch (ETypeOfTerm(t)) { case long_int_e: if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t)); } else { RFLOAT(IntegerOfTerm(t)); } @@ -470,8 +440,7 @@ eval1(Int fi, Term t) { case big_int_e: #ifdef USE_GMP if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling"); - RERROR(); + return process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling"); } else { dbl = mpz_get_d(Yap_BigIntOfTerm(t)); } @@ -493,9 +462,7 @@ eval1(Int fi, Term t) { switch (ETypeOfTerm(t)) { case long_int_e: if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t)); } else { RFLOAT(IntegerOfTerm(t)); } @@ -505,8 +472,7 @@ eval1(Int fi, Term t) { case big_int_e: #ifdef USE_GMP if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { - process_iso_error(Yap_BigIntOfTerm(t), t, "round"); - RERROR(); + return process_iso_error(Yap_BigIntOfTerm(t), t, "round"); } else { dbl = mpz_get_d(Yap_BigIntOfTerm(t)); } @@ -553,9 +519,7 @@ eval1(Int fi, Term t) { mpz_init_set_d(&new, dbl); RBIG(&new); #else - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1"); #endif } } @@ -596,9 +560,7 @@ eval1(Int fi, Term t) { case long_int_e: RINT(msb(IntegerOfTerm(t))); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP RINT(mpz_sizeinbase(Yap_BigIntOfTerm(t),2)); @@ -610,9 +572,7 @@ eval1(Int fi, Term t) { switch (ETypeOfTerm(t)) { case long_int_e: if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t)); } else { RFLOAT(0.0); } @@ -626,8 +586,7 @@ eval1(Int fi, Term t) { case big_int_e: #ifdef USE_GMP if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part"); - RERROR(); + return process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part"); } else { RFLOAT(0.0); } @@ -639,9 +598,7 @@ eval1(Int fi, Term t) { switch (ETypeOfTerm(t)) { case long_int_e: if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t)); } else { RFLOAT(IntegerOfTerm(t)); } @@ -651,8 +608,7 @@ eval1(Int fi, Term t) { case big_int_e: #ifdef USE_GMP if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part"); - RERROR(); + return process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part"); } else { RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); } @@ -687,14 +643,10 @@ eval1(Int fi, Term t) { case long_int_e: RINT(Yap_random()*IntegerOfTerm(t)); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); case big_int_e: #ifdef USE_GMP - Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); #endif case db_ref_e: RERROR(); @@ -705,7 +657,7 @@ eval1(Int fi, Term t) { Term Yap_eval_unary(Int f, Term t) { - return eval1(f,t); + return Yap_FoundArithError(eval1(f,t), t); } static InitUnEntry InitUnTab[] = { @@ -751,13 +703,13 @@ p_unary_is(void) if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, ARG2, "X is Y"); - return(FALSE); + return FALSE; } top = Yap_Eval(Deref(ARG3)); if (top == 0L) return FALSE; if (IsIntTerm(t)) { - Term tout = eval1(IntegerOfTerm(t), top); + Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3)); if (!tout) return FALSE; return Yap_unify_constant(ARG1,tout); @@ -777,10 +729,10 @@ p_unary_is(void) Yap_Error(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,1); - P = (yamop *)FAILCODE; + P = FAILCODE; return(FALSE); } - if (!(out=eval1(p->FOfEE, top))) + if (!(out=Yap_FoundArithError(eval1(p->FOfEE, top),Deref(ARG3)))) return FALSE; return Yap_unify_constant(ARG1,out); } @@ -813,7 +765,7 @@ p_unary_op_as_integer(void) Yap_Error(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,2); - P = (yamop *)FAILCODE; + P = FAILCODE; return(FALSE); } return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE)); diff --git a/C/arith2.c b/C/arith2.c index 23fcbfbca..6e580bf78 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -78,10 +78,8 @@ p_mod(Term t1, Term t2) { #ifdef USE_GMP return Yap_gmp_add_ints(Int_MAX, 1); #else - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t1, + return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1, "// /2 with %d and %d", i1, i2); - P = (yamop *)FAILCODE; - RERROR(); #endif } mod = i1%i2; @@ -90,10 +88,7 @@ p_mod(Term t1, Term t2) { RINT(mod); } case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); #ifdef USE_GMP case (CELL)big_int_e: /* I know the term is much larger, so: */ @@ -111,10 +106,7 @@ p_mod(Term t1, Term t2) { break; } case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); case (CELL)big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { @@ -142,10 +134,7 @@ p_mod(Term t1, Term t2) { RBIG(&new); } case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); case db_ref_e: RERROR(); } @@ -154,10 +143,7 @@ p_mod(Term t1, Term t2) { RERROR(); } zero_divisor: - Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); } static Term @@ -177,20 +163,15 @@ p_rem(Term t1, Term t2) { #ifdef USE_GMP return Yap_gmp_add_ints(Int_MAX, 1); #else - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t1, + return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1, "rem/2 with %d and %d", i1, i2); - P = (yamop *)FAILCODE; - RERROR(); #endif } mod = i1%i2; RINT(i1%i2); } case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); #ifdef USE_GMP case (CELL)big_int_e: /* I know the term is much larger, so: */ @@ -201,9 +182,7 @@ p_rem(Term t1, Term t2) { } break; case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t1, "mod/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "mod/2"); #ifdef USE_GMP case (CELL)big_int_e: switch (ETypeOfTerm(t2)) { @@ -231,10 +210,7 @@ p_rem(Term t1, Term t2) { RBIG(&new); } case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); case db_ref_e: RERROR(); } @@ -243,10 +219,7 @@ p_rem(Term t1, Term t2) { RERROR(); } zero_divisor: - Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); } @@ -370,9 +343,7 @@ p_xor(Term t1, Term t2) /* two integers */ RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2)); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "#/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); #ifdef USE_GMP case big_int_e: { @@ -388,9 +359,7 @@ p_xor(Term t1, Term t2) } break; case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t1, "#/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "#/2"); #ifdef USE_GMP case big_int_e: switch (ETypeOfTerm(t2)) { @@ -412,10 +381,7 @@ p_xor(Term t1, Term t2) RBIG(&new); } case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "#/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); case db_ref_e: RERROR(); } @@ -634,10 +600,8 @@ p_exp(Term t1, Term t2) Int pow = ipow(i1,i2); if (i2 < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, + return Yap_ArithError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "%d ^ %d", i1, i2); - P = (yamop *)FAILCODE; - RERROR(); } #ifdef USE_GMP /* two integers */ @@ -658,9 +622,7 @@ p_exp(Term t1, Term t2) #ifdef USE_GMP case big_int_e: { - Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); } #endif case db_ref_e: @@ -683,9 +645,7 @@ p_exp(Term t1, Term t2) #ifdef USE_GMP case big_int_e: { - Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); } #endif case db_ref_e: @@ -703,9 +663,7 @@ p_exp(Term t1, Term t2) case big_int_e: /* two bignums, makes no sense */ // - Yap_Error(RESOURCE_ERROR_HUGE_INT, t1, "^/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t1, "^/2"); case double_e: { Float dbl = FloatOfTerm(t2); @@ -735,9 +693,8 @@ gcd(Int m11,Int m21) } if (m11<0 || m21<0) { /* overflow? */ /* Oflow = 1; */ - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), "gcd/2 with %d and %d", m11, m21); - P = (yamop *)FAILCODE; return(1); } if (m11) return(m11); @@ -757,9 +714,8 @@ Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */ } if (m11<0 || m21<0) { /* overflow? */ /* Oflow = 1; */ - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), + Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), "gcdmult/2 with %d and %d", m11, m21); - P = (yamop *)FAILCODE; return(1); } if (m11) { @@ -789,10 +745,7 @@ p_gcd(Term t1, Term t2) RINT(gcd(i1,i2)); } case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "gcd/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); #ifdef USE_GMP case big_int_e: /* I know the term is much larger, so: */ @@ -813,9 +766,7 @@ p_gcd(Term t1, Term t2) } break; case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t1, "gcd/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "gcd/2"); #ifdef USE_GMP case big_int_e: switch (ETypeOfTerm(t2)) { @@ -842,10 +793,7 @@ p_gcd(Term t1, Term t2) RBIG(&new); } case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "gcd/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); case db_ref_e: RERROR(); } @@ -1184,7 +1132,7 @@ eval2(Int fi, Term t1, Term t2) { Term Yap_eval_binary(Int f, Term t1, Term t2) { - return eval2(f,t1,t2); + return Yap_FoundArithError(eval2(f,t1,t2), 0L); } static InitBinEntry InitBinTab[] = { @@ -1219,7 +1167,7 @@ p_binary_is(void) Term t1, t2; if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,t, "X is Y"); + Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y"); return(FALSE); } t1 = Yap_Eval(Deref(ARG3)); @@ -1229,7 +1177,7 @@ p_binary_is(void) if (t2 == 0L) return FALSE; if (IsIntTerm(t)) { - Term tout = eval2(IntegerOfTerm(t), t1, t2); + Term tout = Yap_FoundArithError(eval2(IntegerOfTerm(t), t1, t2), 0L); if (!tout) return FALSE; return Yap_unify_constant(ARG1,tout); @@ -1249,10 +1197,10 @@ p_binary_is(void) Yap_Error(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,2); - P = (yamop *)FAILCODE; + P = FAILCODE; return(FALSE); } - if (!(out=eval2(p->FOfEE, t1, t2))) + if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L))) return FALSE; return Yap_unify_constant(ARG1,out); } @@ -1285,7 +1233,7 @@ p_binary_op_as_integer(void) Yap_Error(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,2); - P = (yamop *)FAILCODE; + P = FAILCODE; return(FALSE); } return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE)); @@ -1302,6 +1250,10 @@ Yap_InitBinaryExps(void) for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) { AtomEntry *ae = RepAtom(Yap_LookupAtom(InitBinTab[i].OpName)); + if (ae == NULL) { + Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitBinaryExps"); + return; + } WRITE_LOCK(ae->ARWLock); if (Yap_GetExpPropHavingLock(ae, 2)) { WRITE_UNLOCK(ae->ARWLock); diff --git a/C/eval.c b/C/eval.c index 59f3fdda3..0b2f69eca 100644 --- a/C/eval.c +++ b/C/eval.c @@ -33,9 +33,7 @@ static Term Eval(Term t) { if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic"); - P = (yamop *)FAILCODE; - return 0L; + return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic"); } else if (IsAtomTerm(t)) { ExpEntry *p; Atom name = AtomOfTerm(t); @@ -48,7 +46,7 @@ Eval(Term t) ti[1] = MkIntegerTerm(0); /* error */ terror = Yap_MkApplTerm(FunctorSlash, 2, ti); - Yap_Error(TYPE_ERROR_EVALUABLE, terror, + Yap_ArithError(TYPE_ERROR_EVALUABLE, terror, "atom %s for arithmetic expression", RepAtom(name)->StrOfAE); P = (yamop *)FAILCODE; @@ -68,40 +66,53 @@ Eval(Term t) return t; default: { - Int n = ArityOfFunctor(fun); - Atom name = NameOfFunctor(fun); - ExpEntry *p; - Term t1, t2; - - if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { - Term ti[2]; - - /* error */ - ti[0] = t; - ti[1] = MkIntegerTerm(n); - t = Yap_MkApplTerm(FunctorSlash, 2, ti); - Yap_Error(TYPE_ERROR_EVALUABLE, t, - "functor %s/%d for arithmetic expression", - RepAtom(name)->StrOfAE,n); + if ((Atom)fun == AtomFoundVar) { + Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, + "cyclic term in arithmetic expression"); P = (yamop *)FAILCODE; RERROR(); + } else { + Int n = ArityOfFunctor(fun); + Atom name = NameOfFunctor(fun); + ExpEntry *p; + Term t1, t2; + + if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { + Term ti[2]; + + /* error */ + ti[0] = t; + ti[1] = MkIntegerTerm(n); + t = Yap_MkApplTerm(FunctorSlash, 2, ti); + Yap_ArithError(TYPE_ERROR_EVALUABLE, t, + "functor %s/%d for arithmetic expression", + RepAtom(name)->StrOfAE,n); + P = (yamop *)FAILCODE; + RERROR(); + } + *RepAppl(t) = (CELL)AtomFoundVar; + t1 = Eval(ArgOfTerm(1,t)); + if (t1 == 0L) { + *RepAppl(t) = (CELL)fun; + return FALSE; + } + if (n == 1) { + *RepAppl(t) = (CELL)fun; + return Yap_eval_unary(p->FOfEE, t1); + } + t2 = Eval(ArgOfTerm(2,t)); + *RepAppl(t) = (CELL)fun; + if (t2 == 0L) + return FALSE; + return Yap_eval_binary(p->FOfEE,t1,t2); } - t1 = Eval(ArgOfTerm(1,t)); - if (t1 == 0L) - return FALSE; - if (n == 1) - return Yap_eval_unary(p->FOfEE, t1); - t2 = Eval(ArgOfTerm(2,t)); - if (t2 == 0L) - return FALSE; - return Yap_eval_binary(p->FOfEE,t1,t2); } } } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { - Yap_Error(TYPE_ERROR_EVALUABLE, t, + Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be evaluated as an arithmetic expression"); - P = (yamop *)FAILCODE; + P = FAILCODE; return 0L; } return Eval(HeadOfTerm(t)); @@ -111,7 +122,7 @@ Eval(Term t) Term Yap_Eval(Term t) { - return Eval(t); + return Yap_FoundArithError(Eval(t), t); } #ifdef BEAM @@ -133,16 +144,37 @@ BEAM_is(void) static Int p_is(void) { /* X is Y */ - Term out; - - out = Eval(Deref(ARG2)); - if (out == 0L) { - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, ARG2, "is/2"); - return FALSE; - } + Term out, t; + + t = Deref(ARG2); + out = Yap_FoundArithError(Eval(t), t); + if (!out) return FALSE; return Yap_unify_constant(ARG1,out); } +Int +Yap_ArithError(yap_error_number type, Term where, char *format,...) +{ + va_list ap; + + Yap_Error_TYPE = type; + Yap_Error_Term = where; + if (!Yap_ErrorMessage) + Yap_ErrorMessage = Yap_ErrorSay; + va_start (ap, format); + if (format != NULL) { +#if HAVE_VSNPRINTF + (void) vsnprintf(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE, format, ap); +#else + (void) vsprintf(Yap_ErrorMessage, format, ap); +#endif + } else { + Yap_ErrorMessage[0] = '\0'; + } + va_end (ap); + return 0L; +} + void Yap_InitEval(void) { diff --git a/C/gmp_support.c b/C/gmp_support.c index 408bab473..19afe990b 100644 --- a/C/gmp_support.c +++ b/C/gmp_support.c @@ -28,9 +28,7 @@ MkBigAndClose(MP_INT *new) Term t = Yap_MkBigIntTerm(new); mpz_clear(new); if (t == TermNil) { - Yap_Error(RESOURCE_ERROR_STACK, t, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_STACK, t, ">>/2"); } return t; } @@ -154,8 +152,7 @@ Yap_gmp_div_big_int(MP_INT *b, Int i) if (i > 0) { mpz_tdiv_q_ui(&new, &new, i); } else if (i == 0) { - Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); - return 0L; + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); } else { /* we do not handle MIN_INT */ mpz_tdiv_q_ui(&new, &new, -i); @@ -165,8 +162,7 @@ Yap_gmp_div_big_int(MP_INT *b, Int i) if (i > 0) { mpz_fdiv_q_ui(&new, &new, i); } else if (i == 0) { - Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); - return 0L; + return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); } else { /* we do not handle MIN_INT */ mpz_fdiv_q_ui(&new, &new, -i); @@ -212,7 +208,7 @@ Yap_gmp_sll_big_int(MP_INT *b, Int i) } else { mpz_init_set(&new, b); if (i == Int_MIN) { - return 0L; + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, MkIntegerTerm(i), "<>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); } RINT(IntegerOfTerm(t1) >> -i2); } return do_sll(IntegerOfTerm(t1),IntegerOfTerm(t2)); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "<>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "<>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); } return do_sll(IntegerOfTerm(t1), -i2); } RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2)); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); case big_int_e: #ifdef USE_GMP - Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); #endif case db_ref_e: RERROR(); } break; case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t1, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t1, ">>/2"); case big_int_e: #ifdef USE_GMP switch (ETypeOfTerm(t2)) { case long_int_e: - { - Term t; - - t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2)); - if (t == 0L) { - Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); - } - return(t); - } + return Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2)); case big_int_e: - Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); + return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); case db_ref_e: RERROR(); } diff --git a/H/eval.h b/H/eval.h index 7878a0c03..6ef59659f 100644 --- a/H/eval.h +++ b/H/eval.h @@ -164,6 +164,19 @@ Term STD_PROTO(Yap_eval_unary,(Int,Term)); Term STD_PROTO(Yap_eval_binary,(Int,Term,Term)); Term STD_PROTO(Yap_Eval,(Term)); +Int STD_PROTO(Yap_ArithError,(yap_error_number,Term,char *msg, ...)); + +inline static Term +Yap_FoundArithError(Term t, Term inp) +{ + if (Yap_Error_TYPE) { + Yap_Error(Yap_Error_TYPE, (inp ? inp : Yap_Error_Term), Yap_ErrorMessage); + P = FAILCODE; + return 0L; + } + return t; +} + #define RINT(v) return(MkIntegerTerm(v)) #define RFLOAT(v) return(MkFloatTerm(v))