more bigint and dbterm fixes.

This commit is contained in:
Vítor Santos Costa 2010-12-16 22:21:46 +00:00
parent 5a2d908489
commit cfe0dda995
11 changed files with 198 additions and 105 deletions

View File

@ -4261,17 +4261,17 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(get_bigint, xB);
Op(get_bigint, xN);
#ifdef USE_GMP
BEGD(d0);
d0 = XREG(PREG->u.xB.x);
d0 = XREG(PREG->u.xN.x);
deref_head(d0, gbigint_unk);
gbigint_nonvar:
if (!IsApplTerm(d0))
FAIL();
/* we have met a preexisting bigint */
START_PREFETCH(xB);
START_PREFETCH(xN);
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.xB.b))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.xN.b))
FAIL();
PREG = NEXTOP(PREG, xB);
PREG = NEXTOP(PREG, xN);
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(xB);
START_PREFETCH(xN);
BEGD(d1);
d1 = PREG->u.xB.b;
PREG = NEXTOP(PREG, xB);
d1 = PREG->u.xN.b;
PREG = NEXTOP(PREG, xN);
BIND(pt0, d1, bind_gbigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
@ -6347,7 +6347,7 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(unify_bigint, oB);
Op(unify_bigint, oN);
#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.oB.b))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oN.b))
FAIL();
PREG = NEXTOP(PREG, oB);
PREG = NEXTOP(PREG, oN);
ENDP(pt0);
GONext();
derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar);
BEGD(d1);
d1 = PREG->u.oB.b;
PREG = NEXTOP(PREG, oB);
d1 = PREG->u.oN.b;
PREG = NEXTOP(PREG, oN);
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, oB);
Op(unify_l_bigint, oN);
#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.oB.b))
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oN.b))
FAIL();
PREG = NEXTOP(PREG, oB);
PREG = NEXTOP(PREG, oN);
ENDP(pt0);
GONext();
derefa_body(d0, S_SREG, ulbigint_unk, ulbigint_nonvar);
BEGD(d1);
d1 = PREG->u.oB.b;
PREG = NEXTOP(PREG, oB);
d1 = PREG->u.oN.b;
PREG = NEXTOP(PREG, oN);
BIND_GLOBAL(S_SREG, d1, bind_ulbigint);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
@ -6907,8 +6907,26 @@ Yap_absmi(int inp)
GONext();
ENDD(d0);
ENDOp();
Op(put_dbterm, xD);
BEGD(d0);
d0 = PREG->u.xD.D;
XREG(PREG->u.xD.x) = d0;
PREG = NEXTOP(PREG, xD);
GONext();
ENDD(d0);
ENDOp();
Op(put_float, xd);
Op(put_bigint, xN);
BEGD(d0);
d0 = PREG->u.xN.b;
XREG(PREG->u.xN.x) = d0;
PREG = NEXTOP(PREG, xN);
GONext();
ENDD(d0);
ENDOp();
Op(put_float, xd);
BEGD(d0);
d0 = AbsAppl(PREG->u.xd.d);
XREG(PREG->u.xd.x) = d0;
@ -7101,6 +7119,24 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(write_bigint, N);
BEGD(d0);
d0 = PREG->u.N.b;
*SREG++ = d0;
ENDD(d0);
PREG = NEXTOP(PREG, N);
GONext();
ENDOp();
Op(write_dbterm, D);
BEGD(d0);
d0 = PREG->u.D.D;
*SREG++ = d0;
ENDD(d0);
PREG = NEXTOP(PREG, D);
GONext();
ENDOp();
Op(write_float, d);
BEGD(d0);
d0 = AbsAppl(PREG->u.d.d);

14
C/agc.c
View File

@ -114,20 +114,6 @@ AtomAdjust(Atom a)
static Term AdjustDBTerm(Term, Term *);
static Term
CodeComposedTermAdjust(Term t)
{
Term *base;
if (IsApplTerm(t)) {
base = RepAppl(t);
} else {
base = RepPair(t);
}
return AdjustDBTerm(t, base);
}
#define IsOldCode(P) FALSE
#define IsOldCodeCellPtr(P) FALSE
#define IsOldDelay(P) FALSE

View File

@ -1083,15 +1083,15 @@ a_uc(CELL rnd1, op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_
}
inline static yamop *
a_blob(CELL rnd1, op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
a_wblob(CELL rnd1, op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.c.c =
code_p->u.N.b =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(c);
GONEXT(N);
return code_p;
}
@ -1117,11 +1117,11 @@ a_wdbt(CELL rnd1, op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.c.c = rnd1;
code_p->u.D.D = rnd1;
add_to_dbtermsl(cip, cip->cpc->rnd1);
}
*clause_has_dbtermp = TRUE;
GONEXT(c);
GONEXT(D);
return code_p;
}
@ -1130,13 +1130,13 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.oc.opcw = emit_op(opcode_w);
code_p->u.oc.c =
code_p->u.oN.opcw = emit_op(opcode_w);
code_p->u.oN.b =
AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(oc);
GONEXT(oN);
return code_p;
}
@ -1145,12 +1145,12 @@ a_udbt(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_dbterm
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.oc.opcw = emit_op(opcode_w);
code_p->u.oc.c = cip->cpc->rnd1;
code_p->u.oD.opcw = emit_op(opcode_w);
code_p->u.oD.D = cip->cpc->rnd1;
add_to_dbtermsl(cip, cip->cpc->rnd1);
}
*clause_has_dbtermp = TRUE;
GONEXT(oc);
GONEXT(oD);
return code_p;
}
@ -1372,11 +1372,11 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xc.x = emit_x(cip->cpc->rnd2);
code_p->u.xc.c = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
code_p->u.xN.x = emit_x(cip->cpc->rnd2);
code_p->u.xN.b = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
}
*clause_has_blobsp = TRUE;
GONEXT(xc);
GONEXT(xN);
return code_p;
}
@ -1385,12 +1385,12 @@ a_dbt(op_numbers opcode, int *clause_has_dbtermp, yamop *code_p, int pass_no, st
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.xc.x = emit_x(cip->cpc->rnd2);
code_p->u.xc.c = cip->cpc->rnd1;
code_p->u.xD.x = emit_x(cip->cpc->rnd2);
code_p->u.xD.D = cip->cpc->rnd1;
add_to_dbtermsl(cip, cip->cpc->rnd1);
}
*clause_has_dbtermp = TRUE;
GONEXT(xc);
GONEXT(xD);
return code_p;
}
@ -3248,10 +3248,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_ri(_put_longint, code_p, pass_no, cip->cpc);
break;
case put_bigint_op:
code_p = a_rb(_put_atom, clause_has_blobsp, code_p, pass_no, cip);
code_p = a_rb(_put_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case put_dbterm_op:
code_p = a_dbt(_put_atom, clause_has_dbtermp, code_p, pass_no, cip);
code_p = a_dbt(_put_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
case get_list_op:
code_p = a_glist(&do_not_optimise_uatom, code_p, pass_no, cip);
@ -3344,10 +3344,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_wi(_write_longint, code_p, pass_no, cip->cpc);
break;
case write_bigint_op:
code_p = a_blob(cip->cpc->rnd1, _write_atom, clause_has_blobsp, code_p, pass_no, cip);
code_p = a_wblob(cip->cpc->rnd1, _write_bigint, clause_has_blobsp, code_p, pass_no, cip);
break;
case write_dbterm_op:
code_p = a_wdbt(cip->cpc->rnd1, _write_atom, clause_has_dbtermp, code_p, pass_no, cip);
code_p = a_wdbt(cip->cpc->rnd1, _write_dbterm, clause_has_dbtermp, code_p, pass_no, cip);
break;
case unify_list_op:
code_p = a_ue(_unify_list, _unify_list_write, code_p, pass_no);

View File

@ -67,7 +67,7 @@
OPCODE(get_struct ,xfa),
OPCODE(get_float ,xd),
OPCODE(get_longint ,xi),
OPCODE(get_bigint ,xB),
OPCODE(get_bigint ,xN),
OPCODE(get_dbterm ,xD),
OPCODE(glist_valx ,xx),
OPCODE(glist_valy ,yx),
@ -125,8 +125,8 @@
OPCODE(unify_longint_write ,oi),
OPCODE(unify_l_longint ,oi),
OPCODE(unify_l_longint_write ,oi),
OPCODE(unify_bigint ,oB),
OPCODE(unify_l_bigint ,oB),
OPCODE(unify_bigint ,oN),
OPCODE(unify_l_bigint ,oN),
OPCODE(unify_dbterm ,oD),
OPCODE(unify_l_dbterm ,oD),
OPCODE(unify_list ,o),
@ -145,6 +145,8 @@
OPCODE(put_y_vals ,yyxx),
OPCODE(put_unsafe ,yx),
OPCODE(put_atom ,xc),
OPCODE(put_dbterm ,xD),
OPCODE(put_bigint ,xN),
OPCODE(put_float ,xd),
OPCODE(put_longint ,xi),
OPCODE(put_list ,x),
@ -158,6 +160,8 @@
OPCODE(write_y_val ,y),
OPCODE(write_y_loc ,y),
OPCODE(write_atom ,c),
OPCODE(write_bigint ,N),
OPCODE(write_dbterm ,D),
OPCODE(write_float ,d),
OPCODE(write_longint ,i),
OPCODE(write_n_atoms ,sc),

View File

@ -241,7 +241,6 @@ 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)
@ -253,6 +252,7 @@ typedef enum {
L: logic upd clause, logic_upd_clause *
m: module, Term
n: number, Integer
N: bigint, Blob (Term)
o: opcode, OPCODE
O: OR-parallel information, used by YAPOR, unsigned int
p: predicate, struct pred_entry *
@ -277,6 +277,14 @@ typedef struct yami {
Term c;
CELL next;
} c;
struct {
Term D;
CELL next;
} D;
struct {
Term b;
CELL next;
} N;
struct {
Term c1;
Term c2;
@ -501,7 +509,7 @@ typedef struct yami {
OPCODE opcw;
Term b;
CELL next;
} oB;
} oN;
struct {
OPCODE opcw;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
@ -720,7 +728,7 @@ typedef struct yami {
wamreg x;
Term b;
CELL next;
} xB;
} xN;
struct {
wamreg x;
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];

View File

@ -6,9 +6,15 @@
while (TRUE) {
op_numbers op = Yap_op_from_opcode(cl->opc);
switch (op) {
case _write_dbterm:
cl = NEXTOP(cl,D);
break;
case _alloc_for_logical_pred:
cl = NEXTOP(cl,L);
break;
case _write_bigint:
cl = NEXTOP(cl,N);
break;
case _ensure_space:
cl = NEXTOP(cl,Osbpi);
break;
@ -316,18 +322,18 @@
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_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_atom:
cl = NEXTOP(cl,oc);
break;
@ -656,12 +662,26 @@
}
cl = NEXTOP(cl,x);
break;
case _get_bigint:
if (is_regcopy(myregs, nofregs, cl->u.xB.x)) {
clause->Tag = cl->u.xB.b;
case _put_dbterm:
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xD.x))) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xB);
cl = NEXTOP(cl,xD);
break;
case _get_bigint:
if (is_regcopy(myregs, nofregs, cl->u.xN.x)) {
clause->Tag = cl->u.xN.b;
return;
}
cl = NEXTOP(cl,xN);
break;
case _put_bigint:
if (!(nofregs = delete_regcopy(myregs, nofregs, cl->u.xN.x))) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xN);
break;
case _get_atom:
if (is_regcopy(myregs, nofregs, cl->u.xc.x)) {

View File

@ -291,18 +291,18 @@
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_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_l_bigint:
cl = NEXTOP(cl,oN);
break;
case _unify_atom:
cl = NEXTOP(cl,oc);
break;
@ -553,12 +553,26 @@
}
cl = NEXTOP(cl,x);
break;
case _get_bigint:
if (iarg == cl->u.xB.x) {
clause->Tag = cl->u.xB.b;
case _put_dbterm:
if (iarg == cl->u.xD.x) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xB);
cl = NEXTOP(cl,xD);
break;
case _get_bigint:
if (iarg == cl->u.xN.x) {
clause->Tag = cl->u.xN.b;
return;
}
cl = NEXTOP(cl,xN);
break;
case _put_bigint:
if (iarg == cl->u.xN.x) {
clause->Tag = (CELL)NULL;
return;
}
cl = NEXTOP(cl,xN);
break;
case _get_atom:
if (iarg == cl->u.xc.x) {

View File

@ -16,6 +16,11 @@ restore_opcodes(yamop *pc, yamop *max)
fprintf(stderr, "%s ", Yap_op_names[op]);
#endif
switch (op) {
/* instructions type D */
case _write_dbterm:
pc->u.D.D = DBGroundTermAdjust(pc->u.D.D);
pc = NEXTOP(pc,D);
break;
/* instructions type Ills */
case _enter_lu_pred:
pc->u.Ills.I = PtoLUIndexAdjust(pc->u.Ills.I);
@ -30,6 +35,11 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.L.ClBase = PtoLUClauseAdjust(pc->u.L.ClBase);
pc = NEXTOP(pc,L);
break;
/* instructions type N */
case _write_bigint:
pc->u.N.b = BlobTermInCodeAdjust(pc->u.N.b);
pc = NEXTOP(pc,N);
break;
/* instructions type Osblp */
case _either:
case _or_else:
@ -294,13 +304,6 @@ 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:
@ -308,6 +311,13 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.oD.D = DBGroundTermAdjust(pc->u.oD.D);
pc = NEXTOP(pc,oD);
break;
/* instructions type oN */
case _unify_bigint:
case _unify_l_bigint:
pc->u.oN.opcw = OpcodeAdjust(pc->u.oN.opcw);
pc->u.oN.b = BlobTermInCodeAdjust(pc->u.oN.b);
pc = NEXTOP(pc,oN);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
@ -535,18 +545,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:
case _put_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 xN */
case _get_bigint:
case _put_bigint:
pc->u.xN.x = XAdjust(pc->u.xN.x);
pc->u.xN.b = BlobTermInCodeAdjust(pc->u.xN.b);
pc = NEXTOP(pc,xN);
break;
/* instructions type xc */
case _get_atom:
case _put_atom:

View File

@ -250,10 +250,11 @@ ConstantTermAdjust (Term t)
static Term
DBGroundTermAdjust (Term t)
{
/* The term itself is restored by dbtermlist */
if (IsPairTerm(t)) {
return AdjustDBTerm(t, PtoHeapCellAdjust(RepPair(t)));
return AbsPair(PtoHeapCellAdjust(RepPair(t)));
} else {
return AdjustDBTerm(t, PtoHeapCellAdjust(RepAppl(t)));
return AbsAppl(PtoHeapCellAdjust(RepAppl(t)));
}
}

View File

@ -9,12 +9,20 @@
op = Yap_op_from_opcode(pc->opc);
/* C-code, maybe indexing */
switch (op) {
/* instructions type D */
case _write_dbterm:
pc = NEXTOP(pc,D);
break;
/* instructions type Ills */
case _enter_lu_pred:
return walk_got_lu_block(pc->u.Ills.I, startp, endp);
/* instructions type L */
case _alloc_for_logical_pred:
return walk_got_lu_clause(pc->u.L.ClBase, startp, endp);
/* instructions type N */
case _write_bigint:
pc = NEXTOP(pc,N);
break;
/* instructions type Osblp */
case _either:
case _or_else:
@ -225,16 +233,16 @@
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 oN */
case _unify_bigint:
case _unify_l_bigint:
pc = NEXTOP(pc,oN);
break;
/* instructions type oc */
case _unify_atom:
case _unify_atom_write:
@ -406,14 +414,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:
case _put_dbterm:
pc = NEXTOP(pc,xD);
break;
/* instructions type xN */
case _get_bigint:
case _put_bigint:
pc = NEXTOP(pc,xN);
break;
/* instructions type xc */
case _get_atom:
case _put_atom:

View File

@ -222,7 +222,6 @@ 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").
@ -234,6 +233,7 @@ get_op(0'l,"PtoOp").
get_op(0'L,"PtoLUClause").
get_op(0'm,"Module").
get_op(0'n,"Integer").
get_op(0'N,"BlobTermInCode").
get_op(0'o,"Opcode").
get_op(0'O,"OrArg").
get_op(0'p,"PtoPred").
@ -856,6 +856,8 @@ opinfo("get_bigint",[bind("x","b",[])]).
opinfo("copy_idb_term",[logical]).
opinfo("unify_idb_term",[logical]).
opinfo("put_atom",[new("x")]).
opinfo("put_dbterm",[new("x")]).
opinfo("put_bigint",[new("x")]).
opinfo("put_float",[new("x")]).
opinfo("put_longint",[new("x")]).
opinfo("put_list",[new("x")]).