diff --git a/C/errors.c b/C/errors.c index b19dec6a9..c7352547d 100644 --- a/C/errors.c +++ b/C/errors.c @@ -1357,6 +1357,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...) serious = TRUE; } break; + case RESOURCE_ERROR_STACK: + { + int i; + Term ti[1]; + + i = strlen(tmpbuf); + ti[0] = MkAtomTerm(AtomStack); + nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti); + tp = tmpbuf+i; + psize -= i; + fun = FunctorError; + serious = TRUE; + } + break; case RESOURCE_ERROR_HUGE_INT: { int i; diff --git a/C/gmp_support.c b/C/gmp_support.c index 17bd1db77..408bab473 100644 --- a/C/gmp_support.c +++ b/C/gmp_support.c @@ -16,17 +16,30 @@ *************************************************************************/ #include "Yap.h" +#include "Yatom.h" #include "Heap.h" #include "eval.h" #if USE_GMP +static inline Term +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 t; +} + /* add i + j using temporary bigint new */ Term Yap_gmp_add_ints(Int i, Int j) { MP_INT new; - Term t; mpz_init_set_si(&new,i); if (j > 0) { @@ -39,9 +52,7 @@ Yap_gmp_add_ints(Int i, Int j) mpz_sub_ui(&new, &new, -j); } } - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term @@ -61,6 +72,7 @@ Yap_gmp_sub_ints(Int i, Int j) mpz_add_ui(&new, &new, -j); } } + return MkBigAndClose(&new); t = Yap_MkBigIntTerm(&new); mpz_clear(&new); return t; @@ -70,26 +82,20 @@ Term Yap_gmp_mul_ints(Int i, Int j) { MP_INT new; - Term t; mpz_init_set_si(&new,i); mpz_mul_si(&new, &new, j); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_sll_ints(Int i, Int j) { MP_INT new; - Term t; mpz_init_set_si(&new,i); mpz_mul_2exp(&new, &new, j); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* add i + b using temporary bigint new */ @@ -97,13 +103,10 @@ Term Yap_gmp_add_int_big(Int i, MP_INT *b) { MP_INT new; - Term t; mpz_init_set_si(&new, i); mpz_add(&new, &new, b); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* sub i - b using temporary bigint new */ @@ -111,13 +114,10 @@ Term Yap_gmp_sub_int_big(Int i, MP_INT *b) { MP_INT new; - Term t; mpz_init_set_si(&new, i); mpz_sub(&new, &new, b); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* add i + b using temporary bigint new */ @@ -125,13 +125,10 @@ Term Yap_gmp_mul_int_big(Int i, MP_INT *b) { MP_INT new; - Term t; mpz_init_set_si(&new, i); mpz_mul(&new, &new, b); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* sub i - b using temporary bigint new */ @@ -139,14 +136,11 @@ Term Yap_gmp_sub_big_int(MP_INT *b, Int i) { MP_INT new; - Term t; mpz_init_set_si(&new, i); mpz_neg(&new, &new); mpz_add(&new, &new, b); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* div i / b using temporary bigint new */ @@ -154,7 +148,6 @@ Term Yap_gmp_div_big_int(MP_INT *b, Int i) { MP_INT new; - Term t; mpz_init_set(&new, b); if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) { @@ -180,9 +173,7 @@ Yap_gmp_div_big_int(MP_INT *b, Int i) mpz_neg(&new, &new); } } - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* sub i - b using temporary bigint new */ @@ -190,13 +181,10 @@ Term Yap_gmp_and_int_big(Int i, MP_INT *b) { MP_INT new; - Term t; mpz_init_set_si(&new, i); mpz_and(&new, &new, b); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* sub i - b using temporary bigint new */ @@ -204,13 +192,10 @@ Term Yap_gmp_ior_int_big(Int i, MP_INT *b) { MP_INT new; - Term t; mpz_init_set_si(&new, i); mpz_ior(&new, &new, b); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* add i + b using temporary bigint new */ @@ -218,7 +203,6 @@ Term Yap_gmp_sll_big_int(MP_INT *b, Int i) { MP_INT new; - Term t; if (i > 0) { mpz_init_set(&new, b); @@ -232,48 +216,37 @@ Yap_gmp_sll_big_int(MP_INT *b, Int i) } mpz_tdiv_q_2exp(&new, &new, -i); } - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2) { MP_INT new; - Term t; mpz_init_set(&new, b1); mpz_add(&new, &new, b2); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2) { MP_INT new; - Term t; mpz_init_set(&new, b1); mpz_sub(&new, &new, b2); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2) { MP_INT new; - Term t; mpz_init_set(&new, b1); mpz_mul(&new, &new, b2); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } /* div i / b using temporary bigint new */ @@ -281,7 +254,6 @@ Term Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2) { MP_INT new; - Term t; mpz_init_set(&new, b1); if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) { @@ -289,35 +261,27 @@ Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2) } else { mpz_fdiv_q(&new, &new, b2); } - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2) { MP_INT new; - Term t; mpz_init_set(&new, b1); mpz_and(&new, &new, b2); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2) { MP_INT new; - Term t; mpz_init_set(&new, b1); mpz_ior(&new, &new, b2); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term @@ -348,20 +312,16 @@ Term Yap_gmp_exp_ints(Int i1, Int i2) { MP_INT new; - Term t; mpz_init_set_si(&new, i1); mpz_pow_ui (&new, &new, (unsigned long int)i2); - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } Term Yap_gmp_exp_big_int(MP_INT *b, Int i) { MP_INT new; - Term t; if (b > 0) { mpz_init(&new); @@ -373,9 +333,7 @@ Yap_gmp_exp_big_int(MP_INT *b, Int i) mpz_init_set_si(&new, i); mpz_powm (&new, b, &new, b); } - t = Yap_MkBigIntTerm(&new); - mpz_clear(&new); - return t; + return MkBigAndClose(&new); } #endif diff --git a/H/Yap.h b/H/Yap.h index dbeeb530d..38a163cbd 100644 --- a/H/Yap.h +++ b/H/Yap.h @@ -481,6 +481,7 @@ typedef enum RESOURCE_ERROR_HUGE_INT, RESOURCE_ERROR_MAX_THREADS, RESOURCE_ERROR_MEMORY, + RESOURCE_ERROR_STACK, RETRY_COUNTER_UNDERFLOW, SYNTAX_ERROR, SYSTEM_ERROR, diff --git a/H/arith2.h b/H/arith2.h index 1e2babeb7..658b1767d 100644 --- a/H/arith2.h +++ b/H/arith2.h @@ -492,7 +492,7 @@ p_or(Term t1, Term t2) { return(Yap_gmp_ior_int_big(IntegerOfTerm(t2),Yap_BigIntOfTerm(t1))); case big_int_e: /* two bignums */ - return(Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1))); + return Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)); case double_e: Yap_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2"); /* make GCC happy */ @@ -520,7 +520,7 @@ p_sll(Term t1, Term t2) { if (IntegerOfTerm(t2) < 0) { Int i2 = IntegerOfTerm(t2); if (i2 == Int_MIN) { - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); + Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); } @@ -533,7 +533,7 @@ p_sll(Term t1, Term t2) { RERROR(); case big_int_e: #ifdef USE_GMP - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<>/2"); + Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, "<>/2"); P = (yamop *)FAILCODE; RERROR(); case double_e: @@ -589,7 +589,7 @@ p_slr(Term t1, Term t2) { if (IntegerOfTerm(t2) < 0) { Int i2 = IntegerOfTerm(t2); if (i2 == Int_MIN) { - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); + Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); } @@ -602,7 +602,7 @@ p_slr(Term t1, Term t2) { RERROR(); case big_int_e: #ifdef USE_GMP - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); + Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); #endif @@ -623,14 +623,14 @@ p_slr(Term t1, Term t2) { t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2)); if (t == 0L) { - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); + Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); } return(t); } case big_int_e: - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); + Yap_Error(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); case double_e: diff --git a/H/iatoms.h b/H/iatoms.h index 697a1888f..2c85dae5a 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -237,6 +237,7 @@ AtomSocket = Yap_LookupAtom("socket"); AtomSourceSink = Yap_LookupAtom("source_sink"); AtomSpy = Yap_FullLookupAtom("$spy"); + AtomStack = Yap_LookupAtom("stack"); AtomStackFree = Yap_LookupAtom("stackfree"); AtomStaticClause = Yap_FullLookupAtom("$static_clause"); AtomStaticProcedure = Yap_LookupAtom("static_procedure"); diff --git a/H/ratoms.h b/H/ratoms.h index 5535e0d55..c8e46fc1a 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -239,6 +239,7 @@ AtomSocket = AtomAdjust(AtomSocket); AtomSourceSink = AtomAdjust(AtomSourceSink); AtomSpy = AtomAdjust(AtomSpy); + AtomStack = AtomAdjust(AtomStack); AtomStackFree = AtomAdjust(AtomStackFree); AtomStaticClause = AtomAdjust(AtomStaticClause); AtomStaticProcedure = AtomAdjust(AtomStaticProcedure); diff --git a/H/tatoms.h b/H/tatoms.h index 45e5a388d..bd29921f6 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -480,6 +480,8 @@ #define AtomSourceSink Yap_heap_regs->AtomSourceSink_ Atom AtomSpy_; #define AtomSpy Yap_heap_regs->AtomSpy_ + Atom AtomStack_; +#define AtomStack Yap_heap_regs->AtomStack_ Atom AtomStackFree_; #define AtomStackFree Yap_heap_regs->AtomStackFree_ Atom AtomStaticClause_; diff --git a/misc/ATOMS b/misc/ATOMS index 7e1b02387..a2e9c1a53 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -248,6 +248,7 @@ A Slash N "/" A Socket N "socket" A SourceSink N "source_sink" A Spy F "$spy" +A Stack N "stack" A StackFree N "stackfree" A StaticClause F "$static_clause" A StaticProcedure N "static_procedure" diff --git a/pl/errors.yap b/pl/errors.yap index 23ed8a3b4..11278b292 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -212,10 +212,14 @@ flush_all_streams, fail. +'$process_error'('$abort', top) :- !, + print_message(informational,abort(user)). +'$process_error'('$abort', _) :- !, + throw('$abort'). '$process_error'(abort, top) :- !, print_message(informational,abort(user)). '$process_error'(abort, _) :- !, - throw('$abort'). + throw(abort). '$process_error'(error(thread_cancel(Id), G),top) :- !. '$process_error'(error(thread_cancel(Id), G), _) :- !, throw(error(thread_cancel(Id), G)). diff --git a/pl/messages.yap b/pl/messages.yap index 78f156fde..f1748d697 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -39,6 +39,8 @@ generate_message(halt) --> !, ['YAP execution halted']. generate_message('$abort') :- !, ['YAP execution aborted']. +generate_message(abort(user)) :- !, + ['YAP execution aborted: user request']. generate_message(loading(_,user)) --> !. generate_message(loading(What,AbsoluteFileName)) --> !, [ '~a ~a...' - [What, AbsoluteFileName] ]. @@ -244,6 +246,8 @@ system_message(error(representation_error(max_arity), Where)) --> [ 'REPRESENTATION ERROR- ~w: number too big' - [Where] ]. system_message(error(resource_error(huge_int), Where)) --> [ 'RESOURCE ERROR- too large an integer in absolute value' - [Where] ]. +system_message(error(resource_error(stack), Where)) --> + [ 'RESOURCE ERROR- not enough stack' - [Where] ]. system_message(error(resource_error(threads), Where)) --> [ 'RESOURCE ERROR- too many open threads' - [Where] ]. system_message(error(resource_error(memory), Where)) -->