support for tabling of bignums and strings

This commit is contained in:
Vítor Santos Costa 2014-01-17 09:39:29 +00:00
parent f3e5639439
commit ccccf71ae1
15 changed files with 369 additions and 155 deletions

View File

@ -31,6 +31,7 @@ static char SccsId[] = "%W% %G%";
#include "eval.h"
#include "alloc.h"
#include "pl-utf8.h"
Term
Yap_MkBigIntTerm(MP_INT *big)
@ -332,6 +333,82 @@ Yap_MkULLIntTerm(YAP_ULONG_LONG n)
#endif
}
CELL *
Yap_HeapStoreOpaqueTerm(Term t)
{
CELL *ptr = RepAppl(t);
size_t sz;
void *new;
if (ptr[0] == (CELL)FunctorBigInt) {
sz = sizeof(MP_INT)+2*CellSize+
((MP_INT *)(ptr+2))->_mp_alloc*sizeof(mp_limb_t);
} else { /* string */
sz = sizeof(CELL)*(2+ptr[1]);
}
new = Yap_AllocCodeSpace(sz);
if (!new) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "subgoal_search_loop: no space for %s", StringOfTerm(t) );
} else {
if (ptr[0] == (CELL)FunctorBigInt) {
MP_INT *new = (MP_INT *)(RepAppl(t)+2);
new->_mp_d = (mp_limb_t *)(new+1);
}
memmove(new, ptr, sz);
}
return new;
}
size_t
Yap_OpaqueTermToString(Term t, char *str, size_t max)
{
size_t str_index = 0;
CELL * li = RepAppl(t);
if (li[0] == (CELL)FunctorString) {
str_index += sprintf(& str[str_index], "\"");
do {
int chr;
char *ptr = (char *)StringOfTerm(AbsAppl(li));
ptr = utf8_get_char(ptr, &chr);
if (chr == '\0') break;
str_index += sprintf(& str[str_index], "%C", chr);
} while (TRUE);
str_index += sprintf(& str[str_index], "\"");
} else {
CELL big_tag = li[1];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
str_index += sprintf(& str[str_index], "{...}");
#ifdef USE_GMP
} else if (big_tag == BIG_INT) {
MP_INT *big = Yap_BigIntOfTerm(AbsAppl(li));
char *s = mpz_get_str(&str[str_index], 10, big);
str_index += strlen(&s[str_index]);
} else if (big_tag == BIG_RATIONAL) {
MP_RAT *big = Yap_BigRatOfTerm(AbsAppl(li));
char *s = mpq_get_str(&str[str_index], 10, big);
str_index += strlen(&s[str_index]);
#endif
}
/*
else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
Opaque_CallOnWrite f;
CELL blob_info;
blob_info = big_tag - USER_BLOB_START;
if (GLOBAL_OpaqueHandlers &&
(f= GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
(f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0);
return;
}
} */
str_index += sprintf(& str[str_index], "0");
}
return str_index;
}
static Int
p_is_bignum( USES_REGS1 )
{

View File

@ -567,6 +567,7 @@ X_API void *YAP_ExternalDataInStackFromTerm(Term);
X_API int YAP_NewOpaqueType(void *);
X_API Term YAP_NewOpaqueObject(int, size_t);
X_API void *YAP_OpaqueObjectFromTerm(Term);
X_API CELL *YAP_HeapStoreOpaqueTerm(Term t);
X_API int YAP_Argv(char *** argvp);
X_API YAP_tag_t YAP_TagOfTerm(Term);
X_API size_t YAP_ExportTerm(Term, char *, size_t);
@ -2591,6 +2592,12 @@ YAP_OpaqueObjectFromTerm(Term t)
return ExternalBlobFromTerm (t);
}
X_API CELL *
YAP_HeapStoreOpaqueTerm(Term t)
{
return Yap_HeapStoreOpaqueTerm(t);
}
X_API Int
YAP_RunGoalOnce(Term t)
{

View File

@ -416,6 +416,10 @@
OPCODE(trie_trust_longint ,e),
OPCODE(trie_try_longint ,e),
OPCODE(trie_retry_longint ,e),
OPCODE(trie_do_bigint ,e),
OPCODE(trie_trust_bigint ,e),
OPCODE(trie_try_bigint ,e),
OPCODE(trie_retry_bigint ,e),
OPCODE(trie_do_gterm ,e),
OPCODE(trie_trust_gterm ,e),
OPCODE(trie_try_gterm ,e),

View File

@ -106,6 +106,8 @@ Term Yap_RatTermToApplTerm(Term);
void Yap_InitBigNums(void);
Term Yap_AllocExternalDataInStack(CELL, size_t);
int Yap_CleanOpaqueVariable(CELL *);
CELL *Yap_HeapStoreOpaqueTerm(Term t);
size_t Yap_OpaqueTermToString(Term t, char *str, size_t max);
/* c_interface.c */
Int YAP_Execute(struct pred_entry *, CPredicate);

View File

@ -75,8 +75,29 @@ mul_overflow(Int z, Int i1, Int i2)
}
#ifndef OPTIMIZE_MULTIPLI
#define DO_MULTI() z = i1*i2; \
if (i2 && z/i2 != i1) goto overflow
#if __clang__ && FALSE /* not in OSX yet */
#define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; }
#elif SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
#define DO_MULTI() {\
int64_t w = (int64_t)i1*i2; \
if (w >= 0) {\
if ((w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
} else {\
if ((-w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
}\
z = w;\
}
#else
#define DO_MULTI() {\
__int128_t w = (__int128_t)i1*i2; \
if (w >= 0) {\
if ((w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
} else {\
if ((-w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
}\
z = (Int)w; \
}
#endif
#endif
inline static Term
@ -148,62 +169,6 @@ do_sll(Int i, Int j USES_REGS) /* j > 0 */
}
static inline Term
p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1+fl2);
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
}
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
case double_e:
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
}
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return Yap_gmp_add_big_big(t1, t2);
case double_e:
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}
static Term
p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {

View File

@ -347,28 +347,82 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
}
inline static int
add_overflow(Int x, Int i, Int j)
{
return ((i & j & ~x) | (~i & ~j & x)) < 0;
}
#if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }
#endif
inline static Term
add_int(Int i, Int j USES_REGS)
{
Int x = i+j;
#if USE_GMP
/* Integer overflow, we need to use big integers */
Int overflow = (i & j & ~x) | (~i & ~j & x);
if (overflow < 0) {
return(Yap_gmp_add_ints(i, j));
UInt w = (UInt)i+(UInt)j;
if (i > 0) {
if (j > 0 && (Int)w < 0) goto overflow;
} else {
if (j < 0 && (Int)w > 0) goto overflow;
}
#endif
#ifdef BEAM
RINT(x);
return( MkIntegerTerm (x));
RINT( (Int)w);
/* Integer overflow, we need to use big integers */
overflow:
return Yap_gmp_add_ints(i, j);
#else
RINT(x);
#endif
}
static inline Term
p_plus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1+fl2);
}
case big_int_e:
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), t2));
#endif
default:
RERROR();
}
case double_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* float * integer */
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
case double_e:
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
case big_int_e:
#ifdef USE_GMP
return Yap_gmp_add_float_big(FloatOfTerm(t1),t2);
#endif
default:
RERROR();
}
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
return Yap_gmp_add_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
return Yap_gmp_add_big_big(t1, t2);
case double_e:
return Yap_gmp_add_float_big(FloatOfTerm(t2),t1);
default:
RERROR();
}
#endif
default:
RERROR();
}
RERROR();
}

View File

@ -880,6 +880,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_do_appl_in_pair:
case _trie_do_atom:
case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double:
case _trie_do_extension:
case _trie_do_gterm:
@ -895,6 +896,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_retry_appl_in_pair:
case _trie_retry_atom:
case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double:
case _trie_retry_extension:
case _trie_retry_gterm:
@ -910,6 +912,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_trust_appl_in_pair:
case _trie_trust_atom:
case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double:
case _trie_trust_extension:
case _trie_trust_gterm:
@ -925,6 +928,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _trie_try_appl_in_pair:
case _trie_try_atom:
case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double:
case _trie_try_extension:
case _trie_try_gterm:

View File

@ -904,6 +904,7 @@
case _trie_do_appl_in_pair:
case _trie_do_atom:
case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double:
case _trie_do_extension:
case _trie_do_gterm:
@ -919,6 +920,7 @@
case _trie_retry_appl_in_pair:
case _trie_retry_atom:
case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double:
case _trie_retry_extension:
case _trie_retry_gterm:
@ -934,6 +936,7 @@
case _trie_trust_appl_in_pair:
case _trie_trust_atom:
case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double:
case _trie_trust_extension:
case _trie_trust_gterm:
@ -949,6 +952,7 @@
case _trie_try_appl_in_pair:
case _trie_try_atom:
case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double:
case _trie_try_extension:
case _trie_try_gterm:

View File

@ -666,6 +666,7 @@
case _trie_do_appl_in_pair:
case _trie_do_atom:
case _trie_do_atom_in_pair:
case _trie_do_bigint:
case _trie_do_double:
case _trie_do_extension:
case _trie_do_gterm:
@ -681,6 +682,7 @@
case _trie_retry_appl_in_pair:
case _trie_retry_atom:
case _trie_retry_atom_in_pair:
case _trie_retry_bigint:
case _trie_retry_double:
case _trie_retry_extension:
case _trie_retry_gterm:
@ -696,6 +698,7 @@
case _trie_trust_appl_in_pair:
case _trie_trust_atom:
case _trie_trust_atom_in_pair:
case _trie_trust_bigint:
case _trie_trust_double:
case _trie_trust_extension:
case _trie_trust_gterm:
@ -711,6 +714,7 @@
case _trie_try_appl_in_pair:
case _trie_try_atom:
case _trie_try_atom_in_pair:
case _trie_try_bigint:
case _trie_try_double:
case _trie_try_extension:
case _trie_try_gterm:

View File

@ -54,24 +54,35 @@ Int unify(Term t0, Term t1)
EXTERN inline Int unify_constant(register Term a, register Term cons)
{
CELL *pt;
CELL *pt0, *pt1;
deref_head(a,unify_cons_unk);
unify_cons_nonvar:
{
if (a == cons) return(TRUE);
else if (IsApplTerm(a) && IsExtensionFunctor(FunctorOfTerm(a))) {
Functor fun = FunctorOfTerm(a);
if (fun == FunctorDouble)
return(IsFloatTerm(cons) && FloatOfTerm(a) == FloatOfTerm(cons));
else if (fun == FunctorLongInt) {
return(IsLongIntTerm(cons) && LongIntOfTerm(a) == LongIntOfTerm(cons));
#ifdef TERM_EXTENSIONS
} else if (IsAttachFunc(fun)) {
return(GLOBAL_attas[ExtFromFunctor(fun)].bind_op(SBIND,a,cons));
#endif /* TERM_EXTENSIONS */
} else
if (!IsApplTerm(cons) || FunctorOfTerm(cons) != fun)
return FALSE;
switch((CELL)fun) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
/* no other factors are accepted as arguments */
} else return(FALSE);
}
}
/* no other factors are accepted as arguments */
return(FALSE);
}

View File

@ -111,12 +111,16 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
/* traverse macros */
#define SHOW_MODE_STRUCTURE 0
#define SHOW_MODE_STATISTICS 1
#define TRAVERSE_MODE_NORMAL 0
#define TRAVERSE_MODE_DOUBLE 1
#define TRAVERSE_MODE_DOUBLE2 2
#define TRAVERSE_MODE_DOUBLE_END 3
#define TRAVERSE_MODE_LONGINT 4
#define TRAVERSE_MODE_LONGINT_END 5
typedef enum {
TRAVERSE_MODE_NORMAL = 0,
TRAVERSE_MODE_DOUBLE = 1,
TRAVERSE_MODE_DOUBLE2 = 2,
TRAVERSE_MODE_DOUBLE_END = 3,
TRAVERSE_MODE_BIGINT_OR_STRING = 4,
TRAVERSE_MODE_BIGINT_OR_STRING_END = 5,
TRAVERSE_MODE_LONGINT = 6,
TRAVERSE_MODE_LONGINT_END = 7
} traverse_mode_t;
/* do not change order !!! */
#define TRAVERSE_TYPE_SUBGOAL 0
#define TRAVERSE_TYPE_ANSWER 1

View File

@ -19,6 +19,7 @@
#ifdef TABLING
#include "Yatom.h"
#include "YapHeap.h"
#include "eval.h"
#include "tab.macros.h"
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
@ -376,6 +377,11 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac
current_node = TrNode_parent(current_node);
current_node = TrNode_parent(current_node);
t = MkLongIntTerm(li);
} else if (f == FunctorBigInt || f == FunctorString) {
CELL *li = (CELL *)TrNode_entry(current_node);
current_node = TrNode_parent(current_node);
current_node = TrNode_parent(current_node);
t = AbsAppl(li);
} else {
int f_arity = ArityOfFunctor(f);
t = Yap_MkApplTerm(f, f_arity, stack_terms);
@ -517,12 +523,16 @@ static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) {
mode = TRAVERSE_MODE_DOUBLE;
else if (f == FunctorLongInt)
mode = TRAVERSE_MODE_LONGINT;
else if (f == FunctorBigInt || f == FunctorString)
mode = TRAVERSE_MODE_BIGINT_OR_STRING;
else
mode = TRAVERSE_MODE_NORMAL;
} else
mode = TRAVERSE_MODE_NORMAL;
} else if (mode == TRAVERSE_MODE_LONGINT)
mode = TRAVERSE_MODE_LONGINT_END;
} else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING)
mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
else if (mode == TRAVERSE_MODE_DOUBLE)
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
mode = TRAVERSE_MODE_DOUBLE2;
@ -555,12 +565,16 @@ static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) {
mode = TRAVERSE_MODE_DOUBLE;
else if (f == FunctorLongInt)
mode = TRAVERSE_MODE_LONGINT;
else if (f == FunctorBigInt || f == FunctorString)
mode = TRAVERSE_MODE_BIGINT_OR_STRING;
else
mode = TRAVERSE_MODE_NORMAL;
} else
mode = TRAVERSE_MODE_NORMAL;
} else if (mode == TRAVERSE_MODE_LONGINT)
mode = TRAVERSE_MODE_LONGINT_END;
} else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING)
mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
else if (mode == TRAVERSE_MODE_DOUBLE)
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
mode = TRAVERSE_MODE_DOUBLE2;
@ -898,6 +912,15 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int
mode = TRAVERSE_MODE_LONGINT_END;
} else if (mode == TRAVERSE_MODE_LONGINT_END) {
mode = TRAVERSE_MODE_NORMAL;
} else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
str_index += Yap_OpaqueTermToString(AbsAppl((CELL *)t), str+str_index, 0);
traverse_update_arity(str, &str_index, arity);
if (type == TRAVERSE_TYPE_SUBGOAL)
mode = TRAVERSE_MODE_NORMAL;
else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || TRAVERSE_TYPE_GT_ANSWER */
mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
} else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING_END) {
mode = TRAVERSE_MODE_NORMAL;
} else if (IsVarTerm(t)) {
if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
TrStat_gt_refs++;
@ -950,6 +973,8 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int
mode = TRAVERSE_MODE_DOUBLE;
} else if (f == FunctorLongInt) {
mode = TRAVERSE_MODE_LONGINT;
} else if (f == FunctorBigInt || f == FunctorString) {
mode = TRAVERSE_MODE_BIGINT_OR_STRING;
} else if (f == FunctorComma) {
if (arity[arity[0]] != -3) {
str_index += sprintf(& str[str_index], "(");
@ -1369,20 +1394,26 @@ void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) {
child_mode = TRAVERSE_MODE_DOUBLE;
else if (f == FunctorLongInt)
child_mode = TRAVERSE_MODE_LONGINT;
else if (f == FunctorBigInt || f == FunctorString)
child_mode = TRAVERSE_MODE_BIGINT_OR_STRING;
else
child_mode = TRAVERSE_MODE_NORMAL;
} else
child_mode = TRAVERSE_MODE_NORMAL;
} else if (mode == TRAVERSE_MODE_LONGINT)
} else if (mode == TRAVERSE_MODE_LONGINT) {
child_mode = TRAVERSE_MODE_LONGINT_END;
else if (mode == TRAVERSE_MODE_DOUBLE)
} else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
Yap_FreeCodeSpace((char *)TrNode_entry(current_node));
child_mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
} else if (mode == TRAVERSE_MODE_DOUBLE) {
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
child_mode = TRAVERSE_MODE_DOUBLE2;
else if (mode == TRAVERSE_MODE_DOUBLE2)
} else if (mode == TRAVERSE_MODE_DOUBLE2) {
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
child_mode = TRAVERSE_MODE_DOUBLE_END;
else
} else {
child_mode = TRAVERSE_MODE_NORMAL;
}
free_subgoal_trie(TrNode_child(current_node), child_mode, TRAVERSE_POSITION_FIRST);
} else {
sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(current_node PASS_REGS);
@ -1461,20 +1492,26 @@ void free_answer_trie(ans_node_ptr current_node, int mode, int position) {
child_mode = TRAVERSE_MODE_DOUBLE;
else if (f == FunctorLongInt)
child_mode = TRAVERSE_MODE_LONGINT;
else if (f == FunctorBigInt || f == FunctorString)
child_mode = TRAVERSE_MODE_BIGINT_OR_STRING;
else
child_mode = TRAVERSE_MODE_NORMAL;
} else
child_mode = TRAVERSE_MODE_NORMAL;
} else if (mode == TRAVERSE_MODE_LONGINT)
} else if (mode == TRAVERSE_MODE_LONGINT) {
child_mode = TRAVERSE_MODE_LONGINT_END;
else if (mode == TRAVERSE_MODE_DOUBLE)
} else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
Yap_FreeCodeSpace((char *)TrNode_entry(current_node));
child_mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
} else if (mode == TRAVERSE_MODE_DOUBLE) {
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
child_mode = TRAVERSE_MODE_DOUBLE2;
else if (mode == TRAVERSE_MODE_DOUBLE2)
} else if (mode == TRAVERSE_MODE_DOUBLE2) {
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
child_mode = TRAVERSE_MODE_DOUBLE_END;
else
} else {
child_mode = TRAVERSE_MODE_NORMAL;
}
free_answer_trie(TrNode_child(current_node), child_mode, TRAVERSE_POSITION_FIRST);
}
if (position == TRAVERSE_POSITION_FIRST) {

View File

@ -1160,10 +1160,15 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c
#ifdef MODE_GLOBAL_TRIE_LOOP
SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f));
#endif /* MODE_GLOBAL_TRIE_LOOP */
} else if (f == FunctorBigInt || f == FunctorString) {
CELL *new = Yap_HeapStoreOpaqueTerm(t);
SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f));
SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, (CELL)new);
#ifdef MODE_GLOBAL_TRIE_LOOP
SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f));
#endif /* MODE_GLOBAL_TRIE_LOOP */
} else if (f == FunctorDBRef) {
Yap_Error(INTERNAL_ERROR, TermNil, "subgoal_search_loop: unsupported type tag FunctorDBRef");
} else if (f == FunctorBigInt) {
Yap_Error(INTERNAL_ERROR, TermNil, "subgoal_search_loop: unsupported type tag FunctorBigInt");
} else {
int i;
CELL *aux_appl = RepAppl(t);
@ -1374,10 +1379,13 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_pair);
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, li, _trie_retry_extension);
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_longint);
} else if (f == FunctorBigInt || FunctorString) {
CELL *opq = Yap_HeapStoreOpaqueTerm(t);
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_pair);
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, (CELL)opq, _trie_retry_extension);
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_bigint);
} else if (f == FunctorDBRef) {
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_loop: unsupported type tag FunctorDBRef");
} else if (f == FunctorBigInt) {
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_loop: unsupported type tag FunctorBigInt");
} else {
int i;
CELL *aux_appl = RepAppl(t);
@ -1416,18 +1424,19 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int mode USES_REGS) {
ans_node_ptr child_node;
Term child_term;
Float trie_value = 0, term_value = 0;
Term trie_value = 0, term_value = t;
int cmp;
/* start by computing the current value on the trie (trie_value) */
child_node = TrNode_child(current_node);
child_term = TrNode_entry(child_node);
if (IsIntTerm(child_term)) {
trie_value = (Float) IntOfTerm(child_term);
trie_value = child_term;
} else if (IsApplTerm(child_term)) {
Functor f = (Functor) RepAppl(child_term);
child_node = TrNode_child(child_node);
if (f == FunctorLongInt) {
trie_value = (Float) TrNode_entry(child_node);
trie_value = MkLongIntTerm( (Int) TrNode_entry(child_node) );
} else if (f == FunctorDouble) {
union {
Term t_dbl[sizeof(Float)/sizeof(Term)];
@ -1438,30 +1447,20 @@ static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr c
child_node = TrNode_child(child_node);
u.t_dbl[1] = TrNode_entry(child_node);
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
trie_value = u.dbl;
trie_value = MkFloatTerm(u.dbl);
} else if (f == FunctorBigInt) {
trie_value = AbsAppl( (CELL *) TrNode_entry(child_node) );
} else
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_min_max: invalid arithmetic value");
child_node = TrNode_child(child_node);
}
/* then compute the value for the new term (term_value) */
if (IsAtomOrIntTerm(t))
term_value = (Float) IntOfTerm(t);
else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorLongInt)
term_value = (Float) LongIntOfTerm(t);
else if (f == FunctorDouble)
term_value = FloatOfTerm(t);
else
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_min_max: invalid arithmetic value");
}
cmp = Yap_acmp( term_value, trie_value PASS_REGS);
/* worse answer */
if ((mode == MODE_DIRECTED_MIN && term_value > trie_value) || (mode == MODE_DIRECTED_MAX && term_value < trie_value))
if ((mode == MODE_DIRECTED_MIN && cmp > 0) || (mode == MODE_DIRECTED_MAX && cmp < 0))
return NULL;
/* equal answer */
if (term_value == trie_value)
if (cmp == 0)
return child_node;
/* better answer */
if (IsAtomOrIntTerm(t)) {
@ -1485,6 +1484,11 @@ static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr c
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_null);
ANSWER_SAFE_INSERT_ENTRY(current_node, li, _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_longint);
} else if (f == FunctorBigInt) {
CELL *li = Yap_HeapStoreOpaqueTerm(t);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_null);
ANSWER_SAFE_INSERT_ENTRY(current_node, (CELL)li, _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_bigint);
}
}
return current_node;
@ -1501,19 +1505,18 @@ static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr c
static inline ans_node_ptr answer_search_sum(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t USES_REGS) {
ans_node_ptr child_node;
Term child_term;
Float trie_value = 0, term_value = 0, sum_value = 0;
int sum_value_as_int;
Term trie_value = 0, term_value = t, sum_value = 0;
/* start by computing the current value on the trie (trie_value) */
child_node = TrNode_child(current_node);
child_term = TrNode_entry(child_node);
if (IsIntTerm(child_term)) {
trie_value = (Float) IntOfTerm(child_term);
trie_value = child_term;
} else if (IsApplTerm(child_term)) {
Functor f = (Functor) RepAppl(child_term);
child_node = TrNode_child(child_node);
if (f == FunctorLongInt) {
trie_value = (Float) TrNode_entry(child_node);
trie_value = MkLongIntTerm( (Int) TrNode_entry(child_node) );
} else if (f == FunctorDouble) {
union {
Term t_dbl[sizeof(Float)/sizeof(Term)];
@ -1524,41 +1527,43 @@ static inline ans_node_ptr answer_search_sum(sg_fr_ptr sg_fr, ans_node_ptr curre
child_node = TrNode_child(child_node);
u.t_dbl[1] = TrNode_entry(child_node);
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
trie_value = u.dbl;
trie_value = MkFloatTerm(u.dbl);
} else if (f == FunctorBigInt) {
trie_value = AbsAppl( (CELL *) TrNode_entry(child_node) );
} else
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_sum: invalid arithmetic value");
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_min_max: invalid arithmetic value");
child_node = TrNode_child(child_node);
}
/* then compute the value for the new term (term_value) */
if (IsAtomOrIntTerm(t))
term_value = (Float) IntOfTerm(t);
else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorLongInt)
term_value = (Float) LongIntOfTerm(t);
else if (f == FunctorDouble)
term_value = FloatOfTerm(t);
else
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_sum: invalid arithmetic value");
}
sum_value = trie_value + term_value;
sum_value_as_int = (int) sum_value;
if (sum_value == (float) sum_value_as_int && IntInBnd(sum_value_as_int)) {
ANSWER_SAFE_INSERT_ENTRY(current_node, MkIntegerTerm(sum_value_as_int), _trie_retry_atom);
} else {
union {
Term t_dbl[sizeof(Float)/sizeof(Term)];
Float dbl;
} u;
u.dbl = sum_value;
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)FunctorDouble), _trie_retry_null);
sum_value = p_plus(trie_value, term_value PASS_REGS);
if (IsAtomOrIntTerm(sum_value)) {
ANSWER_SAFE_INSERT_ENTRY(current_node, sum_value, _trie_retry_atom);
} else if (IsApplTerm(sum_value)) {
Functor f = FunctorOfTerm(sum_value);
if (f == FunctorDouble) {
union {
Term t_dbl[sizeof(Float)/sizeof(Term)];
Float dbl;
} u;
u.dbl = FloatOfTerm(sum_value);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_null);
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
ANSWER_SAFE_INSERT_ENTRY(current_node, u.t_dbl[1], _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, u.t_dbl[1], _trie_retry_extension);
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
ANSWER_SAFE_INSERT_ENTRY(current_node, u.t_dbl[0], _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)FunctorDouble), _trie_retry_double);
}
ANSWER_SAFE_INSERT_ENTRY(current_node, u.t_dbl[0], _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_double);
} else if (f == FunctorLongInt) {
Int li = LongIntOfTerm(sum_value);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_null);
ANSWER_SAFE_INSERT_ENTRY(current_node, li, _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_longint);
} else if (f == FunctorBigInt) {
CELL *li = Yap_HeapStoreOpaqueTerm(sum_value);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_null);
ANSWER_SAFE_INSERT_ENTRY(current_node, (CELL)li, _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)f), _trie_retry_bigint);
}
}
return current_node;
}
#endif /* INCLUDE_ANSWER_SEARCH_MODE_DIRECTED */
@ -1757,6 +1762,11 @@ static inline CELL *load_answer_loop(ans_node_ptr current_node USES_REGS) {
current_node = TrNode_parent(current_node);
current_node = TrNode_parent(current_node);
t = MkLongIntTerm(li);
} else if (f == FunctorBigInt || f == FunctorString) {
CELL *ptr = (CELL *)TrNode_entry(current_node);
current_node = TrNode_parent(current_node);
current_node = TrNode_parent(current_node);
t = AbsAppl( ptr );
} else {
int f_arity = ArityOfFunctor(f);
t = Yap_MkApplTerm(f, f_arity, stack_terms);

View File

@ -1149,6 +1149,37 @@
ENDBOp();
PBOp(trie_do_bigint, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_stack = TOP_STACK;
int heap_arity = aux_stack[HEAP_ARITY_ENTRY];
int vars_arity = aux_stack[VARS_ARITY_ENTRY];
int subs_arity = aux_stack[SUBS_ARITY_ENTRY];
Term t = AbsAppl((CELL*)aux_stack[HEAP_ENTRY(1)]);
heap_arity -= 2;
TOP_STACK = aux_stack = &aux_stack[2]; /* jump until the extension mark */
TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity;
aux_stack_term_instr();
ENDPBOp();
BOp(trie_trust_bigint, e)
Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_bigint: invalid instruction");
ENDBOp();
BOp(trie_try_bigint, e)
Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_bigint: invalid instruction");
ENDBOp();
BOp(trie_retry_bigint, e)
Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_bigint: invalid instruction");
ENDBOp();
PBOp(trie_do_gterm, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_stack = TOP_STACK;

@ -1 +1 @@
Subproject commit 5a72fe49e5a5c651a890a388eb967b83da8e2c52
Subproject commit a383bfd51144172fdea8463bd56e9308742e5de2