diff --git a/C/bignum.c b/C/bignum.c index a7ec93ae9..5e5d5eb6b 100644 --- a/C/bignum.c +++ b/C/bignum.c @@ -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 ) { diff --git a/C/c_interface.c b/C/c_interface.c index dabd21bd8..e284ad63c 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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) { diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 00debc6f2..2300d8248 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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), diff --git a/H/Yapproto.h b/H/Yapproto.h index 4fce035c4..83c43e568 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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); diff --git a/H/arith2.h b/H/arith2.h index 9a996a4a5..7d6160a47 100755 --- a/H/arith2.h +++ b/H/arith2.h @@ -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)) { diff --git a/H/eval.h b/H/eval.h index 0d5716e3e..8a2c38c36 100644 --- a/H/eval.h +++ b/H/eval.h @@ -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(); +} + diff --git a/H/rclause.h b/H/rclause.h index 4c3fa1d58..156addb24 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -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: diff --git a/H/saveclause.h b/H/saveclause.h index 11deec448..e826eec14 100644 --- a/H/saveclause.h +++ b/H/saveclause.h @@ -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: diff --git a/H/walkclause.h b/H/walkclause.h index 65b1f19bd..53b829e76 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -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: diff --git a/OPTYap/or.sba_unify.h b/OPTYap/or.sba_unify.h index d5d640596..de385c6cc 100644 --- a/OPTYap/or.sba_unify.h +++ b/OPTYap/or.sba_unify.h @@ -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); } diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index 8cee55523..39b2397a0 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -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 diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index d42a99b6f..a4c5262f0 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -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) { diff --git a/OPTYap/tab.tries.i b/OPTYap/tab.tries.i index a02984888..1ba46271c 100644 --- a/OPTYap/tab.tries.i +++ b/OPTYap/tab.tries.i @@ -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); diff --git a/OPTYap/tab.tries.insts.i b/OPTYap/tab.tries.insts.i index 63f0dad9d..9de066353 100644 --- a/OPTYap/tab.tries.insts.i +++ b/OPTYap/tab.tries.insts.i @@ -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; diff --git a/packages/real b/packages/real index 5a72fe49e..a383bfd51 160000 --- a/packages/real +++ b/packages/real @@ -1 +1 @@ -Subproject commit 5a72fe49e5a5c651a890a388eb967b83da8e2c52 +Subproject commit a383bfd51144172fdea8463bd56e9308742e5de2