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

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

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-04-25 11:01:33 -05:00
parent 09d33c6cad
commit c132e7e6ec
10 changed files with 73 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
C/errors.c
View File

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

110
C/gmp_support.c
View File

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

1
H/Yap.h
View File

@ -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,

20
H/arith2.h
View File

@ -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:

1
H/iatoms.h
View File

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

1
H/ratoms.h
View File

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

2
H/tatoms.h
View File

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

1
misc/ATOMS
View File

@ -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"

6
pl/errors.yap
View File

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

4
pl/messages.yap
View File

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