improve indexing on floats
fix sending large lists to DB git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1692 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
07b2b76c48
commit
4ff41f7a62
147
C/absmi.c
147
C/absmi.c
@ -10,8 +10,12 @@
|
||||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2006-08-07 18:51:44 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.203 2006/08/07 18:51:44 vsc
|
||||
* fix garbage collector not to try to garbage collect when we ask for large
|
||||
* chunks of stack in a single go.
|
||||
*
|
||||
* Revision 1.202 2006/05/24 02:35:39 vsc
|
||||
* make chr work and other minor fixes.
|
||||
*
|
||||
@ -3819,16 +3823,16 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOpRW();
|
||||
|
||||
Op(get_float, xc);
|
||||
Op(get_float, xd);
|
||||
BEGD(d0);
|
||||
d0 = XREG(PREG->u.xc.x);
|
||||
d0 = XREG(PREG->u.xd.x);
|
||||
deref_head(d0, gfloat_unk);
|
||||
|
||||
gfloat_nonvar:
|
||||
if (!IsApplTerm(d0))
|
||||
FAIL();
|
||||
/* we have met a preexisting float */
|
||||
START_PREFETCH(xc);
|
||||
START_PREFETCH(xd);
|
||||
BEGP(pt0);
|
||||
pt0 = RepAppl(d0);
|
||||
/* check functor */
|
||||
@ -3836,7 +3840,8 @@ Yap_absmi(int inp)
|
||||
FAIL();
|
||||
}
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(PREG->u.xc.c);
|
||||
pt1 = PREG->u.xd.d;
|
||||
PREG = NEXTOP(PREG, xd);
|
||||
if (
|
||||
pt1[1] != pt0[1]
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
||||
@ -3845,7 +3850,6 @@ Yap_absmi(int inp)
|
||||
) FAIL();
|
||||
ENDP(pt1);
|
||||
ENDP(pt0);
|
||||
PREG = NEXTOP(PREG, xc);
|
||||
/* enter read mode */
|
||||
GONext();
|
||||
END_PREFETCH();
|
||||
@ -3856,8 +3860,8 @@ Yap_absmi(int inp)
|
||||
/* set d1 to be the new structure we are going to create */
|
||||
START_PREFETCH(xc);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.xc.c;
|
||||
PREG = NEXTOP(PREG, xc);
|
||||
d1 = AbsAppl(PREG->u.xd.d);
|
||||
PREG = NEXTOP(PREG, xd);
|
||||
BIND(pt0, d1, bind_gfloat);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(pt0, d1);
|
||||
@ -3872,28 +3876,25 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(get_longint, xc);
|
||||
Op(get_longint, xi);
|
||||
BEGD(d0);
|
||||
d0 = XREG(PREG->u.xc.x);
|
||||
d0 = XREG(PREG->u.xi.x);
|
||||
deref_head(d0, glongint_unk);
|
||||
|
||||
glongint_nonvar:
|
||||
if (!IsApplTerm(d0))
|
||||
FAIL();
|
||||
/* we have met a preexisting longint */
|
||||
START_PREFETCH(xc);
|
||||
START_PREFETCH(xi);
|
||||
BEGP(pt0);
|
||||
pt0 = RepAppl(d0);
|
||||
/* check functor */
|
||||
if (*pt0 != (CELL)FunctorLongInt) {
|
||||
FAIL();
|
||||
}
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(PREG->u.xc.c);
|
||||
if (pt1[1] != pt0[1]) FAIL();
|
||||
ENDP(pt1);
|
||||
if (PREG->u.xi.i[1] != (CELL)pt0[1]) FAIL();
|
||||
ENDP(pt0);
|
||||
PREG = NEXTOP(PREG, xc);
|
||||
PREG = NEXTOP(PREG, xi);
|
||||
/* enter read mode */
|
||||
GONext();
|
||||
END_PREFETCH();
|
||||
@ -3902,10 +3903,10 @@ Yap_absmi(int inp)
|
||||
deref_body(d0, pt0, glongint_unk, glongint_nonvar);
|
||||
/* Enter Write mode */
|
||||
/* set d1 to be the new structure we are going to create */
|
||||
START_PREFETCH(xc);
|
||||
START_PREFETCH(xi);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.xc.c;
|
||||
PREG = NEXTOP(PREG, xc);
|
||||
d1 = AbsAppl(PREG->u.xi.i);
|
||||
PREG = NEXTOP(PREG, xi);
|
||||
BIND(pt0, d1, bind_glongint);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(pt0, d1);
|
||||
@ -5653,6 +5654,18 @@ Yap_absmi(int inp)
|
||||
GONextW();
|
||||
ENDOpW();
|
||||
|
||||
OpW(unify_float_write, od);
|
||||
* SREG++ = AbsAppl(PREG->u.od.d);
|
||||
PREG = NEXTOP(PREG, od);
|
||||
GONextW();
|
||||
ENDOpW();
|
||||
|
||||
OpW(unify_longint_write, oi);
|
||||
* SREG++ = AbsAppl(PREG->u.oi.i);
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
GONextW();
|
||||
ENDOpW();
|
||||
|
||||
Op(unify_atom, oc);
|
||||
BEGD(d0);
|
||||
BEGP(pt0);
|
||||
@ -5680,6 +5693,18 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(unify_l_float_write, od);
|
||||
SREG[0] = AbsAppl(PREG->u.od.d);
|
||||
PREG = NEXTOP(PREG, od);
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
Op(unify_l_longint_write, oi);
|
||||
SREG[0] = AbsAppl(PREG->u.oi.i);
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
Op(unify_l_atom_write, oc);
|
||||
SREG[0] = PREG->u.oc.c;
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
@ -5766,7 +5791,7 @@ Yap_absmi(int inp)
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
Op(unify_float, oc);
|
||||
Op(unify_float, od);
|
||||
BEGD(d0);
|
||||
BEGP(pt0);
|
||||
pt0 = SREG++;
|
||||
@ -5786,8 +5811,8 @@ Yap_absmi(int inp)
|
||||
}
|
||||
ENDD(d0);
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(PREG->u.oc.c);
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
pt1 = PREG->u.od.d;
|
||||
PREG = NEXTOP(PREG, od);
|
||||
if (
|
||||
pt1[1] != pt0[1]
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
||||
@ -5800,8 +5825,8 @@ Yap_absmi(int inp)
|
||||
|
||||
derefa_body(d0, pt0, ufloat_unk, ufloat_nonvar);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.oc.c;
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
d1 = AbsAppl(PREG->u.od.d);
|
||||
PREG = NEXTOP(PREG, od);
|
||||
BIND_GLOBAL(pt0, d1, bind_ufloat);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(pt0, d1);
|
||||
@ -5814,7 +5839,7 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(unify_l_float, oc);
|
||||
Op(unify_l_float, od);
|
||||
BEGD(d0);
|
||||
CACHE_S();
|
||||
READ_IN_S();
|
||||
@ -5833,8 +5858,8 @@ Yap_absmi(int inp)
|
||||
}
|
||||
ENDD(d0);
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(PREG->u.oc.c);
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
pt1 = PREG->u.od.d;
|
||||
PREG = NEXTOP(PREG, od);
|
||||
if (
|
||||
pt1[1] != pt0[1]
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
||||
@ -5847,8 +5872,8 @@ Yap_absmi(int inp)
|
||||
|
||||
derefa_body(d0, S_SREG, ulfloat_unk, ulfloat_nonvar);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.oc.c;
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
d1 = AbsAppl(PREG->u.od.d);
|
||||
PREG = NEXTOP(PREG, od);
|
||||
BIND_GLOBAL(S_SREG, d1, bind_ulfloat);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(S_SREG, d1);
|
||||
@ -5861,7 +5886,7 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(unify_longint, oc);
|
||||
Op(unify_longint, oi);
|
||||
BEGD(d0);
|
||||
BEGP(pt0);
|
||||
pt0 = SREG++;
|
||||
@ -5881,8 +5906,8 @@ Yap_absmi(int inp)
|
||||
}
|
||||
ENDD(d0);
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(PREG->u.oc.c);
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
pt1 = PREG->u.oi.i;
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
if (pt1[1] != pt0[1]) FAIL();
|
||||
ENDP(pt1);
|
||||
ENDP(pt0);
|
||||
@ -5890,8 +5915,8 @@ Yap_absmi(int inp)
|
||||
|
||||
derefa_body(d0, pt0, ulongint_unk, ulongint_nonvar);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.oc.c;
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
d1 = AbsAppl(PREG->u.oi.i);
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
BIND_GLOBAL(pt0, d1, bind_ulongint);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(pt0, d1);
|
||||
@ -5904,7 +5929,7 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(unify_l_longint, oc);
|
||||
Op(unify_l_longint, oi);
|
||||
BEGD(d0);
|
||||
CACHE_S();
|
||||
READ_IN_S();
|
||||
@ -5923,8 +5948,8 @@ Yap_absmi(int inp)
|
||||
}
|
||||
ENDD(d0);
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(PREG->u.oc.c);
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
pt1 = PREG->u.oi.i;
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
if (pt1[1] != pt0[1]) FAIL();
|
||||
ENDP(pt1);
|
||||
ENDP(pt0);
|
||||
@ -5932,8 +5957,8 @@ Yap_absmi(int inp)
|
||||
|
||||
derefa_body(d0, S_SREG, ullongint_unk, ullongint_nonvar);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.oc.c;
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
d1 = AbsAppl(PREG->u.oi.i);
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
BIND_GLOBAL(S_SREG, d1, bind_ullongint);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(S_SREG, d1);
|
||||
@ -5975,8 +6000,8 @@ Yap_absmi(int inp)
|
||||
|
||||
derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar);
|
||||
BEGD(d1);
|
||||
d1 = PREG->u.oc.c;
|
||||
PREG = NEXTOP(PREG, oc);
|
||||
d1 = AbsAppl(PREG->u.oi.i);
|
||||
PREG = NEXTOP(PREG, oi);
|
||||
BIND_GLOBAL(pt0, d1, bind_ubigint);
|
||||
#ifdef COROUTINING
|
||||
DO_TRAIL(pt0, d1);
|
||||
@ -6420,6 +6445,24 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(put_float, xd);
|
||||
BEGD(d0);
|
||||
d0 = AbsAppl(PREG->u.xd.d);
|
||||
XREG(PREG->u.xd.x) = d0;
|
||||
PREG = NEXTOP(PREG, xd);
|
||||
GONext();
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(put_longint, xi);
|
||||
BEGD(d0);
|
||||
d0 = AbsAppl(PREG->u.xi.i);
|
||||
XREG(PREG->u.xi.x) = d0;
|
||||
PREG = NEXTOP(PREG, xi);
|
||||
GONext();
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
Op(put_list, x);
|
||||
CACHE_S();
|
||||
READ_IN_S();
|
||||
@ -6596,6 +6639,24 @@ Yap_absmi(int inp)
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
Op(write_float, d);
|
||||
BEGD(d0);
|
||||
d0 = AbsAppl(PREG->u.d.d);
|
||||
*SREG++ = d0;
|
||||
ENDD(d0);
|
||||
PREG = NEXTOP(PREG, d);
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
Op(write_longint, i);
|
||||
BEGD(d0);
|
||||
d0 = AbsAppl(PREG->u.i.i);
|
||||
*SREG++ = d0;
|
||||
ENDD(d0);
|
||||
PREG = NEXTOP(PREG, i);
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
Op(write_n_atoms, sc);
|
||||
BEGD(d0);
|
||||
BEGD(d1);
|
||||
@ -8123,7 +8184,11 @@ 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
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
|
||||
140
C/amasm.c
140
C/amasm.c
@ -11,8 +11,12 @@
|
||||
* File: amasm.c *
|
||||
* comments: abstract machine assembler *
|
||||
* *
|
||||
* Last rev: $Date: 2006-03-24 17:13:41 $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.87 2006/03/24 17:13:41 rslopes
|
||||
* New update to BEAM engine.
|
||||
* BEAM now uses YAP Indexing (JITI)
|
||||
*
|
||||
* Revision 1.86 2006/01/02 02:16:17 vsc
|
||||
* support new interface between YAP and GMP, so that we don't rely on our own
|
||||
* allocation routines.
|
||||
@ -808,6 +812,62 @@ a_ublob(CELL rnd1, op_numbers opcode, op_numbers opcode_w, int *clause_has_blobs
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_ud(op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
{
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(opcode);
|
||||
code_p->u.oc.opcw = emit_op(opcode_w);
|
||||
code_p->u.od.d[0] = (CELL)FunctorDouble;
|
||||
code_p->u.od.d[1] = RepAppl(cpc->rnd1)[1];
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
||||
code_p->u.od.d[2] = RepAppl(cpc->rnd1)[2];
|
||||
#endif
|
||||
}
|
||||
GONEXT(od);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_ui(op_numbers opcode, op_numbers opcode_w, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
{
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(opcode);
|
||||
code_p->u.oc.opcw = emit_op(opcode_w);
|
||||
code_p->u.oi.i[0] = (CELL)FunctorLongInt;
|
||||
code_p->u.oi.i[1] = RepAppl(cpc->rnd1)[1];
|
||||
}
|
||||
GONEXT(oi);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_wd(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
{
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(opcode);
|
||||
code_p->u.d.d[0] = (CELL)FunctorDouble;
|
||||
code_p->u.d.d[1] = RepAppl(cpc->rnd1)[1];
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
||||
code_p->u.d.d[2] = RepAppl(cpc->rnd1)[2];
|
||||
#endif
|
||||
}
|
||||
GONEXT(d);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_wi(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
{
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(opcode);
|
||||
code_p->u.i.i[0] = (CELL)FunctorLongInt;
|
||||
code_p->u.i.i[1] = RepAppl(cpc->rnd1)[1];
|
||||
}
|
||||
GONEXT(i);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_nc(CELL rnd1, op_numbers opcode, int i, yamop *code_p, int pass_no)
|
||||
{
|
||||
@ -846,6 +906,35 @@ a_rf(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_rd(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
{
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(opcode);
|
||||
code_p->u.xd.x = emit_x(cpc->rnd2);
|
||||
code_p->u.xd.d[0] = (CELL)FunctorDouble;
|
||||
code_p->u.xd.d[1] = RepAppl(cpc->rnd1)[1];
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
||||
code_p->u.xd.d[2] = RepAppl(cpc->rnd1)[2];
|
||||
#endif
|
||||
}
|
||||
GONEXT(xd);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_ri(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc)
|
||||
{
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(opcode);
|
||||
code_p->u.xi.x = emit_x(cpc->rnd2);
|
||||
code_p->u.xi.i[0] = (CELL)FunctorLongInt;
|
||||
code_p->u.xi.i[1] = RepAppl(cpc->rnd1)[1];
|
||||
}
|
||||
GONEXT(xi);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
static yamop *
|
||||
a_rc(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
|
||||
{
|
||||
@ -854,7 +943,6 @@ a_rc(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
|
||||
(cip->cpc->nextInst->op == get_atom_op ||
|
||||
cip->cpc->nextInst->op == get_num_op)) {
|
||||
struct PSEUDO *next;
|
||||
|
||||
next = cip->cpc->nextInst;
|
||||
if (next->nextInst->rnd2 == 3 &&
|
||||
(next->nextInst->op == get_atom_op ||
|
||||
@ -950,6 +1038,18 @@ a_rb(op_numbers opcode, int *clause_has_blobsp, yamop *code_p, int pass_no, stru
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_rli(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.xc.x = emit_x(cip->cpc->rnd2);
|
||||
code_p->u.xc.c = AbsAppl((CELL *)(Unsigned(cip->code_addr) + cip->label_offset[cip->cpc->rnd1]));
|
||||
}
|
||||
GONEXT(xc);
|
||||
return code_p;
|
||||
}
|
||||
|
||||
inline static yamop *
|
||||
a_r(CELL arnd2, op_numbers opcode, yamop *code_p, int pass_no)
|
||||
{
|
||||
@ -2497,6 +2597,22 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
cl_u->luc.ClRefCount = 0;
|
||||
cl_u->luc.ClPred = cip->CurrentPred;
|
||||
cl_u->luc.ClSize = size;
|
||||
/*
|
||||
Support for timestamps, stalled for now.
|
||||
if (cip->CurrentPred->PredFlags & ThreadLocalPredFlag) {
|
||||
LOCK(LocalTimeStampLock);
|
||||
cl_u->luc.ClTimeStart = LocalTimeStamp;
|
||||
LocalTimeStamp++;
|
||||
cl_u->luc.ClTimeEnd = LocalTimeStamp;
|
||||
UNLOCK(LocalTimeStampLock);
|
||||
} else {
|
||||
LOCK(GlobalTimeStampLock);
|
||||
cl_u->luc.ClTimeStart = GlobalTimeStamp;
|
||||
GlobalTimeStamp++;
|
||||
cl_u->luc.ClTimeEnd = GlobalTimeStamp;
|
||||
UNLOCK(GlobalTimeStampLock);
|
||||
}
|
||||
*/
|
||||
if (*clause_has_blobsp) {
|
||||
cl_u->luc.ClFlags |= HasBlobsMask;
|
||||
}
|
||||
@ -2672,10 +2788,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
code_p = a_rc(_get_atom, code_p, pass_no, cip);
|
||||
break;
|
||||
case get_float_op:
|
||||
code_p = a_rb(_get_float, clause_has_blobsp, code_p, pass_no, cip);
|
||||
code_p = a_rd(_get_float, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case get_longint_op:
|
||||
code_p = a_rb(_get_longint, clause_has_blobsp, code_p, pass_no, cip);
|
||||
code_p = a_ri(_get_longint, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case get_bigint_op:
|
||||
code_p = a_rb(_get_bigint, clause_has_blobsp, code_p, pass_no, cip);
|
||||
@ -2685,7 +2801,11 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
code_p = a_rc(_put_atom, code_p, pass_no, cip);
|
||||
break;
|
||||
case put_float_op:
|
||||
code_p = a_rd(_put_float, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case put_longint_op:
|
||||
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);
|
||||
break;
|
||||
@ -2736,10 +2856,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
code_p = a_ucons(&do_not_optimise_uatom, unify_atom_op, code_p, pass_no, cip);
|
||||
break;
|
||||
case unify_float_op:
|
||||
code_p = a_ublob(cip->cpc->rnd1, _unify_float, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
|
||||
code_p = a_ud(_unify_float, _unify_float_write, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case unify_longint_op:
|
||||
code_p = a_ublob(cip->cpc->rnd1, _unify_longint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
|
||||
code_p = a_ui(_unify_longint, _unify_longint_write, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case unify_bigint_op:
|
||||
code_p = a_ublob(cip->cpc->rnd1, _unify_bigint, _unify_atom_write, clause_has_blobsp, code_p, pass_no, cip);
|
||||
@ -2749,10 +2869,10 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
code_p = a_uc(cip->cpc->rnd1, _unify_l_atom, _unify_l_atom_write, code_p, pass_no);
|
||||
break;
|
||||
case unify_last_float_op:
|
||||
code_p = a_ublob(cip->cpc->rnd1, _unify_l_float, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
|
||||
code_p = a_ud(_unify_l_float, _unify_l_float_write, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case unify_last_longint_op:
|
||||
code_p = a_ublob(cip->cpc->rnd1, _unify_l_longint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
|
||||
code_p = a_ui(_unify_l_longint, _unify_l_longint_write, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case unify_last_bigint_op:
|
||||
code_p = a_ublob(cip->cpc->rnd1, _unify_l_bigint, _unify_l_atom_write, clause_has_blobsp, code_p, pass_no, cip);
|
||||
@ -2762,7 +2882,11 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
|
||||
code_p = a_ucons(&do_not_optimise_uatom, write_atom_op, code_p, pass_no, cip);
|
||||
break;
|
||||
case write_float_op:
|
||||
code_p = a_wd(_write_float, code_p, pass_no, cip->cpc);
|
||||
break;
|
||||
case write_longint_op:
|
||||
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);
|
||||
break;
|
||||
|
||||
53
C/cdmgr.c
53
C/cdmgr.c
@ -11,8 +11,12 @@
|
||||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2006-08-07 18:51:44 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.190 2006/08/07 18:51:44 vsc
|
||||
* fix garbage collector not to try to garbage collect when we ask for large
|
||||
* chunks of stack in a single go.
|
||||
*
|
||||
* Revision 1.189 2006/05/24 02:35:39 vsc
|
||||
* make chr work and other minor fixes.
|
||||
*
|
||||
@ -551,6 +555,10 @@ static Term BlobTermAdjust(Term t)
|
||||
|
||||
#include "rclause.h"
|
||||
|
||||
#ifdef DEBUG
|
||||
static UInt total_megaclause, total_released, nof_megaclauses;
|
||||
#endif
|
||||
|
||||
void
|
||||
Yap_BuildMegaClause(PredEntry *ap)
|
||||
{
|
||||
@ -588,6 +596,11 @@ Yap_BuildMegaClause(PredEntry *ap)
|
||||
sz -= (UInt)NEXTOP((yamop *)NULL,p) + sizeof(StaticClause);
|
||||
}
|
||||
required = sz*ap->cs.p_code.NOfClauses+sizeof(MegaClause)+(UInt)NEXTOP((yamop *)NULL,l);
|
||||
#ifdef DEBUG
|
||||
total_megaclause += required;
|
||||
total_released += ap->cs.p_code.NOfClauses*(sz+sizeof(StaticClause));
|
||||
nof_megaclauses++;
|
||||
#endif
|
||||
while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
|
||||
if (!Yap_growheap(FALSE, sizeof(consult_obj)*ConsultCapacity, NULL)) {
|
||||
/* just fail, the system will keep on going */
|
||||
@ -615,7 +628,6 @@ Yap_BuildMegaClause(PredEntry *ap)
|
||||
cl = cl->ClNext;
|
||||
}
|
||||
ptr->opc = Yap_opcode(_Ystop);
|
||||
ptr->u.l.l = mcl->ClCode;
|
||||
cl =
|
||||
ClauseCodeToStaticClause(ap->cs.p_code.FirstClause);
|
||||
/* recover the space spent on the original clauses */
|
||||
@ -3921,11 +3933,19 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
|
||||
case _put_unsafe:
|
||||
pc = NEXTOP(pc,yx);
|
||||
break;
|
||||
/* instructions type xd */
|
||||
case _get_float:
|
||||
case _put_float:
|
||||
pc = NEXTOP(pc,xd);
|
||||
break;
|
||||
/* instructions type xi */
|
||||
case _get_longint:
|
||||
case _put_longint:
|
||||
pc = NEXTOP(pc,xi);
|
||||
break;
|
||||
/* instructions type xc */
|
||||
case _get_atom:
|
||||
case _put_atom:
|
||||
case _get_float:
|
||||
case _get_longint:
|
||||
case _get_bigint:
|
||||
pc = NEXTOP(pc,xc);
|
||||
break;
|
||||
@ -4023,15 +4043,24 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
|
||||
case _unify_l_n_voids:
|
||||
pc = NEXTOP(pc,os);
|
||||
break;
|
||||
/* instructions type od */
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
pc = NEXTOP(pc,od);
|
||||
break;
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
case _unify_longint_write:
|
||||
case _unify_l_longint_write:
|
||||
pc = NEXTOP(pc,oi);
|
||||
break;
|
||||
/* instructions type oc */
|
||||
case _unify_atom_write:
|
||||
case _unify_atom:
|
||||
case _unify_l_atom_write:
|
||||
case _unify_l_atom:
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
case _unify_bigint:
|
||||
case _unify_l_bigint:
|
||||
pc = NEXTOP(pc,oc);
|
||||
@ -4063,6 +4092,14 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
|
||||
case _write_atom:
|
||||
pc = NEXTOP(pc,c);
|
||||
break;
|
||||
/* instructions type d */
|
||||
case _write_float:
|
||||
pc = NEXTOP(pc,d);
|
||||
break;
|
||||
/* instructions type i */
|
||||
case _write_longint:
|
||||
pc = NEXTOP(pc,i);
|
||||
break;
|
||||
/* instructions type sc */
|
||||
case _write_n_atoms:
|
||||
pc = NEXTOP(pc,sc);
|
||||
|
||||
91
C/compiler.c
91
C/compiler.c
@ -11,8 +11,11 @@
|
||||
* File: compiler.c *
|
||||
* comments: Clause compiler *
|
||||
* *
|
||||
* Last rev: $Date: 2006-08-01 13:14:17 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.79 2006/08/01 13:14:17 vsc
|
||||
* fix compilation of |
|
||||
*
|
||||
* Revision 1.78 2006/07/27 19:04:56 vsc
|
||||
* fix nasty overflows in and add some very preliminary support for very large
|
||||
* clauses with lots
|
||||
@ -560,54 +563,41 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
|
||||
write_atom_op), (CELL) t, Zero, &cglobs->cint);
|
||||
} else if (IsIntegerTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t)) {
|
||||
if (!IsIntTerm(t)) {
|
||||
/* we are taking a blob, that is a binary that is supposed to be
|
||||
guarded in the clause itself. Possible examples include
|
||||
floats, long ints, bignums, bitmaps.... */
|
||||
CELL l1 = ++cglobs->labelno;
|
||||
CELL *src = RepAppl(t);
|
||||
PInstr *ocpc = cglobs->cint.cpc, *OCodeStart = cglobs->cint.CodeStart;
|
||||
|
||||
/* use a special list to store the blobs */
|
||||
cglobs->cint.cpc = cglobs->cint.icpc;
|
||||
/* if (IsFloatTerm(t)) {
|
||||
Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
|
||||
}*/
|
||||
Yap_emit(label_op, l1, Zero, &cglobs->cint);
|
||||
if (IsFloatTerm(t)) {
|
||||
/* let us do floats first */
|
||||
CELL *dest =
|
||||
Yap_emit_extra_size(blob_op,
|
||||
(CELL)(SIZEOF_DOUBLE/SIZEOF_LONG_INT+1),
|
||||
(1+SIZEOF_DOUBLE/SIZEOF_LONG_INT)*CellSize, &cglobs->cint);
|
||||
/* copy the float bit by bit */
|
||||
dest[0] = src[0];
|
||||
dest[1] = src[1];
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
|
||||
dest[2] = src[2];
|
||||
#endif
|
||||
/* note that we don't need to copy size info, unless we wanted
|
||||
to garbage collect clauses ;-) */
|
||||
cglobs->cint.icpc = cglobs->cint.cpc;
|
||||
if (cglobs->cint.BlobsStart == NULL)
|
||||
cglobs->cint.BlobsStart = cglobs->cint.CodeStart;
|
||||
cglobs->cint.cpc = ocpc;
|
||||
cglobs->cint.CodeStart = OCodeStart;
|
||||
/* The argument to pass to the structure is now the label for
|
||||
where we are storing the blob */
|
||||
if (level == 0)
|
||||
Yap_emit((cglobs->onhead ? get_float_op : put_float_op), l1, argno, &cglobs->cint);
|
||||
Yap_emit((cglobs->onhead ? get_float_op : put_float_op), t, argno, &cglobs->cint);
|
||||
else
|
||||
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_float_op
|
||||
: unify_float_op) :
|
||||
write_float_op), l1, Zero, &cglobs->cint);
|
||||
#if USE_GMP
|
||||
} else if (IsBigIntTerm(t)) {
|
||||
/* next, let us do bigints */
|
||||
write_float_op), t, Zero, &cglobs->cint);
|
||||
} else if (IsLongIntTerm(t)) {
|
||||
if (level == 0)
|
||||
Yap_emit((cglobs->onhead ? get_longint_op : put_longint_op), t, argno, &cglobs->cint);
|
||||
else
|
||||
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_longint_op
|
||||
: unify_longint_op) :
|
||||
write_longint_op), t, Zero, &cglobs->cint);
|
||||
} else {
|
||||
/* we are taking a blob, that is a binary that is supposed to be
|
||||
guarded in the clause itself. Possible examples include
|
||||
floats, long ints, bignums, bitmaps.... */
|
||||
CELL l1 = ++cglobs->labelno;
|
||||
CELL *src = RepAppl(t);
|
||||
PInstr *ocpc = cglobs->cint.cpc, *OCodeStart = cglobs->cint.CodeStart;
|
||||
Int sz = sizeof(CELL)+
|
||||
sizeof(MP_INT)+
|
||||
((((MP_INT *)(RepAppl(t)+1))->_mp_alloc)*sizeof(mp_limb_t));
|
||||
CELL *dest =
|
||||
CELL *dest;
|
||||
|
||||
/* use a special list to store the blobs */
|
||||
cglobs->cint.cpc = cglobs->cint.icpc;
|
||||
/* if (IsFloatTerm(t)) {
|
||||
Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
|
||||
}*/
|
||||
Yap_emit(label_op, l1, Zero, &cglobs->cint);
|
||||
dest =
|
||||
Yap_emit_extra_size(blob_op, sz/CellSize, sz, &cglobs->cint);
|
||||
|
||||
/* copy the bignum */
|
||||
memcpy(dest, src, sz);
|
||||
/* note that we don't need to copy size info, unless we wanted
|
||||
@ -625,27 +615,6 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
|
||||
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_bigint_op
|
||||
: unify_bigint_op) :
|
||||
write_bigint_op), l1, Zero, &cglobs->cint);
|
||||
#endif
|
||||
} else {
|
||||
/* for now, it's just a long int */
|
||||
CELL *dest =
|
||||
Yap_emit_extra_size(blob_op,
|
||||
2,
|
||||
2*CellSize, &cglobs->cint);
|
||||
/* copy the long int in one fell swoop */
|
||||
dest[0] = src[0];
|
||||
dest[1] = src[1];
|
||||
cglobs->cint.icpc = cglobs->cint.cpc;
|
||||
if (cglobs->cint.BlobsStart == NULL)
|
||||
cglobs->cint.BlobsStart = cglobs->cint.CodeStart;
|
||||
cglobs->cint.cpc = ocpc;
|
||||
cglobs->cint.CodeStart = OCodeStart;
|
||||
if (level == 0)
|
||||
Yap_emit((cglobs->onhead ? get_longint_op : put_longint_op), l1, argno, &cglobs->cint);
|
||||
else
|
||||
Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_longint_op
|
||||
: unify_longint_op) :
|
||||
write_longint_op), l1, Zero, &cglobs->cint);
|
||||
}
|
||||
/* That's it folks! */
|
||||
return;
|
||||
|
||||
@ -11,8 +11,14 @@
|
||||
* File: computils.c *
|
||||
* comments: some useful routines for YAP's compiler *
|
||||
* *
|
||||
* Last rev: $Date: 2005-12-05 17:16:10 $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.29 2005/12/05 17:16:10 vsc
|
||||
* write_depth/3
|
||||
* overflow handlings and garbage collection
|
||||
* Several ipdates to CLPBN
|
||||
* dif/2 could be broken in the presence of attributed variables.
|
||||
*
|
||||
* Revision 1.28 2005/09/08 22:06:44 rslopes
|
||||
* BEAM for YAP update...
|
||||
*
|
||||
@ -487,6 +493,9 @@ ShowOp (char *f, struct PSEUDO *cpc)
|
||||
Yap_DebugErrorPutc ('\t');
|
||||
Yap_DebugPlWrite (MkIntTerm (rn & 1));
|
||||
break;
|
||||
case 'w':
|
||||
Yap_DebugPlWrite (arg);
|
||||
break;
|
||||
case 'o':
|
||||
Yap_DebugPlWrite ((Term) * cptr++);
|
||||
case 'c':
|
||||
@ -552,11 +561,11 @@ static char *opformat[] =
|
||||
"put_atom\t%a,%r",
|
||||
"get_num\t\t%n,%r",
|
||||
"put_num\t\t%n,%r",
|
||||
"get_float\t\t%l,%r",
|
||||
"put_float\t\t%l,%r",
|
||||
"get_float\t\t%w,%r",
|
||||
"put_float\t\t%w,%r",
|
||||
"align_float",
|
||||
"get_longint\t\t%l,%r",
|
||||
"put_longint\t\t%l,%r",
|
||||
"get_longint\t\t%w,%r",
|
||||
"put_longint\t\t%w,%r",
|
||||
"get_bigint\t\t%l,%r",
|
||||
"put_bigint\t\t%l,%r",
|
||||
"get_list\t%r",
|
||||
@ -572,10 +581,10 @@ static char *opformat[] =
|
||||
"write_atom\t%a",
|
||||
"unify_num\t%n",
|
||||
"write_num\t%n",
|
||||
"unify_float\t%l",
|
||||
"write_float\t%l",
|
||||
"unify_longint\t%l",
|
||||
"write_longint\t%l",
|
||||
"unify_float\t%w",
|
||||
"write_float\t%w",
|
||||
"unify_longint\t%w",
|
||||
"write_longint\t%w",
|
||||
"unify_bigint\t%l",
|
||||
"write_bigint\t%l",
|
||||
"unify_list",
|
||||
@ -640,8 +649,8 @@ static char *opformat[] =
|
||||
"unify_last_local\t%v",
|
||||
"unify_last_atom\t%a",
|
||||
"unify_last_num\t%n",
|
||||
"unify_last_float\t%l",
|
||||
"unify_last_longint\t%l",
|
||||
"unify_last_float\t%w",
|
||||
"unify_last_longint\t%w",
|
||||
"unify_last_bigint\t%l",
|
||||
"pvar_bitmap\t%l,%b",
|
||||
"pvar_live_regs\t%l,%b",
|
||||
|
||||
192
C/dbase.c
192
C/dbase.c
@ -135,7 +135,6 @@ typedef struct idb_queue
|
||||
#define LARGE_IDB_LINK_TABLE 1
|
||||
|
||||
/* traditionally, YAP used a link table to recover IDB terms*/
|
||||
#define IDB_LINK_TABLE 1
|
||||
#if LARGE_IDB_LINK_TABLE
|
||||
typedef BITS32 link_entry;
|
||||
#define SIZEOF_LINK_ENTRY 4
|
||||
@ -143,15 +142,11 @@ typedef BITS32 link_entry;
|
||||
typedef BITS16 link_entry;
|
||||
#define SIZEOF_LINK_ENTRY 2
|
||||
#endif
|
||||
/* a second alternative is to just use a tag */
|
||||
/*#define IDB_USE_MBIT 1*/
|
||||
|
||||
/* These global variables are necessary to build the data base
|
||||
structure */
|
||||
typedef struct db_globs {
|
||||
#ifdef IDB_LINK_TABLE
|
||||
link_entry *lr, *LinkAr;
|
||||
#endif
|
||||
/* we cannot call Error directly from within recorded(). These flags are used
|
||||
to delay for a while
|
||||
*/
|
||||
@ -180,12 +175,7 @@ typedef table {
|
||||
#endif
|
||||
|
||||
STATIC_PROTO(CELL *cpcells,(CELL *,CELL*,Int));
|
||||
#ifdef IDB_LINK_TABLE
|
||||
STATIC_PROTO(void linkblk,(link_entry *,CELL *,CELL));
|
||||
#endif
|
||||
#ifdef IDB_USE_MBIT
|
||||
STATIC_PROTO(CELL *linkcells,(CELL *,Int));
|
||||
#endif
|
||||
STATIC_PROTO(Int cmpclls,(CELL *,CELL *,Int));
|
||||
STATIC_PROTO(Prop FindDBProp,(AtomEntry *, int, unsigned int, Term));
|
||||
STATIC_PROTO(CELL CalcKey, (Term));
|
||||
@ -199,9 +189,7 @@ STATIC_PROTO(DBRef record, (int, Term, Term, Term));
|
||||
STATIC_PROTO(DBRef check_if_cons, (DBRef, Term));
|
||||
STATIC_PROTO(DBRef check_if_var, (DBRef));
|
||||
STATIC_PROTO(DBRef check_if_wvars, (DBRef, unsigned int, CELL *));
|
||||
#ifdef IDB_LINK_TABLE
|
||||
STATIC_PROTO(int scheckcells, (int, CELL *, CELL *, link_entry *, CELL));
|
||||
#endif
|
||||
STATIC_PROTO(DBRef check_if_nvars, (DBRef, unsigned int, CELL *, struct db_globs *));
|
||||
STATIC_PROTO(Int p_rcda, (void));
|
||||
STATIC_PROTO(Int p_rcdap, (void));
|
||||
@ -350,7 +338,6 @@ static void remove_from_table() {
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef IDB_LINK_TABLE
|
||||
inline static CELL *cpcells(CELL *to, CELL *from, Int n)
|
||||
{
|
||||
#if HAVE_MEMMOVE
|
||||
@ -374,37 +361,6 @@ static void linkblk(link_entry *r, CELL *c, CELL offs)
|
||||
c[p] = AdjustIDBPtr(t, offs);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef IDB_USE_MBIT
|
||||
inline static CELL *cpcells(register CELL *to, register CELL *from, Int n)
|
||||
{
|
||||
CELL *last = to + n;
|
||||
register CELL off = ((CELL)to)-MBIT;
|
||||
while (to <= last) {
|
||||
register d0 = *from++;
|
||||
if (MARKED(d0))
|
||||
*to++ = AdjustIDBPtr(d0, off);
|
||||
else
|
||||
*to++ = d0;
|
||||
}
|
||||
return(to);
|
||||
}
|
||||
|
||||
static CELL *linkcells(register CELL *to, Int n)
|
||||
{
|
||||
CELL *last = to + n;
|
||||
register CELL off = ((CELL)to)-MBIT;
|
||||
while(to <= last) {
|
||||
register d0 = *to++;
|
||||
if (MARKED(d0))
|
||||
to[-1] = AdjustIDBPtr(d0, off);
|
||||
}
|
||||
return(to);
|
||||
}
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
static Int cmpclls(CELL *a,CELL *b,Int n)
|
||||
{
|
||||
@ -417,12 +373,7 @@ static Int cmpclls(CELL *a,CELL *b,Int n)
|
||||
#if !THREADS
|
||||
int Yap_DBTrailOverflow()
|
||||
{
|
||||
#ifdef IDB_USE_MBIT
|
||||
return(FALSE);
|
||||
#endif
|
||||
#ifdef IDB_LINK_TABLE
|
||||
return((CELL *)s_dbg->lr > (CELL *)s_dbg->tofref - 2048);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
|
||||
@ -725,10 +676,8 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
continue;
|
||||
}
|
||||
#endif
|
||||
#ifdef IDB_LINK_TABLE
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall((CELL)(StoPoint)-(CELL)(tbase));
|
||||
#endif
|
||||
f = (Functor)(*ap2);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
switch((CELL)f) {
|
||||
@ -738,9 +687,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
/* store now the correct entry */
|
||||
dbentry = DBRefOfTerm(d0);
|
||||
*StoPoint++ = d0;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
dbg->lr--;
|
||||
#endif
|
||||
if (dbentry->Flags & LogUpdMask) {
|
||||
LogUpdClause *cl = (LogUpdClause *)dbentry;
|
||||
|
||||
@ -755,11 +702,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
continue;
|
||||
}
|
||||
case (CELL)FunctorLongInt:
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ = AbsAppl(CodeMax)|MBIT;
|
||||
#else
|
||||
*StoPoint++ = AbsAppl(CodeMax);
|
||||
#endif
|
||||
CheckDBOverflow(3);
|
||||
CodeMax = copy_long_int(CodeMax, ap2);
|
||||
++pt0;
|
||||
@ -768,11 +711,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
case (CELL)FunctorBigInt:
|
||||
CheckDBOverflow(2+Yap_SizeOfBigInt(d0));
|
||||
/* first thing, store a link to the list before we move on */
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ = AbsAppl(CodeMax)|MBIT;
|
||||
#else
|
||||
*StoPoint++ = AbsAppl(CodeMax);
|
||||
#endif
|
||||
CodeMax = copy_big_int(CodeMax, ap2);
|
||||
++pt0;
|
||||
continue;
|
||||
@ -783,11 +722,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
|
||||
CheckDBOverflow(4);
|
||||
/* first thing, store a link to the list before we move on */
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ = AbsAppl(st)|MBIT;
|
||||
#else
|
||||
*StoPoint++ = AbsAppl(st);
|
||||
#endif
|
||||
CodeMax = copy_double(CodeMax, ap2);
|
||||
++pt0;
|
||||
continue;
|
||||
@ -795,11 +730,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
}
|
||||
}
|
||||
/* first thing, store a link to the list before we move on */
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ = AbsAppl(CodeMax)|MBIT;
|
||||
#else
|
||||
*StoPoint++ = AbsAppl(CodeMax);
|
||||
#endif
|
||||
/* next, postpone analysis to the rest of the current list */
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0+1;
|
||||
@ -832,7 +763,6 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
}
|
||||
else if (IsPairTerm(d0)) {
|
||||
/* we will need to link afterwards */
|
||||
#ifdef RATIONAL_TREES
|
||||
CELL *ap2 = RepPair(d0);
|
||||
if (ap2 >= tbase && ap2 < StoPoint) {
|
||||
*StoPoint++ = d0;
|
||||
@ -841,17 +771,60 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
++pt0;
|
||||
continue;
|
||||
}
|
||||
#endif
|
||||
#ifdef IDB_LINK_TABLE
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall((CELL)(StoPoint)-(CELL)(tbase));
|
||||
#endif
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint++ =
|
||||
AbsPair(CodeMax)|MBIT;
|
||||
#else
|
||||
*StoPoint++ = AbsPair(CodeMax);
|
||||
#endif
|
||||
if (IsAtomOrIntTerm(Deref(ap2[0])) &&
|
||||
IsPairTerm(Deref(ap2[1]))) {
|
||||
/* shortcut for [1,2,3,4,5] */
|
||||
Term tt = Deref(ap2[1]);
|
||||
Term th = Deref(ap2[0]);
|
||||
Int direction = RepPair(tt)-ap2;
|
||||
CELL *OldStoPoint;
|
||||
CELL *lp;
|
||||
|
||||
if (direction < 0)
|
||||
direction = -1;
|
||||
else
|
||||
direction = 1;
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall((CELL)(StoPoint)-(CELL)(tbase));
|
||||
*StoPoint++ = AbsPair(CodeMax);
|
||||
OldStoPoint = StoPoint;
|
||||
do {
|
||||
lp = RepPair(tt);
|
||||
|
||||
if (lp >= tbase && lp < StoPoint) {
|
||||
break;
|
||||
}
|
||||
CheckDBOverflow(2);
|
||||
CodeMax[0] = th;
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall((CELL)(CodeMax+1)-(CELL)(tbase));
|
||||
CodeMax[1] = AbsPair(CodeMax+2);
|
||||
CodeMax+=2;
|
||||
th = Deref(lp[0]);
|
||||
tt = Deref(lp[1]);
|
||||
} while (IsAtomOrIntTerm(th) &&
|
||||
IsPairTerm(tt) &&
|
||||
/* have same direction to avoid infinite terms X = [a|X] */
|
||||
(RepPair(tt)-lp)*direction > 0);
|
||||
if (lp >= tbase && lp < StoPoint) {
|
||||
CodeMax[-1] = tt;
|
||||
break;
|
||||
}
|
||||
if (IsAtomOrIntTerm(th) && IsAtomOrIntTerm(tt)) {
|
||||
CheckDBOverflow(2);
|
||||
CodeMax[0] = th;
|
||||
CodeMax[1] = tt;
|
||||
CodeMax+=2;
|
||||
++pt0;
|
||||
continue;
|
||||
}
|
||||
d0 = AbsPair(lp);
|
||||
StoPoint = OldStoPoint;
|
||||
} else {
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall((CELL)(StoPoint)-(CELL)(tbase));
|
||||
*StoPoint++ = AbsPair(CodeMax);
|
||||
}
|
||||
/* next, postpone analysis to the rest of the current list */
|
||||
#ifdef RATIONAL_TREES
|
||||
to_visit[0] = pt0+1;
|
||||
@ -918,20 +891,12 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
#if SBA
|
||||
/* the copy we keep will be an empty variable */
|
||||
*StoPoint++ = 0;
|
||||
#else
|
||||
#ifdef IDB_USE_MBIT
|
||||
/* say we've seen the variable, and make it point to its
|
||||
offset */
|
||||
/* the copy we keep will be the current displacement */
|
||||
*StoPoint = ((CELL)StoPoint | MBIT);
|
||||
StoPoint++;
|
||||
#else
|
||||
/* the copy we keep will be the current displacement */
|
||||
*StoPoint = (CELL)StoPoint;
|
||||
StoPoint++;
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall(displacement);
|
||||
#endif
|
||||
#endif
|
||||
/* indicate we found variables */
|
||||
vars_found++;
|
||||
@ -960,16 +925,10 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
continue;
|
||||
} else {
|
||||
/* references need to be offset at read time */
|
||||
#ifdef IDB_LINK_TABLE
|
||||
db_check_trail(dbg->lr+1);
|
||||
*dbg->lr++ = ToSmall(displacement);
|
||||
#endif
|
||||
/* store the offset */
|
||||
#ifdef IDB_USE_MBIT
|
||||
*StoPoint = d0 | MBIT;
|
||||
#else
|
||||
*StoPoint = d0;
|
||||
#endif
|
||||
StoPoint++;
|
||||
continue;
|
||||
}
|
||||
@ -1192,8 +1151,6 @@ check_if_wvars(DBRef p, unsigned int NOfCells, CELL *BTptr)
|
||||
return (NIL);
|
||||
}
|
||||
|
||||
#ifdef IDB_LINK_TABLE
|
||||
|
||||
static int
|
||||
scheckcells(int NOfCells, register CELL *m1, register CELL *m2, link_entry *lp, register CELL bp)
|
||||
{
|
||||
@ -1226,7 +1183,6 @@ scheckcells(int NOfCells, register CELL *m1, register CELL *m2, link_entry *lp,
|
||||
}
|
||||
return (TRUE);
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
* the cousin of the previous, but with things a bit more sophisticated.
|
||||
@ -1244,12 +1200,7 @@ check_if_nvars(DBRef p, unsigned int NOfCells, CELL *BTptr, struct db_globs *dbg
|
||||
if (p == NIL)
|
||||
return (p);
|
||||
memptr = CellPtr(p->DBT.Contents);
|
||||
#ifdef IDB_LINK_TABLE
|
||||
if (scheckcells(NOfCells, memptr, BTptr, dbg->LinkAr, Unsigned(p->DBT.Contents-1)))
|
||||
#else
|
||||
if (NOfCells == *memptr++
|
||||
&& cmpclls(memptr, BTptr, NOfCells))
|
||||
#endif
|
||||
return (p);
|
||||
else
|
||||
p = NextDBRef(p);
|
||||
@ -1403,9 +1354,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
{
|
||||
Register Term tt, *nar = NIL;
|
||||
SMALLUNSGN flag;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
int NOfLinks = 0;
|
||||
#endif
|
||||
/* place DBRefs in ConsultStack */
|
||||
DBRef *TmpRefBase = (DBRef *)Yap_TrailTop;
|
||||
CELL *CodeAbs; /* how much code did we find */
|
||||
@ -1468,9 +1417,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
return NULL;
|
||||
}
|
||||
ntp0 = ppt0->Contents;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
dbg->lr = dbg->LinkAr = (link_entry *)TR;
|
||||
#endif
|
||||
#ifdef COROUTINING
|
||||
/* attachment */
|
||||
if (IsVarTerm(Tm)) {
|
||||
@ -1544,10 +1491,8 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
return (NULL); /* Error Situation */
|
||||
}
|
||||
NOfCells = ntp - ntp0; /* End Of Code Info */
|
||||
#ifdef IDB_LINK_TABLE
|
||||
*dbg->lr++ = 0;
|
||||
NOfLinks = (dbg->lr - dbg->LinkAr);
|
||||
#endif
|
||||
if (vars_found || InFlag & InQueue) {
|
||||
|
||||
/*
|
||||
@ -1555,7 +1500,6 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
* for the number of links
|
||||
*/
|
||||
flag = DBComplex;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
CodeAbs += CellPtr(dbg->lr) - CellPtr(dbg->LinkAr);
|
||||
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
|
||||
Yap_Error_Size = (UInt)DBLength(CodeAbs);
|
||||
@ -1563,7 +1507,6 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
|
||||
return(NULL);
|
||||
}
|
||||
#endif
|
||||
if ((InFlag & MkIfNot) && (dbg->found_one = check_if_wvars(p->First, NOfCells, ntp0))) {
|
||||
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
|
||||
return dbg->found_one;
|
||||
@ -1585,13 +1528,11 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
}
|
||||
flag |= DBWithRefs;
|
||||
}
|
||||
#ifdef IDB_LINK_TABLE
|
||||
#if SIZEOF_LINK_ENTRY==2
|
||||
if (Unsigned(CodeAbs) >= 0x40000) {
|
||||
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
|
||||
return generate_dberror_msg(SYSTEM_ERROR, 0, "trying to store term larger than 256KB");
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
if (p == NULL) {
|
||||
ADDR ptr = Yap_AllocCodeSpace((CELL)CodeAbs+extra_size+sizeof(DBTerm));
|
||||
@ -1614,9 +1555,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
ppt = &(pp->DBT);
|
||||
}
|
||||
if (flag & DBComplex) {
|
||||
#ifdef IDB_LINK_TABLE
|
||||
link_entry *woar;
|
||||
#endif /* IDB_LINK_TABLE */
|
||||
|
||||
ppt->NOfCells = NOfCells;
|
||||
#ifdef COROUTINING
|
||||
@ -1624,18 +1563,10 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
#endif
|
||||
if (pp0 != pp) {
|
||||
nar = ppt->Contents;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
nar = (Term *) cpcells(CellPtr(nar), ntp0, Unsigned(NOfCells));
|
||||
#endif
|
||||
#ifdef IDB_USE_MBIT
|
||||
memcpy((void *)nar, (const void *)ntp0,
|
||||
(size_t)((NOfCells+1)*sizeof(CELL)));
|
||||
nar += NOfCells+1;
|
||||
#endif
|
||||
} else {
|
||||
nar = ppt->Contents + Unsigned(NOfCells);
|
||||
}
|
||||
#ifdef IDB_LINK_TABLE
|
||||
woar = (link_entry *)nar;
|
||||
memcpy((void *)woar,(const void *)dbg->LinkAr,(size_t)(NOfLinks*sizeof(link_entry)));
|
||||
woar += NOfLinks;
|
||||
@ -1649,26 +1580,17 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
||||
#endif
|
||||
#endif
|
||||
nar = (Term *) (woar);
|
||||
#endif
|
||||
*pstat = TRUE;
|
||||
} else if (flag & DBNoVars) {
|
||||
if (pp0 != pp) {
|
||||
nar = (Term *) cpcells(CellPtr(ppt->Contents), ntp0, Unsigned(NOfCells));
|
||||
} else {
|
||||
#ifdef IDB_LINK_TABLE
|
||||
nar = ppt->Contents + Unsigned(NOfCells);
|
||||
#endif
|
||||
#ifdef IDB_USE_MBIT
|
||||
/* we still need to link */
|
||||
nar = (Term *) linkcells(ntp0, NOfCells);
|
||||
#endif
|
||||
}
|
||||
ppt->NOfCells = NOfCells;
|
||||
}
|
||||
if (ppt != ppt0) {
|
||||
#ifdef IDB_LINK_TABLE
|
||||
linkblk(dbg->LinkAr, CellPtr(ppt->Contents-1), (CELL)ppt-(CELL)ppt0);
|
||||
#endif
|
||||
ppt->Entry = AdjustIDBPtr(tt,(CELL)ppt-(CELL)ppt0);
|
||||
#ifdef COROUTINING
|
||||
if (attachments)
|
||||
@ -2354,7 +2276,6 @@ p_still_variant(void)
|
||||
return IsVarTerm(t2);
|
||||
dbt = &(dbr->DBT);
|
||||
}
|
||||
#ifdef IDB_LINK_TABLE
|
||||
/*
|
||||
we checked the trail, so we are sure only variables in the new term
|
||||
were bound
|
||||
@ -2377,9 +2298,6 @@ p_still_variant(void)
|
||||
}
|
||||
}
|
||||
}
|
||||
#else /* IDB_LINK_TABLE */
|
||||
not IMPLEMENTED;
|
||||
#endif
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
@ -2517,12 +2435,10 @@ GetDBTerm(DBTerm *DBSP)
|
||||
HeapPtr = cpcells(HOld, pt, NOf);
|
||||
pt += HeapPtr - HOld;
|
||||
H = HeapPtr;
|
||||
#ifdef IDB_LINK_TABLE
|
||||
{
|
||||
link_entry *lp = (link_entry *)pt;
|
||||
linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents));
|
||||
}
|
||||
#endif
|
||||
#ifdef COROUTINING
|
||||
if (DBSP->attachments != 0L) {
|
||||
if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->attachments,(CELL)HOld-(CELL)(DBSP->Contents)))) {
|
||||
|
||||
@ -709,6 +709,7 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
|
||||
if (IsExtensionFunctor(f)) {
|
||||
switch((CELL)f) {
|
||||
case (CELL)FunctorDBRef:
|
||||
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
|
||||
return t;
|
||||
case (CELL)FunctorLongInt:
|
||||
if (H > ASP - (128+3)) {
|
||||
|
||||
17
C/grow.c
17
C/grow.c
@ -722,17 +722,23 @@ fix_compiler_instructions(PInstr *pcpc)
|
||||
case fetch_args_vv_op:
|
||||
pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
|
||||
break;
|
||||
case get_float_op:
|
||||
case put_float_op:
|
||||
case get_longint_op:
|
||||
case put_longint_op:
|
||||
case unify_float_op:
|
||||
case unify_last_float_op:
|
||||
case write_float_op:
|
||||
/* floats might be in the global */
|
||||
pcpc->rnd1 = AdjustAppl(pcpc->rnd1);
|
||||
break;
|
||||
/* hopefully nothing to do */
|
||||
case nop_op:
|
||||
case get_atom_op:
|
||||
case put_atom_op:
|
||||
case get_num_op:
|
||||
case put_num_op:
|
||||
case get_float_op:
|
||||
case put_float_op:
|
||||
case align_float_op:
|
||||
case get_longint_op:
|
||||
case put_longint_op:
|
||||
case get_bigint_op:
|
||||
case put_bigint_op:
|
||||
case get_list_op:
|
||||
@ -745,9 +751,6 @@ fix_compiler_instructions(PInstr *pcpc)
|
||||
case unify_num_op:
|
||||
case unify_last_num_op:
|
||||
case write_num_op:
|
||||
case unify_float_op:
|
||||
case unify_last_float_op:
|
||||
case write_float_op:
|
||||
case unify_longint_op:
|
||||
case unify_last_longint_op:
|
||||
case write_longint_op:
|
||||
|
||||
215
C/index.c
215
C/index.c
@ -11,8 +11,13 @@
|
||||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2006-05-16 18:37:30 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.168 2006/05/16 18:37:30 vsc
|
||||
* WIN32 fixes
|
||||
* compiler bug fixes
|
||||
* extend interface
|
||||
*
|
||||
* Revision 1.167 2006/05/02 16:44:11 vsc
|
||||
* avoid uninitialised memory at overflow.
|
||||
*
|
||||
@ -1004,11 +1009,19 @@ has_cut(yamop *pc)
|
||||
case _put_unsafe:
|
||||
pc = NEXTOP(pc,yx);
|
||||
break;
|
||||
/* instructions type xd */
|
||||
case _get_float:
|
||||
case _put_float:
|
||||
pc = NEXTOP(pc,xd);
|
||||
break;
|
||||
/* instructions type xi */
|
||||
case _get_longint:
|
||||
case _put_longint:
|
||||
pc = NEXTOP(pc,xi);
|
||||
break;
|
||||
/* instructions type xc */
|
||||
case _get_atom:
|
||||
case _put_atom:
|
||||
case _get_float:
|
||||
case _get_longint:
|
||||
case _get_bigint:
|
||||
pc = NEXTOP(pc,xc);
|
||||
break;
|
||||
@ -1106,15 +1119,33 @@ has_cut(yamop *pc)
|
||||
case _unify_l_n_voids:
|
||||
pc = NEXTOP(pc,os);
|
||||
break;
|
||||
/* instructions type od */
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
pc = NEXTOP(pc,od);
|
||||
break;
|
||||
/* instructions type d */
|
||||
case _write_float:
|
||||
pc = NEXTOP(pc,d);
|
||||
break;
|
||||
/* instructions type oi */
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
case _unify_longint_write:
|
||||
case _unify_l_longint_write:
|
||||
pc = NEXTOP(pc,oi);
|
||||
break;
|
||||
/* instructions type i */
|
||||
case _write_longint:
|
||||
pc = NEXTOP(pc,i);
|
||||
break;
|
||||
/* instructions type oc */
|
||||
case _unify_atom_write:
|
||||
case _unify_atom:
|
||||
case _unify_l_atom_write:
|
||||
case _unify_l_atom:
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
case _unify_bigint:
|
||||
case _unify_l_bigint:
|
||||
pc = NEXTOP(pc,oc);
|
||||
@ -1796,21 +1827,21 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
}
|
||||
break;
|
||||
case _get_float:
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xc.x)) {
|
||||
clause->u.t_ptr = cl->u.xc.c;
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xd.x)) {
|
||||
clause->u.t_ptr = AbsAppl(cl->u.xd.d);
|
||||
clause->Tag = AbsAppl((CELL *)FunctorDouble);
|
||||
return;
|
||||
} else {
|
||||
cl = NEXTOP(cl,xc);
|
||||
cl = NEXTOP(cl,xd);
|
||||
}
|
||||
break;
|
||||
case _get_longint:
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xc.x)) {
|
||||
clause->u.t_ptr = cl->u.xc.c;
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xi.x)) {
|
||||
clause->u.t_ptr = AbsAppl(cl->u.xi.i);
|
||||
clause->Tag = AbsAppl((CELL *)FunctorLongInt);
|
||||
return;
|
||||
} else {
|
||||
cl = NEXTOP(cl,xc);
|
||||
cl = NEXTOP(cl,xi);
|
||||
}
|
||||
break;
|
||||
case _get_bigint:
|
||||
@ -1864,6 +1895,26 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
cl = NEXTOP(cl,xc);
|
||||
}
|
||||
break;
|
||||
case _put_float:
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xd.x) &&
|
||||
(nofregs = delete_regcopy(myregs, nofregs, cl->u.xd.x)) == 0 &&
|
||||
!ycopy) {
|
||||
clause->Tag = (CELL)NULL;
|
||||
return;
|
||||
} else {
|
||||
cl = NEXTOP(cl,xd);
|
||||
}
|
||||
break;
|
||||
case _put_longint:
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xi.x) &&
|
||||
(nofregs = delete_regcopy(myregs, nofregs, cl->u.xi.x)) == 0 &&
|
||||
!ycopy) {
|
||||
clause->Tag = (CELL)NULL;
|
||||
return;
|
||||
} else {
|
||||
cl = NEXTOP(cl,xi);
|
||||
}
|
||||
break;
|
||||
case _get_struct:
|
||||
if (regcopy_in(myregs, nofregs, cl->u.xf.x)) {
|
||||
clause->u.WorkPC = NEXTOP(cl,xf);
|
||||
@ -2023,11 +2074,21 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
break;
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
cl = NEXTOP(cl,oc);
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
cl = NEXTOP(cl,od);
|
||||
break;
|
||||
case _write_float:
|
||||
cl = NEXTOP(cl,d);
|
||||
break;
|
||||
case _unify_longint:
|
||||
case _unify_longint_write:
|
||||
case _unify_l_longint:
|
||||
cl = NEXTOP(cl,oc);
|
||||
case _unify_l_longint_write:
|
||||
cl = NEXTOP(cl,oi);
|
||||
break;
|
||||
case _write_longint:
|
||||
cl = NEXTOP(cl,i);
|
||||
break;
|
||||
case _unify_bigint:
|
||||
case _unify_l_bigint:
|
||||
@ -2507,21 +2568,21 @@ add_head_info(ClauseDef *clause, UInt regno)
|
||||
}
|
||||
break;
|
||||
case _get_float:
|
||||
if (cl->u.xc.x == iarg) {
|
||||
clause->u.t_ptr = cl->u.xc.c;
|
||||
if (cl->u.xd.x == iarg) {
|
||||
clause->u.t_ptr = AbsAppl(cl->u.xd.d);
|
||||
clause->Tag = AbsAppl((CELL *)FunctorDouble);
|
||||
return;
|
||||
} else {
|
||||
cl = NEXTOP(cl,xc);
|
||||
cl = NEXTOP(cl,xd);
|
||||
}
|
||||
break;
|
||||
case _get_longint:
|
||||
if (cl->u.xc.x == iarg) {
|
||||
clause->u.t_ptr = cl->u.xc.c;
|
||||
if (cl->u.xi.x == iarg) {
|
||||
clause->u.t_ptr = AbsAppl(cl->u.xi.i);
|
||||
clause->Tag = AbsAppl((CELL *)FunctorLongInt);
|
||||
return;
|
||||
} else {
|
||||
cl = NEXTOP(cl,xc);
|
||||
cl = NEXTOP(cl,xi);
|
||||
}
|
||||
break;
|
||||
case _get_bigint:
|
||||
@ -2645,11 +2706,21 @@ add_head_info(ClauseDef *clause, UInt regno)
|
||||
break;
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
cl = NEXTOP(cl,oc);
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
cl = NEXTOP(cl,od);
|
||||
break;
|
||||
case _write_float:
|
||||
cl = NEXTOP(cl,d);
|
||||
break;
|
||||
case _unify_longint:
|
||||
case _unify_longint_write:
|
||||
case _unify_l_longint:
|
||||
cl = NEXTOP(cl,oc);
|
||||
case _unify_l_longint_write:
|
||||
cl = NEXTOP(cl,oi);
|
||||
break;
|
||||
case _write_longint:
|
||||
cl = NEXTOP(cl,i);
|
||||
break;
|
||||
case _unify_bigint:
|
||||
case _unify_l_bigint:
|
||||
@ -2901,25 +2972,29 @@ add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno)
|
||||
case _unify_l_atom_write:
|
||||
cl = NEXTOP(cl,oc);
|
||||
break;
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
cl = NEXTOP(cl,od);
|
||||
break;
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
if (argno == 1) {
|
||||
clause->Tag = AbsAppl((CELL *)FunctorDouble);
|
||||
clause->u.t_ptr = cl->u.oc.c;
|
||||
clause->u.t_ptr = AbsAppl(cl->u.od.d);
|
||||
return;
|
||||
}
|
||||
cl = NEXTOP(cl,oc);
|
||||
cl = NEXTOP(cl,od);
|
||||
argno--;
|
||||
break;
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
if (argno == 1) {
|
||||
clause->Tag = AbsAppl((CELL *)FunctorLongInt);
|
||||
clause->u.t_ptr = cl->u.oc.c;
|
||||
clause->u.t_ptr = AbsAppl(cl->u.oi.i);
|
||||
return;
|
||||
}
|
||||
argno--;
|
||||
cl = NEXTOP(cl,oc);
|
||||
cl = NEXTOP(cl,oi);
|
||||
break;
|
||||
case _unify_bigint:
|
||||
case _unify_l_bigint:
|
||||
@ -3073,6 +3148,10 @@ skip_to_arg(ClauseDef *clause, PredEntry *ap, UInt argno, int at_point)
|
||||
case _unify_l_atom_write:
|
||||
cl = NEXTOP(cl,oc);
|
||||
break;
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
cl = NEXTOP(cl,od);
|
||||
break;
|
||||
case _unify_l_struc_write:
|
||||
case _unify_struct_write:
|
||||
cl = NEXTOP(cl,of);
|
||||
@ -3107,6 +3186,9 @@ valid_instructions(yamop *end, yamop *cl)
|
||||
case _get_atom:
|
||||
cl = NEXTOP(cl,xc);
|
||||
break;
|
||||
case _get_float:
|
||||
cl = NEXTOP(cl,xd);
|
||||
break;
|
||||
case _get_2atoms:
|
||||
cl = NEXTOP(cl,cc);
|
||||
break;
|
||||
@ -3139,6 +3221,12 @@ valid_instructions(yamop *end, yamop *cl)
|
||||
case _unify_l_atom_write:
|
||||
cl = NEXTOP(cl,oc);
|
||||
break;
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
cl = NEXTOP(cl,od);
|
||||
break;
|
||||
case _unify_struct:
|
||||
case _unify_struct_write:
|
||||
case _unify_l_struc:
|
||||
@ -4375,7 +4463,12 @@ 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 {
|
||||
cl->Tag = MkIntTerm(RepAppl(cl->u.t_ptr)[1]);
|
||||
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++;
|
||||
}
|
||||
@ -4582,8 +4675,15 @@ install_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
|
||||
if (f == FunctorDBRef) {
|
||||
if (cls->u.t_ptr != sp->extra) break;
|
||||
} else {
|
||||
Term t = MkIntTerm(RepAppl(sp->extra)[1]),
|
||||
t1 = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
|
||||
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;
|
||||
}
|
||||
}
|
||||
@ -4735,9 +4835,16 @@ install_log_upd_clause(ClauseDef *cls, PredEntry *ap, istack_entry *stack)
|
||||
if (f == FunctorDBRef) {
|
||||
if (cls->u.t_ptr != sp->extra) break;
|
||||
} else {
|
||||
Term t = MkIntTerm(RepAppl(sp->extra)[1]),
|
||||
t1 = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
|
||||
if (t != t1) break;
|
||||
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;
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -5153,7 +5260,11 @@ 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
|
||||
sp[-1].extra = AbsAppl(s_reg-1);
|
||||
s_reg = NULL;
|
||||
ipc = NEXTOP(ipc,e);
|
||||
@ -5573,7 +5684,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
|
||||
Atom At = NameOfFunctor(f);
|
||||
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0);
|
||||
Yap_DebugPutc(Yap_c_error_stream,'/');
|
||||
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
}
|
||||
} else {
|
||||
if (ap->ArityOfPE == 0) {
|
||||
@ -5584,7 +5695,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
|
||||
Atom At = NameOfFunctor(f);
|
||||
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0);
|
||||
Yap_DebugPutc(Yap_c_error_stream,'/');
|
||||
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
}
|
||||
}
|
||||
Yap_DebugPutc(Yap_c_error_stream,'\n');
|
||||
@ -7317,7 +7428,14 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause
|
||||
ipc = NEXTOP(ipc,e);
|
||||
break;
|
||||
case _index_blob:
|
||||
cls->Tag = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
|
||||
{
|
||||
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
|
||||
}
|
||||
ipc = NEXTOP(ipc,e);
|
||||
break;
|
||||
case _switch_on_cons:
|
||||
@ -7437,7 +7555,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
|
||||
Atom At = NameOfFunctor(f);
|
||||
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0);
|
||||
Yap_DebugPutc(Yap_c_error_stream,'/');
|
||||
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
}
|
||||
} else {
|
||||
if (ap->ArityOfPE == 0) {
|
||||
@ -7448,7 +7566,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
|
||||
Atom At = NameOfFunctor(f);
|
||||
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0);
|
||||
Yap_DebugPutc(Yap_c_error_stream,'/');
|
||||
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
}
|
||||
}
|
||||
Yap_DebugPutc(Yap_c_error_stream,'\n');
|
||||
@ -7787,7 +7905,14 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
|
||||
ipc = NEXTOP(ipc,e);
|
||||
break;
|
||||
case _index_blob:
|
||||
cls->Tag = MkIntTerm(RepAppl(cls->u.t_ptr)[1]);
|
||||
{
|
||||
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
|
||||
}
|
||||
ipc = NEXTOP(ipc,e);
|
||||
break;
|
||||
case _switch_on_cons:
|
||||
@ -7906,7 +8031,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
|
||||
Atom At = NameOfFunctor(f);
|
||||
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0);
|
||||
Yap_DebugPutc(Yap_c_error_stream,'/');
|
||||
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
}
|
||||
} else {
|
||||
if (ap->PredFlags & NumberDBPredFlag) {
|
||||
@ -7920,7 +8045,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
|
||||
Atom At = NameOfFunctor(f);
|
||||
Yap_plwrite(MkAtomTerm(At), Yap_DebugPutc, 0);
|
||||
Yap_DebugPutc(Yap_c_error_stream,'/');
|
||||
Yap_plwrite(MkIntTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
Yap_plwrite(MkIntegerTerm(ArityOfFunctor(f)), Yap_DebugPutc, 0);
|
||||
}
|
||||
}
|
||||
Yap_DebugPutc(Yap_c_error_stream,'\n');
|
||||
@ -8364,7 +8489,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
|
||||
ipc = NEXTOP(ipc,e);
|
||||
break;
|
||||
case _switch_on_cons:
|
||||
@ -8755,7 +8884,11 @@ find_caller(PredEntry *ap, yamop *code, 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
|
||||
sp[-1].val = t;
|
||||
s_reg = NULL;
|
||||
ipc = NEXTOP(ipc,e);
|
||||
|
||||
14
H/Heap.h
14
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.104 2006-08-25 19:50:35 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.105 2006-09-20 20:03:51 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -165,6 +165,10 @@ typedef struct worker_local_struct {
|
||||
struct global_entry *global_variables;
|
||||
Term global_arena;
|
||||
Term global_delay_arena;
|
||||
UInt local_timestamp;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
lockvar local_timestamp_lock;
|
||||
#endif
|
||||
yamop trust_lu_code[3];
|
||||
} worker_local;
|
||||
|
||||
@ -212,6 +216,10 @@ typedef struct various_codes {
|
||||
worker_local wl[MAX_WORKERS];
|
||||
#else
|
||||
worker_local wl;
|
||||
#endif
|
||||
UInt global_timestamp;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
lockvar global_timestamp_lock;
|
||||
#endif
|
||||
#ifdef BEAM
|
||||
yamop beam_retry_code;
|
||||
@ -562,6 +570,8 @@ struct various_codes *Yap_heap_regs;
|
||||
#define HeapMax Yap_heap_regs->heap_max
|
||||
#define HeapTop Yap_heap_regs->heap_top
|
||||
#define HeapLim Yap_heap_regs->heap_lim
|
||||
#define GlobalTimeStamp Yap_heap_regs->global_timestamp
|
||||
#define GlobalTimeStampLock Yap_heap_regs->global_timestamp_lock
|
||||
#ifdef YAPOR
|
||||
#define SEQUENTIAL_IS_DEFAULT Yap_heap_regs->seq_def
|
||||
#define GETWORK (&(Yap_heap_regs->getwork_code))
|
||||
@ -893,6 +903,8 @@ struct various_codes *Yap_heap_regs;
|
||||
#define GlobalVariables Yap_heap_regs->WL.global_variables
|
||||
#define GlobalArena Yap_heap_regs->WL.global_arena
|
||||
#define GlobalDelayArena Yap_heap_regs->WL.global_delay_arena
|
||||
#define LocalTimeStamp Yap_heap_regs->WL.local_timestamp
|
||||
#define LocalTimeStampLock Yap_heap_regs->WL.local_timestamp_lock
|
||||
#define profiling Yap_heap_regs->compiler_profiling
|
||||
#define call_counting Yap_heap_regs->compiler_call_counting
|
||||
#define compile_arrays Yap_heap_regs->compiler_compile_arrays
|
||||
|
||||
@ -11,8 +11,11 @@
|
||||
* File: YapOpcodes.h *
|
||||
* comments: Central Table with all YAP opcodes *
|
||||
* *
|
||||
* Last rev: $Date: 2006-04-27 14:13:24 $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.38 2006/04/27 14:13:24 rslopes
|
||||
* *** empty log message ***
|
||||
*
|
||||
* Revision 1.37 2006/03/24 16:34:21 rslopes
|
||||
* New update to BEAM engine.
|
||||
* BEAM now uses YAP Indexing (JITI)
|
||||
@ -172,8 +175,8 @@
|
||||
OPCODE(get_4atoms ,cccc), /* peephole */
|
||||
OPCODE(get_5atoms ,ccccc), /* peephole */
|
||||
OPCODE(get_6atoms ,cccccc), /* peephole */
|
||||
OPCODE(get_float ,xc),
|
||||
OPCODE(get_longint ,xc),
|
||||
OPCODE(get_float ,xd),
|
||||
OPCODE(get_longint ,xi),
|
||||
OPCODE(get_bigint ,xc),
|
||||
OPCODE(get_list ,x),
|
||||
OPCODE(get_struct ,xf),
|
||||
@ -182,7 +185,7 @@
|
||||
OPCODE(unify_x_val ,ox),
|
||||
OPCODE(unify_y_val ,oy),
|
||||
OPCODE(unify_atom ,oc),
|
||||
OPCODE(unify_float ,oc),
|
||||
OPCODE(unify_float ,od),
|
||||
OPCODE(unify_longint ,oc),
|
||||
OPCODE(unify_bigint ,oc),
|
||||
OPCODE(unify_list ,o),
|
||||
@ -194,6 +197,8 @@
|
||||
OPCODE(put_unsafe ,yx),
|
||||
OPCODE(put_xx_val ,xxxx), /* peephole */
|
||||
OPCODE(put_atom ,xc),
|
||||
OPCODE(put_float ,xd),
|
||||
OPCODE(put_longint ,xi),
|
||||
OPCODE(put_list ,x),
|
||||
OPCODE(put_struct ,xf),
|
||||
OPCODE(write_x_var ,x),
|
||||
@ -201,6 +206,8 @@
|
||||
OPCODE(write_x_val ,x),
|
||||
OPCODE(write_y_val ,y),
|
||||
OPCODE(write_atom ,c),
|
||||
OPCODE(write_float ,d),
|
||||
OPCODE(write_longint ,i),
|
||||
OPCODE(write_list ,e),
|
||||
OPCODE(write_struct ,f),
|
||||
OPCODE(pop ,e),
|
||||
@ -296,8 +303,8 @@
|
||||
OPCODE(unify_l_x_val ,ox),
|
||||
OPCODE(unify_l_y_val ,oy),
|
||||
OPCODE(unify_l_atom ,oc),
|
||||
OPCODE(unify_l_float ,oc),
|
||||
OPCODE(unify_l_longint ,oc),
|
||||
OPCODE(unify_l_float ,od),
|
||||
OPCODE(unify_l_longint ,oi),
|
||||
OPCODE(unify_l_bigint ,oc),
|
||||
OPCODE(unify_l_void ,o),
|
||||
OPCODE(unify_l_n_voids ,os),
|
||||
@ -309,6 +316,8 @@
|
||||
OPCODE(unify_x_val_write ,ox),
|
||||
OPCODE(unify_y_val_write ,oy),
|
||||
OPCODE(unify_atom_write ,oc),
|
||||
OPCODE(unify_float_write ,od),
|
||||
OPCODE(unify_longint_write ,oi),
|
||||
OPCODE(unify_n_atoms_write ,osc),
|
||||
OPCODE(unify_list_write ,o),
|
||||
OPCODE(unify_x_var2_write ,oxx),
|
||||
@ -322,6 +331,8 @@
|
||||
OPCODE(unify_l_x_val_write ,ox),
|
||||
OPCODE(unify_l_y_val_write ,oy),
|
||||
OPCODE(unify_l_atom_write ,oc),
|
||||
OPCODE(unify_l_float_write ,od),
|
||||
OPCODE(unify_l_longint_write ,oi),
|
||||
OPCODE(unify_l_void_write ,o),
|
||||
OPCODE(unify_l_n_voids_write ,os),
|
||||
OPCODE(unify_l_x_loc_write ,ox),
|
||||
|
||||
47
H/amidefs.h
47
H/amidefs.h
@ -11,8 +11,12 @@
|
||||
* File: amidefs.h *
|
||||
* comments: Abstract machine peculiarities *
|
||||
* *
|
||||
* Last rev: $Date: 2005-12-17 03:25:39 $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.30 2005/12/17 03:25:39 vsc
|
||||
* major changes to support online event-based profiling
|
||||
* improve error discovery and restart on scanner.
|
||||
*
|
||||
* Revision 1.29 2005/07/06 15:10:15 vsc
|
||||
* improvements to compiler: merged instructions and fixes for ->
|
||||
*
|
||||
@ -211,7 +215,8 @@ typedef struct yami {
|
||||
CELL next;
|
||||
} clll;
|
||||
struct {
|
||||
CODEADDR d;
|
||||
OPCODE opcw;
|
||||
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
|
||||
CELL next;
|
||||
} d;
|
||||
struct {
|
||||
@ -247,6 +252,11 @@ typedef struct yami {
|
||||
struct yami *f;
|
||||
CELL next;
|
||||
} fy;
|
||||
struct {
|
||||
OPCODE opcw;
|
||||
CELL i[2];
|
||||
CELL next;
|
||||
} i;
|
||||
struct {
|
||||
struct logic_upd_index *I;
|
||||
struct yami *l1;
|
||||
@ -277,6 +287,19 @@ typedef struct yami {
|
||||
#ifdef YAPOR
|
||||
unsigned int or_arg;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
struct table_entry *te; /* pointer to table entry */
|
||||
#endif /* TABLING */
|
||||
COUNT s;
|
||||
struct pred_entry *n, *c;
|
||||
struct yami *d;
|
||||
CELL *owner;
|
||||
CELL next;
|
||||
} lld;
|
||||
struct {
|
||||
#ifdef YAPOR
|
||||
unsigned int or_arg;
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
struct table_entry *te; /* pointer to table entry */
|
||||
#endif /* TABLING */
|
||||
@ -388,12 +411,22 @@ typedef struct yami {
|
||||
CELL c;
|
||||
CELL next;
|
||||
} oc;
|
||||
struct {
|
||||
OPCODE opcw;
|
||||
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
|
||||
CELL next;
|
||||
} od;
|
||||
struct {
|
||||
OPCODE opcw;
|
||||
Functor f;
|
||||
Int a;
|
||||
CELL next;
|
||||
} of;
|
||||
struct {
|
||||
OPCODE opcw;
|
||||
CELL i[2];
|
||||
CELL next;
|
||||
} oi;
|
||||
struct {
|
||||
OPCODE opcw;
|
||||
COUNT s;
|
||||
@ -484,6 +517,11 @@ typedef struct yami {
|
||||
CELL c;
|
||||
CELL next;
|
||||
} xc;
|
||||
struct {
|
||||
wamreg x;
|
||||
CELL d[1+SIZEOF_DOUBLE/SIZEOF_INT_P];
|
||||
CELL next;
|
||||
} xd;
|
||||
struct {
|
||||
wamreg x;
|
||||
Functor f;
|
||||
@ -495,6 +533,11 @@ typedef struct yami {
|
||||
struct yami *F;
|
||||
CELL next;
|
||||
} xF;
|
||||
struct {
|
||||
wamreg x;
|
||||
CELL i[2];
|
||||
CELL next;
|
||||
} xi;
|
||||
struct {
|
||||
wamreg x;
|
||||
struct yami *l1;
|
||||
|
||||
@ -78,6 +78,10 @@ typedef struct logic_upd_clause {
|
||||
struct logic_upd_clause *ClPrev, *ClNext;
|
||||
/* parent pointer */
|
||||
PredEntry *ClPred;
|
||||
/*
|
||||
support for timers, stalled for now.
|
||||
UInt ClTimeStart, ClTimeEnd;
|
||||
*/
|
||||
/* The instructions, at least one of the form sl */
|
||||
yamop ClCode[MIN_ARRAY];
|
||||
} LogUpdClause;
|
||||
|
||||
47
H/rclause.h
47
H/rclause.h
@ -12,8 +12,11 @@
|
||||
* File: rclause.h *
|
||||
* comments: walk through a clause *
|
||||
* *
|
||||
* Last rev: $Date: 2006-04-27 14:13:24 $,$Author: rslopes $ *
|
||||
* Last rev: $Date: 2006-09-20 20:03:51 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.15 2006/04/27 14:13:24 rslopes
|
||||
* *** empty log message ***
|
||||
*
|
||||
* Revision 1.14 2005/12/17 03:25:39 vsc
|
||||
* major changes to support online event-based profiling
|
||||
* improve error discovery and restart on scanner.
|
||||
@ -425,11 +428,21 @@ restore_opcodes(yamop *pc)
|
||||
pc->u.yx.y = YAdjust(pc->u.yx.y);
|
||||
pc = NEXTOP(pc,yx);
|
||||
break;
|
||||
/* instructions type xd */
|
||||
case _get_float:
|
||||
case _put_float:
|
||||
pc->u.xd.x = XAdjust(pc->u.xd.x);
|
||||
pc = NEXTOP(pc,xd);
|
||||
break;
|
||||
/* instructions type xd */
|
||||
case _get_longint:
|
||||
case _put_longint:
|
||||
pc->u.xi.x = XAdjust(pc->u.xi.x);
|
||||
pc = NEXTOP(pc,xi);
|
||||
break;
|
||||
/* instructions type xc */
|
||||
case _get_atom:
|
||||
case _put_atom:
|
||||
case _get_float:
|
||||
case _get_longint:
|
||||
case _get_bigint:
|
||||
pc->u.xc.x = XAdjust(pc->u.xc.x);
|
||||
{
|
||||
@ -688,15 +701,27 @@ restore_opcodes(yamop *pc)
|
||||
pc->u.os.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.os.opcw));
|
||||
pc = NEXTOP(pc,os);
|
||||
break;
|
||||
/* instructions type od */
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_float_write:
|
||||
case _unify_l_float_write:
|
||||
pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw));
|
||||
pc = NEXTOP(pc,od);
|
||||
break;
|
||||
/* instructions type oi */
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
case _unify_longint_write:
|
||||
case _unify_l_longint_write:
|
||||
pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw));
|
||||
pc = NEXTOP(pc,oi);
|
||||
break;
|
||||
/* instructions type oc */
|
||||
case _unify_atom_write:
|
||||
case _unify_atom:
|
||||
case _unify_l_atom_write:
|
||||
case _unify_l_atom:
|
||||
case _unify_float:
|
||||
case _unify_l_float:
|
||||
case _unify_longint:
|
||||
case _unify_l_longint:
|
||||
case _unify_bigint:
|
||||
case _unify_l_bigint:
|
||||
pc->u.oc.opcw = Yap_opcode(Yap_op_from_opcode(pc->u.oc.opcw));
|
||||
@ -740,6 +765,14 @@ restore_opcodes(yamop *pc)
|
||||
#endif /* TABLING */
|
||||
pc = NEXTOP(pc,s);
|
||||
break;
|
||||
/* instructions type d */
|
||||
case _write_float:
|
||||
pc = NEXTOP(pc,d);
|
||||
break;
|
||||
/* instructions type i */
|
||||
case _write_longint:
|
||||
pc = NEXTOP(pc,i);
|
||||
break;
|
||||
/* instructions type c */
|
||||
case _write_atom:
|
||||
{
|
||||
|
||||
@ -16,6 +16,8 @@
|
||||
|
||||
<h2>Yap-5.1.2:</h2>
|
||||
<ul>
|
||||
<li> FIXED: indexing on doubles wasn't working properly.</li>
|
||||
<li> FIXED: sending large lists of atomics to DB was very, very slow.</li>
|
||||
<li> FIXED: make library_directory/1 better protected.</li>
|
||||
<li> FIXED: make YAP smarter at finding libraries in WIN32.</li>
|
||||
<li> NEW: data structures using global variables: queues, heaps and
|
||||
|
||||
@ -435,6 +435,7 @@ source_module(Mod) :-
|
||||
'$member'(X,[X|_]) :- !.
|
||||
'$member'(X,[_|L]) :- '$member'(X,L).
|
||||
|
||||
|
||||
% comma has its own problems.
|
||||
:- '$install_meta_predicate'((:,:), prolog).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user