fix gmp support to give out of resource error if the bignum is too big.

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;

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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 /* 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 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);
+  return MkBigAndClose(&new);
-  mpz_clear(&new);
-  return t;
 }
 
 #endif

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,

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();
 #endif
@@ -552,14 +552,14 @@ p_sll(Term t1, Term t2) {
       {
 	Term 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);
+	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:
@@ -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:

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");

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);

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_;

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"

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)).

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)) -->