From fd9f4efe0bbddbe34b42d7cd5015845eba3f97b9 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 14 May 2010 12:42:30 +0100 Subject: [PATCH 1/4] fix indexing of bignums (obs from Jos de Roo). --- C/absmi.c | 8 +--- C/index.c | 105 +++++++++++------------------------------------ C/tracer.c | 5 ++- H/TermExt.h | 38 +++++++++++++++++ H/findclause.h | 8 +++- H/headclause.h | 8 +++- changes-6.0.html | 2 + misc/buildops | 2 +- 8 files changed, 83 insertions(+), 93 deletions(-) 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/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: