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

fix indexing of bignums (obs from Jos de Roo).

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-05-14 12:42:30 +01:00
parent c2f84c9e28
commit fd9f4efe0b
8 changed files with 83 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/absmi.c
View File

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

105
C/index.c
View File

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

5
C/tracer.c
View File

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

38
H/TermExt.h
View File

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

8
H/findclause.h
View File

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

8
H/headclause.h
View File

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

2
changes-6.0.html
View File

@ -17,6 +17,8 @@
<h2>Yap-6.0.6:</h2>
<ul>
<li> FIXED: fix problems in indexing compiled bignums (obs from Jos de
Roo), center hash computing code in TermExt.h.</li>
<li> FIXED: similar problem in unify_dbterm.</li>
<li> FIXED: bug in implementation of unify_bigint instruction (obs
from Jos de Roo).</li>

2
misc/buildops
View File

@ -850,7 +850,7 @@ opinfo("gl_void_vary",[bind("y","AbsPair(NULL)",workpc=currentop),new("y")]).
opinfo("get_struct",[bind("x","AbsAppl((CELL *)cl->u.xfa.f)",workpc=nextop)]).
opinfo("get_float",[bind("x","AbsAppl((CELL *)FunctorDouble)",t_ptr="d")]).
opinfo("get_longint",[bind("x","AbsAppl((CELL *)FunctorLongInt)",t_ptr="i")]).
opinfo("get_bigint",[bind("x","AbsAppl((CELL *)FunctorBigInt)",t_ptr=[])]).
opinfo("get_bigint",[bind("x","c",[])]).
opinfo("copy_idb_term",[logical]).
opinfo("unify_idb_term",[logical]).
opinfo("put_atom",[new("x")]).