diff --git a/C/absmi.c b/C/absmi.c index d74874607..2ff799d31 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -9012,17 +9012,13 @@ Yap_absmi(int inp) Op(index_blob, e); PREG = NEXTOP(PREG, e); -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - I_R = MkIntTerm(SREG[0]^SREG[1]); -#else - I_R = MkIntTerm(SREG[0]); -#endif + I_R = Yap_DoubleP_key(SREG); GONext(); ENDOp(); Op(index_long, e); PREG = NEXTOP(PREG, e); - I_R = MkIntTerm(SREG[0] & (MAX_ABS_INT-1)); + I_R = Yap_IntP_key(SREG); GONext(); ENDOp(); diff --git a/C/index.c b/C/index.c index a8c22f4aa..06ac8e3e9 100644 --- a/C/index.c +++ b/C/index.c @@ -1802,14 +1802,11 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno) case _unify_bigint: case _unify_l_bigint: if (argno == 1) { -#ifdef USE_GMP clause->Tag = AbsAppl((CELL *)FunctorBigInt); -#else - clause->Tag = AbsAppl((CELL *)FunctorLongInt); -#endif clause->u.t_ptr = cl->u.oc.c; return; } + cl = NEXTOP(cl,oc); argno--; break; case _unify_n_atoms: @@ -2714,7 +2711,7 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs if (IsExtensionFunctor(f)) { if (f == FunctorDBRef) ifs->u.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first, clleft, top); - else if (f == FunctorLongInt) + else if (f == FunctorLongInt || f == FunctorBigInt) ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, FALSE); else ifs->u.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first, clleft, top, TRUE); @@ -3238,15 +3235,9 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t, struct intermediates *cint if (cl->u.t_ptr == (CELL)NULL) { /* check whether it is a builtin */ cl->Tag = Zero; } else if (blob) { - CELL *pt = RepAppl(cl->u.t_ptr); -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - cl->Tag = MkIntTerm(pt[1]^pt[2]); -#else - cl->Tag = MkIntTerm(pt[1]); -#endif + cl->Tag = Yap_Double_key(cl->u.t_ptr); } else { - CELL *pt = RepAppl(cl->u.t_ptr); - cl->Tag = MkIntTerm((pt[1] & (MAX_ABS_INT-1))); + cl->Tag = Yap_Int_key(cl->u.t_ptr); } cl++; } @@ -3498,24 +3489,13 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack) if (f == FunctorDBRef) { if (cls->u.t_ptr != sp->extra) break; } else if (f == FunctorDouble) { - CELL *pt = RepAppl(sp->extra); - if (cls->u.t_ptr) { - CELL *pt1 = RepAppl(cls->u.t_ptr); -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - Term t = MkIntTerm(pt[1]^pt[2]), - t1 = MkIntTerm(pt1[1]^pt1[2]); -#else - Term t = MkIntTerm(pt[1]), - t1 = MkIntTerm(pt1[1]); -#endif - if (t != t1) break; - } + if (cls->u.t_ptr && + Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr)) + break; } else { - CELL *pt = RepAppl(sp->extra); - CELL *pt1 = RepAppl(cls->u.t_ptr); - Term t = MkIntTerm(pt[1] & (MAX_ABS_INT-1)), - t1 = MkIntTerm(pt1[1] & (MAX_ABS_INT-1)); - if (t != t1) break; + if (cls->u.t_ptr && + Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr)) + break; } } } @@ -3662,22 +3642,13 @@ install_log_upd_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack) if (f == FunctorDBRef) { if (cls->u.t_ptr != sp->extra) break; } else if (f == FunctorDouble) { - CELL *pt = RepAppl(sp->extra); - CELL *pt1 = RepAppl(cls->u.t_ptr); -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - Term t = MkIntTerm(pt[1]^pt[2]), - t1 = MkIntTerm(pt1[1]^pt1[2]); -#else - Term t = MkIntTerm(pt[1]), - t1 = MkIntTerm(pt1[1]); -#endif - if (t != t1) break; + if (cls->u.t_ptr && + Yap_Double_key(sp->extra) != Yap_Double_key(cls->u.t_ptr)) + break; } else { - CELL *pt = RepAppl(sp->extra); - CELL *pt1 = RepAppl(cls->u.t_ptr); - Term t = MkIntTerm(pt[1] & (MAX_ABS_INT-1)), - t1 = MkIntTerm(pt1[1] & (MAX_ABS_INT-1)); - if (t != t1) break; + if (cls->u.t_ptr && + Yap_Int_key(sp->extra) != Yap_Int_key(cls->u.t_ptr)) + break; } } } @@ -4109,17 +4080,13 @@ expand_index(struct intermediates *cint) { ipc = NEXTOP(ipc,e); break; case _index_blob: -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - t = MkIntTerm(s_reg[0]^s_reg[1]); -#else - t = MkIntTerm(s_reg[0]); -#endif + t = Yap_DoubleP_key(s_reg); sp[-1].extra = AbsAppl(s_reg-1); s_reg = NULL; ipc = NEXTOP(ipc,e); break; case _index_long: - t = MkIntTerm((s_reg[0] & (MAX_ABS_INT-1))); + t = Yap_IntP_key(s_reg); sp[-1].extra = AbsAppl(s_reg-1); s_reg = NULL; ipc = NEXTOP(ipc,e); @@ -5935,21 +5902,11 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause ipc = NEXTOP(ipc,e); break; case _index_blob: - { - CELL *pt = RepAppl(cls->u.t_ptr); -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - cls->Tag = MkIntTerm(pt[1]^pt[2]); -#else - cls->Tag = MkIntTerm(pt[1]); -#endif - } + cls->Tag = Yap_Double_key(cls->u.t_ptr); ipc = NEXTOP(ipc,e); break; case _index_long: - { - CELL *pt = RepAppl(cls->u.t_ptr); - cls->Tag = MkIntTerm((pt[1] & (MAX_ABS_INT-1))); - } + cls->Tag = Yap_Int_key(cls->u.t_ptr); ipc = NEXTOP(ipc,e); break; case _switch_on_cons: @@ -6436,21 +6393,11 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg ipc = NEXTOP(ipc,e); break; case _index_blob: - { - CELL *pt = RepAppl(cls->u.t_ptr); -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - cls->Tag = MkIntTerm(pt[1]^pt[2]); -#else - cls->Tag = MkIntTerm(pt[1]); -#endif - } + cls->Tag = Yap_Double_key(cls->u.t_ptr); ipc = NEXTOP(ipc,e); break; case _index_long: - { - CELL *pt = RepAppl(cls->u.t_ptr); - cls->Tag = MkIntTerm(pt[1] & (MAX_ABS_INT-1)); - } + cls->Tag = Yap_Int_key(cls->u.t_ptr); ipc = NEXTOP(ipc,e); break; case _switch_on_cons: @@ -7109,15 +7056,11 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y ipc = NEXTOP(ipc,e); break; case _index_blob: -#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT - t = MkIntTerm(s_reg[0]^s_reg[1]); -#else - t = MkIntTerm(s_reg[0]); -#endif + t = Yap_DoubleP_key(s_reg); ipc = NEXTOP(ipc,e); break; case _index_long: - t = MkIntTerm(s_reg[0] & (MAX_ABS_INT-1)); + t = Yap_IntP_key(s_reg); ipc = NEXTOP(ipc,e); break; case _switch_on_cons: diff --git a/C/tracer.c b/C/tracer.c index 1ecc94bc8..b3100145d 100755 --- a/C/tracer.c +++ b/C/tracer.c @@ -172,7 +172,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) LOCK(Yap_heap_regs->low_level_trace_lock); sc = Yap_heap_regs; vsc_count++; - #ifdef THREADS + if (vsc_count == 7188) jmp_deb(1); + if (vsc_count < 7000) + return; +#ifdef THREADS MY_ThreadHandle.thread_inst_count++; #endif #ifdef COMMENTED diff --git a/H/TermExt.h b/H/TermExt.h index 55359db18..a7e311c92 100644 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -551,3 +551,41 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1) } return (FALSE); } + +static inline +CELL Yap_IntP_key(CELL *pt) +{ +#ifdef USE_GMP + if (((Functor)pt[-1] == FunctorBigInt)) { + MP_INT *b1 = Yap_BigIntOfTerm(AbsAppl(pt-1)); + /* first cell in program */ + CELL val = ((CELL *)(b1+1))[0]; + return MkIntTerm(val & (MAX_ABS_INT-1)); + } +#endif + return MkIntTerm(pt[0] & (MAX_ABS_INT-1)); +} + +static inline +CELL Yap_Int_key(Term t) +{ + return Yap_IntP_key(RepAppl(t)+1); +} + +static inline +CELL Yap_DoubleP_key(CELL *pt) +{ +#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT + CELL val = pt[0]^pt[1]; +#else + CELL val = pt[0]; +#endif + return MkIntTerm(val & (MAX_ABS_INT-1)); +} + +static inline +CELL Yap_Double_key(Term t) +{ + return Yap_DoubleP_key(RepAppl(t)+1); +} + diff --git a/H/findclause.h b/H/findclause.h index 34b33e6b7..c24138c07 100644 --- a/H/findclause.h +++ b/H/findclause.h @@ -670,8 +670,12 @@ break; case _get_bigint: if (is_regcopy(myregs, nofregs, cl->u.xc.x)) { - clause->Tag = AbsAppl((CELL *)FunctorBigInt); - clause->u.t_ptr = (CELL)NULL; + if (IsApplTerm(cl->u.xc.c)) { + CELL *pt = RepAppl(cl->u.xc.c); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.xc.c; + } else + clause->Tag = cl->u.xc.c; return; } cl = NEXTOP(cl,xc); diff --git a/H/headclause.h b/H/headclause.h index 44242c83b..9cb93cd98 100644 --- a/H/headclause.h +++ b/H/headclause.h @@ -567,8 +567,12 @@ break; case _get_bigint: if (iarg == cl->u.xc.x) { - clause->Tag = AbsAppl((CELL *)FunctorBigInt); - clause->u.t_ptr = (CELL)NULL; + if (IsApplTerm(cl->u.xc.c)) { + CELL *pt = RepAppl(cl->u.xc.c); + clause->Tag = AbsAppl((CELL *)pt[0]); + clause->u.t_ptr = cl->u.xc.c; + } else + clause->Tag = cl->u.xc.c; return; } cl = NEXTOP(cl,xc); diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index 6ecdc0622..85d133e68 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -37,7 +37,9 @@ #ifdef TABLING static Int p_freeze_choice_point(void); static Int p_wake_choice_point(void); -static Int p_abolish_all_frozen_choice_points(void); +static Int p_reset_frozen_choice_points(void); +static Int p_abolish_frozen_choice_points_until(void); +static Int p_abolish_frozen_choice_points_all(void); static Int p_table(void); static Int p_tabling_mode(void); static Int p_abolish_table(void); @@ -122,7 +124,8 @@ void Yap_init_optyap_preds(void) { #ifdef TABLING Yap_InitCPred("freeze_choice_point", 1, p_freeze_choice_point, SafePredFlag|SyncPredFlag); Yap_InitCPred("wake_choice_point", 1, p_wake_choice_point, SafePredFlag|SyncPredFlag); - Yap_InitCPred("abolish_all_frozen_choice_points", 0, p_abolish_all_frozen_choice_points, SafePredFlag|SyncPredFlag); + Yap_InitCPred("abolish_frozen_choice_points", 1, p_abolish_frozen_choice_points_until, SafePredFlag|SyncPredFlag); + Yap_InitCPred("abolish_frozen_choice_points", 0, p_abolish_frozen_choice_points_all, SafePredFlag|SyncPredFlag); Yap_InitCPred("$c_table", 2, p_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$c_tabling_mode", 3, p_tabling_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$c_abolish_table", 2, p_abolish_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); @@ -170,32 +173,32 @@ void finish_yapor(void) { #ifdef TABLING static Int p_freeze_choice_point(void) { - Term term_arg, term_cp; - - term_arg = Deref(ARG1); - if (IsVarTerm(term_arg)) { - choiceptr cp = freeze_current_cp(); - term_cp = MkIntegerTerm((Int) cp); - return Yap_unify(ARG1, term_cp); + if (IsVarTerm(Deref(ARG1))) { + Int offset = freeze_current_cp(); + return Yap_unify(ARG1, MkIntegerTerm(offset)); } return (FALSE); } static Int p_wake_choice_point(void) { - Term term_arg; - - term_arg = Deref(ARG1); - if (IsIntegerTerm(term_arg)) { - choiceptr cp = (choiceptr) IntegerOfTerm(term_arg); - resume_frozen_cp(cp); - } + Term term_offset = Deref(ARG1); + if (IsIntegerTerm(term_offset)) + wake_frozen_cp(IntegerOfTerm(term_offset)); return (FALSE); } -static Int p_abolish_all_frozen_choice_points(void) { - abolish_all_frozen_cps(); +static Int p_abolish_frozen_choice_points_until(void) { + Term term_offset = Deref(ARG1); + if (IsIntegerTerm(term_offset)) + abolish_frozen_cps_until(IntegerOfTerm(term_offset)); + return (TRUE); +} + + +static Int p_abolish_frozen_choice_points_all(void) { + abolish_frozen_cps_all(); return (TRUE); } diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h old mode 100755 new mode 100644 index 740ff28f9..4038d26ba --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -21,9 +21,10 @@ #endif /* HAVE_STRING_H */ #include "opt.mavar.h" -static inline choiceptr freeze_current_cp(void); -static inline void resume_frozen_cp(choiceptr); -static inline void abolish_all_frozen_cps(void); +static inline Int freeze_current_cp(void); +static inline void wake_frozen_cp(Int); +static inline void abolish_frozen_cps_until(Int); +static inline void abolish_frozen_cps_all(void); static inline void adjust_freeze_registers(void); static inline void mark_as_completed(sg_fr_ptr); static inline void unbind_variables(tr_fr_ptr, tr_fr_ptr); @@ -421,7 +422,7 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int); ** Inline funcions ** ******************************/ -static inline choiceptr freeze_current_cp(void) { +static inline Int freeze_current_cp(void) { choiceptr freeze_cp = B; B_FZ = freeze_cp; @@ -429,11 +430,13 @@ static inline choiceptr freeze_current_cp(void) { TR_FZ = freeze_cp->cp_tr; B = B->cp_b; HB = B->cp_h; - return freeze_cp; + return (Yap_LocalBase - (ADDR)freeze_cp); } -static inline void resume_frozen_cp(choiceptr frozen_cp) { +static inline void wake_frozen_cp(Int frozen_offset) { + choiceptr frozen_cp = (choiceptr)(Yap_LocalBase - frozen_offset); + restore_bindings(TR, frozen_cp->cp_tr); B = frozen_cp; TR = TR_FZ; @@ -442,7 +445,17 @@ static inline void resume_frozen_cp(choiceptr frozen_cp) { } -static inline void abolish_all_frozen_cps(void) { +static inline void abolish_frozen_cps_until(Int frozen_offset) { + choiceptr frozen_cp = (choiceptr)(Yap_LocalBase - frozen_offset); + + B_FZ = frozen_cp; + H_FZ = frozen_cp->cp_h; + TR_FZ = frozen_cp->cp_tr; + return; +} + + +static inline void abolish_frozen_cps_all(void) { B_FZ = (choiceptr) Yap_LocalBase; H_FZ = (CELL *) Yap_GlobalBase; TR_FZ = (tr_fr_ptr) Yap_TrailBase; diff --git a/changes-6.0.html b/changes-6.0.html index 32736b02d..4ce5d6679 100644 --- a/changes-6.0.html +++ b/changes-6.0.html @@ -17,6 +17,8 @@

Yap-6.0.6: