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

fix restore of instructions that manipulate bigints or db terms.

This commit is contained in:
Vítor Santos Costa 2010-12-16 20:39:53 +00:00
parent a442d888de
commit 5a2d908489
12 changed files with 161 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
C/absmi.c
View File

@ -4261,17 +4261,17 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(get_bigint, xc);
Op(get_bigint, xB);
#ifdef USE_GMP
BEGD(d0);
d0 = XREG(PREG->u.xc.x);
d0 = XREG(PREG->u.xB.x);
deref_head(d0, gbigint_unk);
gbigint_nonvar:
if (!IsApplTerm(d0))
FAIL();
/* we have met a preexisting bigint */
START_PREFETCH(xc);
START_PREFETCH(xB);
BEGP(pt0);
pt0 = RepAppl(d0);
/* check functor */
@ -4279,9 +4279,9 @@ Yap_absmi(int inp)
{
FAIL();
}
if (Yap_gmp_tcmp_big_big(d0,PREG->u.xc.c))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.xB.b))
FAIL();
PREG = NEXTOP(PREG, xc);
PREG = NEXTOP(PREG, xB);
ENDP(pt0);
/* enter read mode */
GONext();
@ -4291,10 +4291,10 @@ Yap_absmi(int inp)
deref_body(d0, pt0, gbigint_unk, gbigint_nonvar);
/* Enter Write mode */
/* set d1 to be the new structure we are going to create */
START_PREFETCH(xc);
START_PREFETCH(xB);
BEGD(d1);
d1 = PREG->u.xc.c;
PREG = NEXTOP(PREG, xc);
d1 = PREG->u.xB.b;
PREG = NEXTOP(PREG, xB);
BIND(pt0, d1, bind_gbigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -4313,16 +4313,16 @@ Yap_absmi(int inp)
ENDOp();
Op(get_dbterm, xc);
Op(get_dbterm, xD);
BEGD(d0);
d0 = XREG(PREG->u.xc.x);
d0 = XREG(PREG->u.xD.x);
deref_head(d0, gdbterm_unk);
gdbterm_nonvar:
BEGD(d1);
/* we have met a preexisting dbterm */
d1 = PREG->u.xc.c;
PREG = NEXTOP(PREG, xc);
d1 = PREG->u.xD.D;
PREG = NEXTOP(PREG, xD);
UnifyBound(d0,d1);
ENDD(d1);
@ -4330,10 +4330,10 @@ Yap_absmi(int inp)
deref_body(d0, pt0, gdbterm_unk, gdbterm_nonvar);
/* Enter Write mode */
/* set d1 to be the new structure we are going to create */
START_PREFETCH(xc);
START_PREFETCH(xD);
BEGD(d1);
d1 = PREG->u.xc.c;
PREG = NEXTOP(PREG, xc);
d1 = PREG->u.xD.D;
PREG = NEXTOP(PREG, xD);
BIND(pt0, d1, bind_gdbterm);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6347,7 +6347,7 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(unify_bigint, oc);
Op(unify_bigint, oB);
#ifdef USE_GMP
BEGD(d0);
BEGP(pt0);
@ -6368,16 +6368,16 @@ Yap_absmi(int inp)
FAIL();
}
ENDD(d1);
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oc.c))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oB.b))
FAIL();
PREG = NEXTOP(PREG, oc);
PREG = NEXTOP(PREG, oB);
ENDP(pt0);
GONext();
derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oB.b;
PREG = NEXTOP(PREG, oB);
BIND_GLOBAL(pt0, d1, bind_ubigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6393,7 +6393,7 @@ Yap_absmi(int inp)
#endif
ENDOp();
Op(unify_l_bigint, oc);
Op(unify_l_bigint, oB);
#ifdef USE_GMP
BEGD(d0);
CACHE_S();
@ -6413,16 +6413,16 @@ Yap_absmi(int inp)
FAIL();
}
ENDD(d0);
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oc.c))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oB.b))
FAIL();
PREG = NEXTOP(PREG, oc);
PREG = NEXTOP(PREG, oB);
ENDP(pt0);
GONext();
derefa_body(d0, S_SREG, ulbigint_unk, ulbigint_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oB.b;
PREG = NEXTOP(PREG, oB);
BIND_GLOBAL(S_SREG, d1, bind_ulbigint);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
@ -6438,7 +6438,7 @@ Yap_absmi(int inp)
#endif
ENDOp();
Op(unify_dbterm, oc);
Op(unify_dbterm, oD);
BEGD(d0);
BEGP(pt0);
pt0 = SREG++;
@ -6447,15 +6447,15 @@ Yap_absmi(int inp)
udbterm_nonvar:
BEGD(d1);
/* we have met a preexisting dbterm */
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
UnifyBound(d0,d1);
ENDD(d1);
derefa_body(d0, pt0, udbterm_unk, udbterm_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
BIND_GLOBAL(pt0, d1, bind_udbterm);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6468,7 +6468,7 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(unify_l_dbterm, oc);
Op(unify_l_dbterm, oD);
BEGD(d0);
CACHE_S();
READ_IN_S();
@ -6477,15 +6477,15 @@ Yap_absmi(int inp)
uldbterm_nonvar:
BEGD(d1);
/* we have met a preexisting dbterm */
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
UnifyBound(d0,d1);
ENDD(d1);
derefa_body(d0, S_SREG, uldbterm_unk, uldbterm_nonvar);
BEGD(d1);
d1 = PREG->u.oc.c;
PREG = NEXTOP(PREG, oc);
d1 = PREG->u.oD.D;
PREG = NEXTOP(PREG, oD);
BIND_GLOBAL(S_SREG, d1, bind_uldbterm);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);

2
C/agc.c
View File

@ -161,7 +161,7 @@ CodeComposedTermAdjust(Term t)
#define ModEntryPtrAdjust(P) (P)
#define AtomEntryAdjust(P) (P)
#define GlobalEntryAdjust(P) (P)
#define BlobTermAdjust(P) (P)
#define BlobTermInCodeAdjust(P) (P)
#define CellPtoHeapAdjust(P) (P)
#define PtoAtomHashEntryAdjust(P) (P)
#define CellPtoHeapCellAdjust(P) (P)

16
C/cdmgr.c
View File

@ -771,8 +771,10 @@ get_pred(Term t, Term tmod, char *pname)
#define ModuleAdjust(X) (X)
#define ExternalFunctionAdjust(X) (X)
#define AdjustSwitchTable(X,Y,Z)
#define DBGroundTermAdjust(X) (X)
#define rehash(A,B,C)
static Term BlobTermAdjust(Term t)
static Term BlobTermInCodeAdjust(Term t)
{
#if TAGS_FAST_OPS
return t-ClDiff;
@ -781,22 +783,12 @@ static Term BlobTermAdjust(Term t)
#endif
}
static Term ConstantTermAdjust (Term);
static Term
ConstantTermAdjust (Term t)
{
if (IsAtomTerm(t))
return AtomTermAdjust(t);
else if (IsIntTerm(t))
return t;
else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
return BlobTermAdjust(t);
} else if (IsApplTerm(t) || IsPairTerm(t)) {
return CodeComposedTermAdjust(t);
} else {
return t;
}
return t;
}

12
H/YapOpcodes.h
View File

@ -67,8 +67,8 @@
OPCODE(get_struct ,xfa),
OPCODE(get_float ,xd),
OPCODE(get_longint ,xi),
OPCODE(get_bigint ,xc),
OPCODE(get_dbterm ,xc),
OPCODE(get_bigint ,xB),
OPCODE(get_dbterm ,xD),
OPCODE(glist_valx ,xx),
OPCODE(glist_valy ,yx),
OPCODE(gl_void_varx ,xx),
@ -125,10 +125,10 @@
OPCODE(unify_longint_write ,oi),
OPCODE(unify_l_longint ,oi),
OPCODE(unify_l_longint_write ,oi),
OPCODE(unify_bigint ,oc),
OPCODE(unify_l_bigint ,oc),
OPCODE(unify_dbterm ,oc),
OPCODE(unify_l_dbterm ,oc),
OPCODE(unify_bigint ,oB),
OPCODE(unify_l_bigint ,oB),
OPCODE(unify_dbterm ,oD),
OPCODE(unify_l_dbterm ,oD),
OPCODE(unify_list ,o),
OPCODE(unify_list_write ,o),
OPCODE(unify_l_list ,o),

21
H/amidefs.h
View File

@ -241,6 +241,7 @@ typedef enum {
The meaning and type of the symbols in a abstract machine instruction is:
b: arity (Int)
B: bigint, Blob (Term)
b: bitmap (CELL *)
c: constant, is a Term
d: double (functor + unaligned double)
@ -496,11 +497,21 @@ typedef struct yami {
Term c;
CELL next;
} oc;
struct {
OPCODE opcw;
Term b;
CELL next;
} oB;
struct {
OPCODE opcw;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
CELL next;
} od;
struct {
OPCODE opcw;
Term D;
CELL next;
} oD;
struct {
OPCODE opcw;
Functor f;
@ -705,11 +716,21 @@ typedef struct yami {
CELL c;
CELL next;
} xc;
struct {
wamreg x;
Term b;
CELL next;
} xB;
struct {
wamreg x;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
CELL next;
} xd;
struct {
wamreg x;
Term D;
CELL next;
} xD;
struct {
wamreg x;
Functor f;

39
H/findclause.h
View File

@ -316,30 +316,30 @@
case _unify_void_write:
cl = NEXTOP(cl,o);
break;
case _unify_bigint:
cl = NEXTOP(cl,oB);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oB);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_float:
cl = NEXTOP(cl,od);
break;
@ -656,19 +656,14 @@
}
cl = NEXTOP(cl,x);
break;
case _get_atom:
if (is_regcopy(myregs, nofregs, cl->u.xc.x)) {
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;
case _get_bigint:
if (is_regcopy(myregs, nofregs, cl->u.xB.x)) {
clause->Tag = cl->u.xB.b;
return;
}
cl = NEXTOP(cl,xc);
cl = NEXTOP(cl,xB);
break;
case _get_bigint:
case _get_atom:
if (is_regcopy(myregs, nofregs, cl->u.xc.x)) {
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);

39
H/headclause.h
View File

@ -291,30 +291,30 @@
case _unify_void_write:
cl = NEXTOP(cl,o);
break;
case _unify_bigint:
cl = NEXTOP(cl,oB);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oB);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oD);
break;
case _unify_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom:
cl = NEXTOP(cl,oc);
break;
case _unify_l_atom_write:
cl = NEXTOP(cl,oc);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oc);
break;
case _unify_l_dbterm:
cl = NEXTOP(cl,oc);
break;
case _unify_float:
cl = NEXTOP(cl,od);
break;
@ -553,19 +553,14 @@
}
cl = NEXTOP(cl,x);
break;
case _get_atom:
if (iarg == cl->u.xc.x) {
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;
case _get_bigint:
if (iarg == cl->u.xB.x) {
clause->Tag = cl->u.xB.b;
return;
}
cl = NEXTOP(cl,xc);
cl = NEXTOP(cl,xB);
break;
case _get_bigint:
case _get_atom:
if (iarg == cl->u.xc.x) {
if (IsApplTerm(cl->u.xc.c)) {
CELL *pt = RepAppl(cl->u.xc.c);

32
H/rclause.h
View File

@ -294,15 +294,25 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.o.opcw = OpcodeAdjust(pc->u.o.opcw);
pc = NEXTOP(pc,o);
break;
/* instructions type oB */
case _unify_bigint:
case _unify_l_bigint:
pc->u.oB.opcw = OpcodeAdjust(pc->u.oB.opcw);
pc->u.oB.b = BlobTermInCodeAdjust(pc->u.oB.b);
pc = NEXTOP(pc,oB);
break;
/* instructions type oD */
case _unify_dbterm:
case _unify_l_dbterm:
pc->u.oD.opcw = OpcodeAdjust(pc->u.oD.opcw);
pc->u.oD.D = DBGroundTermAdjust(pc->u.oD.D);
pc = NEXTOP(pc,oD);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
case _unify_bigint:
case _unify_dbterm:
case _unify_l_atom:
case _unify_l_atom_write:
case _unify_l_bigint:
case _unify_l_dbterm:
pc->u.oc.opcw = OpcodeAdjust(pc->u.oc.opcw);
pc->u.oc.c = ConstantTermAdjust(pc->u.oc.c);
pc = NEXTOP(pc,oc);
@ -525,10 +535,20 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.x.x = XAdjust(pc->u.x.x);
pc = NEXTOP(pc,x);
break;
/* instructions type xB */
case _get_bigint:
pc->u.xB.x = XAdjust(pc->u.xB.x);
pc->u.xB.b = BlobTermInCodeAdjust(pc->u.xB.b);
pc = NEXTOP(pc,xB);
break;
/* instructions type xD */
case _get_dbterm:
pc->u.xD.x = XAdjust(pc->u.xD.x);
pc->u.xD.D = DBGroundTermAdjust(pc->u.xD.D);
pc = NEXTOP(pc,xD);
break;
/* instructions type xc */
case _get_atom:
case _get_bigint:
case _get_dbterm:
case _put_atom:
pc->u.xc.x = XAdjust(pc->u.xc.x);
pc->u.xc.c = ConstantTermAdjust(pc->u.xc.c);

16
H/rheap.h
View File

@ -244,14 +244,16 @@ ConstantTermAdjust (Term t)
{
if (IsAtomTerm(t))
return AtomTermAdjust(t);
else if (IsIntTerm(t))
return t;
else if (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t))) {
return BlobTermAdjust(t);
} else if (IsApplTerm(t) || IsPairTerm(t)) {
return CodeComposedTermAdjust(t);
return t;
}
static Term
DBGroundTermAdjust (Term t)
{
if (IsPairTerm(t)) {
return AdjustDBTerm(t, PtoHeapCellAdjust(RepPair(t)));
} else {
return t;
return AdjustDBTerm(t, PtoHeapCellAdjust(RepAppl(t)));
}
}

8
H/sshift.h
View File

@ -449,10 +449,10 @@ CodeVarAdjust (Term var)
#if TAGS_FAST_OPS
inline EXTERN Term BlobTermAdjust (Term);
inline EXTERN Term BlobTermInCodeAdjust (Term);
inline EXTERN Term
BlobTermAdjust (Term t)
BlobTermInCodeAdjust (Term t)
{
return (Term) (CharP(t) - HDiff);
}
@ -469,10 +469,10 @@ CodeComposedTermAdjust (Term t)
#else
inline EXTERN Term BlobTermAdjust (Term);
inline EXTERN Term BlobTermInCodeAdjust (Term);
inline EXTERN Term
BlobTermAdjust (Term t)
BlobTermInCodeAdjust (Term t)
{
return (Term) (CharP(t) + HDiff);
}

24
H/walkclause.h
View File

@ -225,15 +225,21 @@
case _unify_void_write:
pc = NEXTOP(pc,o);
break;
/* instructions type oB */
case _unify_bigint:
case _unify_l_bigint:
pc = NEXTOP(pc,oB);
break;
/* instructions type oD */
case _unify_dbterm:
case _unify_l_dbterm:
pc = NEXTOP(pc,oD);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
case _unify_bigint:
case _unify_dbterm:
case _unify_l_atom:
case _unify_l_atom_write:
case _unify_l_bigint:
case _unify_l_dbterm:
pc = NEXTOP(pc,oc);
break;
/* instructions type od */
@ -400,10 +406,16 @@
case _write_x_var:
pc = NEXTOP(pc,x);
break;
/* instructions type xB */
case _get_bigint:
pc = NEXTOP(pc,xB);
break;
/* instructions type xD */
case _get_dbterm:
pc = NEXTOP(pc,xD);
break;
/* instructions type xc */
case _get_atom:
case _get_bigint:
case _get_dbterm:
case _put_atom:
pc = NEXTOP(pc,xc);
break;

4
misc/buildops
View File

@ -222,8 +222,10 @@ rewritable_field(0't).
get_op(0'a,"Arity").
get_op(0'b,"CellPtoHeap").
get_op(0'B,"BlobTermInCode").
get_op(0'c,"ConstantTerm").
get_op(0'd,"DoubleInCode").
get_op(0'D,"DBGroundTerm").
get_op(0'f,"Func").
get_op(0'F,"ExternalFunction").
get_op(0'i,"IntegerInCode").
@ -850,7 +852,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","c",[])]).
opinfo("get_bigint",[bind("x","b",[])]).
opinfo("copy_idb_term",[logical]).
opinfo("unify_idb_term",[logical]).
opinfo("put_atom",[new("x")]).