many fixes: restart on threads, fixes for tabling, other generic fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@954 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
b16de6ad3d
commit
80fd1bcc91
283
C/absmi.c
283
C/absmi.c
@ -1606,30 +1606,64 @@ Yap_absmi(int inp)
|
||||
if ((ADDR) pt1 >= Yap_TrailBase)
|
||||
#endif /* SBA */
|
||||
{
|
||||
pt0 = (tr_fr_ptr) pt1;
|
||||
goto failloop;
|
||||
}
|
||||
#endif /* FROZEN_STACKS */
|
||||
flags = *pt1;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
if (!FlagOn(DBClMask, flags)) {
|
||||
if (FlagOn(DBClMask, flags)) {
|
||||
DBRef dbr = DBStructFlagsToDBStruct(pt1);
|
||||
int erase;
|
||||
|
||||
LOCK(dbr->lock);
|
||||
DEC_DBREF_COUNT(dbr);
|
||||
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
|
||||
UNLOCK(dbr->lock);
|
||||
if (erase) {
|
||||
saveregs();
|
||||
Yap_ErDBE(dbr);
|
||||
setregs();
|
||||
}
|
||||
} else {
|
||||
if (flags & LogUpdMask) {
|
||||
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
|
||||
int erase;
|
||||
LOCK(cl->ClLock);
|
||||
DEC_CLREF_COUNT(cl);
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
UNLOCK(cl->ClLock);
|
||||
if (erase) {
|
||||
saveregs();
|
||||
/* at this point,
|
||||
we are the only ones accessing the clause,
|
||||
hence we don't need to have a lock it */
|
||||
Yap_ErLogUpdCl(cl);
|
||||
setregs();
|
||||
if (flags & IndexMask) {
|
||||
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
|
||||
int erase;
|
||||
|
||||
LOCK(cl->ClLock);
|
||||
DEC_CLREF_COUNT(cl);
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
UNLOCK(cl->ClLock);
|
||||
if (erase) {
|
||||
saveregs();
|
||||
/* at this point,
|
||||
we are the only ones accessing the clause,
|
||||
hence we don't need to have a lock it */
|
||||
Yap_ErLogUpdIndex(cl);
|
||||
setregs();
|
||||
}
|
||||
} else {
|
||||
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
|
||||
int erase;
|
||||
|
||||
LOCK(cl->ClLock);
|
||||
DEC_CLREF_COUNT(cl);
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
UNLOCK(cl->ClLock);
|
||||
if (erase) {
|
||||
saveregs();
|
||||
/* at this point,
|
||||
we are the only ones accessing the clause,
|
||||
hence we don't need to have a lock it */
|
||||
Yap_ErLogUpdCl(cl);
|
||||
setregs();
|
||||
}
|
||||
}
|
||||
} else {
|
||||
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
|
||||
int erase;
|
||||
|
||||
LOCK(cl->ClLock);
|
||||
DEC_CLREF_COUNT(cl);
|
||||
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
||||
@ -1643,19 +1677,6 @@ Yap_absmi(int inp)
|
||||
setregs();
|
||||
}
|
||||
}
|
||||
} else {
|
||||
DBRef dbr = DBStructFlagsToDBStruct(pt1);
|
||||
int erase;
|
||||
|
||||
LOCK(dbr->lock);
|
||||
DEC_DBREF_COUNT(dbr);
|
||||
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
|
||||
UNLOCK(dbr->lock);
|
||||
if (erase) {
|
||||
saveregs();
|
||||
Yap_ErDBE(dbr);
|
||||
setregs();
|
||||
}
|
||||
}
|
||||
#else
|
||||
ResetFlag(InUseMask, flags);
|
||||
@ -1810,15 +1831,15 @@ Yap_absmi(int inp)
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
/* comit_b_x Xi */
|
||||
Op(comit_b_x, x);
|
||||
/* commit_b_x Xi */
|
||||
Op(commit_b_x, x);
|
||||
BEGD(d0);
|
||||
d0 = XREG(PREG->u.x.x);
|
||||
#ifdef COROUTINING
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackComitX, H);
|
||||
check_stack(NoStackCommitX, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
do_comit_b_x:
|
||||
do_commit_b_x:
|
||||
#endif
|
||||
/* skip a void call and a label */
|
||||
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, x),sla),l);
|
||||
@ -1847,15 +1868,15 @@ Yap_absmi(int inp)
|
||||
GONext();
|
||||
ENDOp();
|
||||
|
||||
/* comit_b_y Yi */
|
||||
Op(comit_b_y, y);
|
||||
/* commit_b_y Yi */
|
||||
Op(commit_b_y, y);
|
||||
BEGD(d0);
|
||||
d0 = YREG[PREG->u.y.y];
|
||||
#ifdef COROUTINING
|
||||
CACHE_Y_AS_ENV(YREG);
|
||||
check_stack(NoStackComitY, H);
|
||||
check_stack(NoStackCommitY, H);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
do_comit_b_y:
|
||||
do_commit_b_y:
|
||||
#endif
|
||||
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, y),sla),l);
|
||||
{
|
||||
@ -2199,7 +2220,7 @@ Yap_absmi(int inp)
|
||||
#ifdef COROUTINING
|
||||
|
||||
/* This is easier: I know there is an environment so I cannot do allocate */
|
||||
NoStackComitY:
|
||||
NoStackCommitY:
|
||||
/* find something to fool S */
|
||||
if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) {
|
||||
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
|
||||
@ -2208,10 +2229,10 @@ Yap_absmi(int inp)
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
goto do_comit_b_y;
|
||||
goto do_commit_b_y;
|
||||
|
||||
/* Problem: have I got an environment or not? */
|
||||
NoStackComitX:
|
||||
NoStackCommitX:
|
||||
/* find something to fool S */
|
||||
if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) {
|
||||
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
|
||||
@ -2235,7 +2256,7 @@ Yap_absmi(int inp)
|
||||
goto creep_either;
|
||||
}
|
||||
/* don't do debugging and friends here */
|
||||
goto do_comit_b_x;
|
||||
goto do_commit_b_x;
|
||||
|
||||
/* don't forget I cannot creep at ; */
|
||||
NoStackEither:
|
||||
@ -6352,31 +6373,33 @@ Yap_absmi(int inp)
|
||||
|
||||
BOp(index_pred, e);
|
||||
saveregs();
|
||||
WRITE_LOCK(PredFromDefCode(PREG)->PRWLock);
|
||||
{
|
||||
PredEntry *ap = PredFromDefCode(PREG);
|
||||
WRITE_LOCK(ap->PRWLock);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
/*
|
||||
we do not lock access to the predicate,
|
||||
we must take extra care here
|
||||
*/
|
||||
if (PredFromDefCode(PREG)->OpcodeOfPred != INDEX_OPCODE) {
|
||||
/* someone was here before we were */
|
||||
Yap_Error(SYSTEM_ERROR,TermNil,"Bad locking");
|
||||
PREG = PredFromDefCode(PREG)->CodeOfPred;
|
||||
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
|
||||
JMPNext();
|
||||
}
|
||||
if (ap->OpcodeOfPred != INDEX_OPCODE) {
|
||||
/* someone was here before we were */
|
||||
PREG = ap->CodeOfPred;
|
||||
WRITE_UNLOCK(ap->PRWLock);
|
||||
JMPNext();
|
||||
}
|
||||
#endif
|
||||
/* update ASP before calling IPred */
|
||||
ASP = YREG+E_CB;
|
||||
if (ASP > (CELL *) B) {
|
||||
ASP = (CELL *) B;
|
||||
}
|
||||
Yap_IPred(PredFromDefCode(PREG));
|
||||
ASP = YREG+E_CB;
|
||||
if (ASP > (CELL *) B) {
|
||||
ASP = (CELL *) B;
|
||||
}
|
||||
Yap_IPred(ap);
|
||||
/* IPred can generate errors, it thus must get rid of the lock itself */
|
||||
setregs();
|
||||
CACHED_A1() = ARG1;
|
||||
PREG = PredFromDefCode(PREG)->CodeOfPred;
|
||||
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
|
||||
setregs();
|
||||
CACHED_A1() = ARG1;
|
||||
PREG = ap->CodeOfPred;
|
||||
WRITE_UNLOCK(ap->PRWLock);
|
||||
}
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
@ -9246,12 +9269,12 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDOp();
|
||||
|
||||
BOp(call_bfunc_xx, lxx);
|
||||
BOp(call_bfunc_xx, llxx);
|
||||
BEGD(d0);
|
||||
BEGD(d1);
|
||||
d0 = XREG(PREG->u.lxx.x1);
|
||||
d0 = XREG(PREG->u.llxx.x1);
|
||||
call_bfunc_xx_nvar:
|
||||
d1 = XREG(PREG->u.lxx.x2);
|
||||
d1 = XREG(PREG->u.llxx.x2);
|
||||
call_bfunc_xx2_nvar:
|
||||
deref_head(d0, call_bfunc_xx_unk);
|
||||
deref_head(d1, call_bfunc_xx2_unk);
|
||||
@ -9259,37 +9282,46 @@ Yap_absmi(int inp)
|
||||
int flags;
|
||||
|
||||
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
||||
flags = PREG->u.lxx.flags;
|
||||
PREG = NEXTOP(PREG, lxx);
|
||||
flags = PREG->u.llxx.flags;
|
||||
if (v > 0) {
|
||||
if (flags & GT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxx);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxx.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else if (v < 0) {
|
||||
if (flags & LT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxx);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxx.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else /* if (v == 0) */ {
|
||||
if (flags & EQ_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxx);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxx.f;
|
||||
JMPNext();
|
||||
}
|
||||
}
|
||||
}
|
||||
exec_bin_cmp_xx:
|
||||
{
|
||||
CmpPredicate f = PREG->u.lxx.p->cs.d_code;
|
||||
PREG = NEXTOP(PREG, lxx);
|
||||
CmpPredicate f = PREG->u.llxx.p->cs.d_code;
|
||||
saveregs();
|
||||
d0 = (CELL) (f) (d0,d1);
|
||||
|
||||
}
|
||||
setregs();
|
||||
if (!d0) {
|
||||
FAIL();
|
||||
PREG = PREG->u.llxx.f;
|
||||
JMPNext();
|
||||
}
|
||||
PREG = NEXTOP(PREG, llxx);
|
||||
JMPNext();
|
||||
|
||||
BEGP(pt0);
|
||||
@ -9306,12 +9338,12 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDBOp();
|
||||
|
||||
BOp(call_bfunc_yx, lxy);
|
||||
BOp(call_bfunc_yx, llxy);
|
||||
BEGD(d0);
|
||||
BEGD(d1);
|
||||
BEGP(pt0);
|
||||
pt0 = YREG + PREG->u.lxy.y;
|
||||
d1 = XREG(PREG->u.lxy.x);
|
||||
pt0 = YREG + PREG->u.llxy.y;
|
||||
d1 = XREG(PREG->u.llxy.x);
|
||||
d0 = *pt0;
|
||||
ENDP(pt0);
|
||||
deref_head(d0, call_bfunc_yx_unk);
|
||||
@ -9322,36 +9354,45 @@ Yap_absmi(int inp)
|
||||
int flags;
|
||||
|
||||
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
||||
flags = PREG->u.lxy.flags;
|
||||
PREG = NEXTOP(PREG, lxy);
|
||||
flags = PREG->u.llxy.flags;
|
||||
if (v > 0) {
|
||||
if (flags & GT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else if (v < 0) {
|
||||
if (flags & LT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else /* if (v == 0) */ {
|
||||
if (flags & EQ_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
}
|
||||
}
|
||||
exec_bin_cmp_yx:
|
||||
{
|
||||
CmpPredicate f = PREG->u.lxy.p->cs.d_code;
|
||||
PREG = NEXTOP(PREG, lxy);
|
||||
CmpPredicate f = PREG->u.llxy.p->cs.d_code;
|
||||
saveregs();
|
||||
d0 = (CELL) (f) (d0,d1);
|
||||
}
|
||||
setregs();
|
||||
if (!d0) {
|
||||
FAIL();
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
|
||||
BEGP(pt0);
|
||||
@ -9368,12 +9409,12 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDBOp();
|
||||
|
||||
BOp(call_bfunc_xy, lxy);
|
||||
BOp(call_bfunc_xy, llxy);
|
||||
BEGD(d0);
|
||||
BEGD(d1);
|
||||
BEGP(pt0);
|
||||
pt0 = YREG + PREG->u.lxy.y;
|
||||
d0 = XREG(PREG->u.lxy.x);
|
||||
pt0 = YREG + PREG->u.llxy.y;
|
||||
d0 = XREG(PREG->u.llxy.x);
|
||||
d1 = *pt0;
|
||||
ENDP(pt0);
|
||||
deref_head(d0, call_bfunc_xy_unk);
|
||||
@ -9384,36 +9425,45 @@ Yap_absmi(int inp)
|
||||
int flags;
|
||||
|
||||
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
||||
flags = PREG->u.lxy.flags;
|
||||
PREG = NEXTOP(PREG, lxy);
|
||||
flags = PREG->u.llxy.flags;
|
||||
if (v > 0) {
|
||||
if (flags & GT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else if (v < 0) {
|
||||
if (flags & LT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else /* if (v == 0) */ {
|
||||
if (flags & EQ_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
}
|
||||
}
|
||||
exec_bin_cmp_xy:
|
||||
{
|
||||
CmpPredicate f = PREG->u.lxy.p->cs.d_code;
|
||||
PREG = NEXTOP(PREG, lxy);
|
||||
CmpPredicate f = PREG->u.llxy.p->cs.d_code;
|
||||
saveregs();
|
||||
d0 = (CELL) (f) (d0,d1);
|
||||
}
|
||||
setregs();
|
||||
if (!d0) {
|
||||
FAIL();
|
||||
PREG = PREG->u.llxy.f;
|
||||
JMPNext();
|
||||
}
|
||||
PREG = NEXTOP(PREG, llxy);
|
||||
JMPNext();
|
||||
|
||||
BEGP(pt0);
|
||||
@ -9430,13 +9480,13 @@ Yap_absmi(int inp)
|
||||
ENDD(d0);
|
||||
ENDBOp();
|
||||
|
||||
BOp(call_bfunc_yy, lyy);
|
||||
BOp(call_bfunc_yy, llyy);
|
||||
BEGD(d0);
|
||||
BEGD(d1);
|
||||
BEGP(pt0);
|
||||
pt0 = YREG + PREG->u.lyy.y1;
|
||||
pt0 = YREG + PREG->u.llyy.y1;
|
||||
BEGP(pt1);
|
||||
pt1 = YREG + PREG->u.lyy.y2;
|
||||
pt1 = YREG + PREG->u.llyy.y2;
|
||||
d0 = *pt0;
|
||||
d1 = *pt1;
|
||||
ENDP(pt1);
|
||||
@ -9449,36 +9499,45 @@ Yap_absmi(int inp)
|
||||
int flags;
|
||||
|
||||
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
||||
flags = PREG->u.lyy.flags;
|
||||
PREG = NEXTOP(PREG, lyy);
|
||||
flags = PREG->u.llyy.flags;
|
||||
if (v > 0) {
|
||||
if (flags & GT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llyy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llyy.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else if (v < 0) {
|
||||
if (flags & LT_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llyy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llyy.f;
|
||||
JMPNext();
|
||||
}
|
||||
} else /* if (v == 0) */ {
|
||||
if (flags & EQ_OK_IN_CMP) {
|
||||
PREG = NEXTOP(PREG, llyy);
|
||||
JMPNext();
|
||||
} else
|
||||
FAIL();
|
||||
} else {
|
||||
PREG = PREG->u.llyy.f;
|
||||
JMPNext();
|
||||
}
|
||||
}
|
||||
}
|
||||
exec_bin_cmp_yy:
|
||||
{
|
||||
CmpPredicate f = PREG->u.lyy.p->cs.d_code;
|
||||
PREG = NEXTOP(PREG, lyy);
|
||||
CmpPredicate f = PREG->u.llyy.p->cs.d_code;
|
||||
saveregs();
|
||||
d0 = (CELL) (f) (d0,d1);
|
||||
}
|
||||
setregs();
|
||||
if (!d0) {
|
||||
FAIL();
|
||||
PREG = PREG->u.llyy.f;
|
||||
JMPNext();
|
||||
}
|
||||
PREG = NEXTOP(PREG, llyy);
|
||||
JMPNext();
|
||||
|
||||
BEGP(pt0);
|
||||
|
121
C/amasm.c
121
C/amasm.c
@ -122,7 +122,7 @@ static int asm_error = FALSE;
|
||||
|
||||
static int assembling;
|
||||
|
||||
static CELL comit_lab;
|
||||
static CELL commit_lab;
|
||||
|
||||
static int do_not_optimize_uatom = FALSE;
|
||||
|
||||
@ -742,7 +742,6 @@ check_alloc(void)
|
||||
static void
|
||||
a_p(op_numbers opcode)
|
||||
{ /* emit opcode & predicate code address */
|
||||
int comit_ok = (comit_lab == 0);
|
||||
Prop fe = (Prop) (cpc->rnd1);
|
||||
CELL Flags = RepPredProp(fe)->PredFlags;
|
||||
if (Flags & AsmPredFlag) {
|
||||
@ -769,16 +768,11 @@ a_p(op_numbers opcode)
|
||||
longjmp(Yap_CompilerBotch, 1);
|
||||
}
|
||||
a_e(op);
|
||||
if (!comit_ok) {
|
||||
Yap_Error(SYSTEM_ERROR, TermNil,"internal assembler error for commit");
|
||||
save_machine_regs();
|
||||
longjmp(Yap_CompilerBotch, 1);
|
||||
}
|
||||
return;
|
||||
}
|
||||
if (Flags & CPredFlag) {
|
||||
check_alloc();
|
||||
if (!comit_ok && (Flags & TestPredFlag)) {
|
||||
if (commit_lab && (Flags & TestPredFlag)) {
|
||||
if (pass_no) {
|
||||
if (Flags & UserCPredFlag) {
|
||||
Yap_Error(SYSTEM_ERROR, TermNil,
|
||||
@ -790,13 +784,12 @@ a_p(op_numbers opcode)
|
||||
code_p->u.sdl.s =
|
||||
emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
|
||||
code_p->u.sdl.l =
|
||||
emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
|
||||
emit_a(Unsigned(code_addr) + label_offset[commit_lab]);
|
||||
code_p->u.sdl.p =
|
||||
emit_pe(RepPredProp(fe));
|
||||
}
|
||||
GONEXT(sdl);
|
||||
comit_lab = 0;
|
||||
comit_ok = TRUE;
|
||||
commit_lab = 0;
|
||||
}
|
||||
else {
|
||||
if (pass_no) {
|
||||
@ -826,11 +819,6 @@ a_p(op_numbers opcode)
|
||||
}
|
||||
GONEXT(sla);
|
||||
}
|
||||
if (!comit_ok) {
|
||||
Yap_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit");
|
||||
save_machine_regs();
|
||||
longjmp(Yap_CompilerBotch,1);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
@ -866,11 +854,6 @@ a_p(op_numbers opcode)
|
||||
code_p->u.p.p = RepPredProp(fe);
|
||||
GONEXT(p);
|
||||
}
|
||||
if (!comit_ok) {
|
||||
Yap_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit");
|
||||
save_machine_regs();
|
||||
longjmp(Yap_CompilerBotch,1);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@ -968,21 +951,35 @@ a_bfunc(CELL pred)
|
||||
if (ve->KindOfVE == PermVar) {
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(_call_bfunc_yy);
|
||||
code_p->u.lxy.p = RepPredProp(((Prop)pred));
|
||||
code_p->u.lyy.y1 = v1;
|
||||
code_p->u.lyy.y2 = emit_yreg(var_offset);
|
||||
code_p->u.lyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
code_p->u.llyy.p = RepPredProp(((Prop)pred));
|
||||
if (commit_lab) {
|
||||
code_p->u.llyy.f =
|
||||
emit_a(Unsigned(code_addr) + label_offset[commit_lab]);
|
||||
commit_lab = 0;
|
||||
} else {
|
||||
code_p->u.llyy.f = FAILCODE;
|
||||
}
|
||||
code_p->u.llyy.y1 = v1;
|
||||
code_p->u.llyy.y2 = emit_yreg(var_offset);
|
||||
code_p->u.llyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
}
|
||||
GONEXT(lyy);
|
||||
GONEXT(llyy);
|
||||
} else {
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(_call_bfunc_yx);
|
||||
code_p->u.lxy.p = RepPredProp(((Prop)pred));
|
||||
code_p->u.lxy.x = emit_xreg(var_offset);
|
||||
code_p->u.lxy.y = v1;
|
||||
code_p->u.lxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
code_p->u.llxy.p = RepPredProp(((Prop)pred));
|
||||
if (commit_lab) {
|
||||
code_p->u.llxy.f =
|
||||
emit_a(Unsigned(code_addr) + label_offset[commit_lab]);
|
||||
commit_lab = 0;
|
||||
} else {
|
||||
code_p->u.llxy.f = FAILCODE;
|
||||
}
|
||||
code_p->u.llxy.x = emit_xreg(var_offset);
|
||||
code_p->u.llxy.y = v1;
|
||||
code_p->u.llxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
}
|
||||
GONEXT(lxy);
|
||||
GONEXT(llxy);
|
||||
}
|
||||
} else {
|
||||
wamreg x1 = emit_xreg(var_offset);
|
||||
@ -992,21 +989,35 @@ a_bfunc(CELL pred)
|
||||
if (ve->KindOfVE == PermVar) {
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(_call_bfunc_xy);
|
||||
code_p->u.lxy.p = RepPredProp(((Prop)pred));
|
||||
code_p->u.lxy.x = x1;
|
||||
code_p->u.lxy.y = emit_yreg(var_offset);
|
||||
code_p->u.lxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
code_p->u.llxy.p = RepPredProp(((Prop)pred));
|
||||
if (commit_lab) {
|
||||
code_p->u.llxy.f =
|
||||
emit_a(Unsigned(code_addr) + label_offset[commit_lab]);
|
||||
commit_lab = 0;
|
||||
} else {
|
||||
code_p->u.llxy.f = FAILCODE;
|
||||
}
|
||||
code_p->u.llxy.x = x1;
|
||||
code_p->u.llxy.y = emit_yreg(var_offset);
|
||||
code_p->u.llxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
}
|
||||
GONEXT(lxy);
|
||||
GONEXT(llxy);
|
||||
} else {
|
||||
if (pass_no) {
|
||||
code_p->opc = emit_op(_call_bfunc_xx);
|
||||
code_p->u.lxy.p = RepPredProp(((Prop)pred));
|
||||
code_p->u.lxx.x1 = x1;
|
||||
code_p->u.lxx.x2 = emit_xreg(var_offset);
|
||||
code_p->u.lxx.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
code_p->u.llxx.p = RepPredProp(((Prop)pred));
|
||||
if (commit_lab) {
|
||||
code_p->u.llxx.f =
|
||||
emit_a(Unsigned(code_addr) + label_offset[commit_lab]);
|
||||
commit_lab = 0;
|
||||
} else {
|
||||
code_p->u.llxx.f = FAILCODE;
|
||||
}
|
||||
code_p->u.llxx.x1 = x1;
|
||||
code_p->u.llxx.x2 = emit_xreg(var_offset);
|
||||
code_p->u.llxx.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
|
||||
}
|
||||
GONEXT(lxx);
|
||||
GONEXT(llxx);
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -2047,7 +2058,7 @@ do_pass(void)
|
||||
code_p = code_addr;
|
||||
cl_u = (union clause_obj *)code_p;
|
||||
cpc = CodeStart;
|
||||
comit_lab = 0L;
|
||||
commit_lab = 0L;
|
||||
/* Space while for the clause flags */
|
||||
log_update = CurrentPred->PredFlags & LogUpdatePredFlag;
|
||||
dynamic = CurrentPred->PredFlags & DynamicPredFlag;
|
||||
@ -2115,6 +2126,10 @@ do_pass(void)
|
||||
cl_u->lui.SiblingIndex = NULL;
|
||||
cl_u->lui.u.pred = CurrentPred;
|
||||
cl_u->lui.ClRefCount = 0;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INIT_LOCK(cl_u->lui.ClLock);
|
||||
INIT_CLREF_COUNT(&(cl_u->lui));
|
||||
#endif
|
||||
}
|
||||
code_p = cl_u->lui.ClCode;
|
||||
} else {
|
||||
@ -2331,8 +2346,8 @@ do_pass(void)
|
||||
case patch_b_op:
|
||||
a_v(_save_b_x);
|
||||
break;
|
||||
case comit_b_op:
|
||||
a_v(_comit_b_x);
|
||||
case commit_b_op:
|
||||
a_v(_commit_b_x);
|
||||
#ifdef YAPOR
|
||||
if (pass_no)
|
||||
PUT_YAMOP_CUT(entry_code);
|
||||
@ -2390,7 +2405,7 @@ do_pass(void)
|
||||
break;
|
||||
case trustme_op:
|
||||
if (log_update && assembling == ASSEMBLING_INDEX) {
|
||||
a_gl(_trust_logical_pred);
|
||||
a_cl(_trust_logical_pred);
|
||||
}
|
||||
#ifdef TABLING
|
||||
if (tabled)
|
||||
@ -2593,8 +2608,8 @@ do_pass(void)
|
||||
case mark_live_regs_op:
|
||||
a_bregs();
|
||||
break;
|
||||
case comit_opt_op:
|
||||
comit_lab = cpc->rnd1;
|
||||
case commit_opt_op:
|
||||
commit_lab = cpc->rnd1;
|
||||
break;
|
||||
case fetch_args_vv_op:
|
||||
a_fetch_vv();
|
||||
@ -2631,6 +2646,18 @@ do_pass(void)
|
||||
}
|
||||
a_bfunc(cpc->nextInst->rnd2);
|
||||
break;
|
||||
case align_float_op:
|
||||
/* install a blob */
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
|
||||
if (pass_no) {
|
||||
if ((CELL)code_p & 0x4)
|
||||
GONEXT(e);
|
||||
} else {
|
||||
if (!((CELL)code_p & 0x4))
|
||||
GONEXT(e);
|
||||
}
|
||||
#endif
|
||||
break;
|
||||
case blob_op:
|
||||
/* install a blob */
|
||||
copy_blob();
|
||||
|
29
C/cmppreds.c
29
C/cmppreds.c
@ -452,10 +452,11 @@ p_acomp(void)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
|
||||
return(flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2)));
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
|
||||
return(int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2)));
|
||||
} if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
|
||||
return(flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2)));
|
||||
}
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
@ -532,10 +533,10 @@ a_eq(Term t1, Term t2)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2))
|
||||
return (FloatOfTerm(t1) == FloatOfTerm(t2));
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
case long_int_e:
|
||||
@ -611,10 +612,10 @@ a_dif(Term t1, Term t2)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "=\\=/2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2))
|
||||
return (FloatOfTerm(t1) != FloatOfTerm(t2));
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
case long_int_e:
|
||||
@ -690,10 +691,10 @@ a_gt(Term t1, Term t2)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, ">/2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2))
|
||||
return (FloatOfTerm(t1) > FloatOfTerm(t2));
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
case long_int_e:
|
||||
@ -769,10 +770,10 @@ a_ge(Term t1, Term t2)
|
||||
Yap_Error(INSTANTIATION_ERROR, t1, ">=/2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2))
|
||||
return (FloatOfTerm(t1) >= FloatOfTerm(t2));
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
case long_int_e:
|
||||
@ -848,10 +849,10 @@ a_lt(Term t1, Term t2)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "</2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2))
|
||||
return (FloatOfTerm(t1) < FloatOfTerm(t2));
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
case long_int_e:
|
||||
@ -927,10 +928,10 @@ a_le(Term t1, Term t2)
|
||||
Yap_Error(INSTANTIATION_ERROR, t2, "=</2");
|
||||
return(FALSE);
|
||||
}
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
|
||||
if (IsFloatTerm(t1) && IsFloatTerm(t2))
|
||||
return (FloatOfTerm(t1) <= FloatOfTerm(t2));
|
||||
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
|
||||
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
|
||||
bt1 = Yap_Eval(t1, &v1);
|
||||
switch (bt1) {
|
||||
case long_int_e:
|
||||
|
74
C/compiler.c
74
C/compiler.c
@ -233,8 +233,8 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level)
|
||||
case save_b_flag:
|
||||
Yap_emit(save_b_op, (CELL) v, Zero);
|
||||
break;
|
||||
case comit_b_flag:
|
||||
Yap_emit(comit_b_op, (CELL) v, Zero);
|
||||
case commit_b_flag:
|
||||
Yap_emit(commit_b_op, (CELL) v, Zero);
|
||||
Yap_emit(empty_call_op, Zero, Zero);
|
||||
Yap_emit(restore_tmps_and_skip_op, Zero, Zero);
|
||||
break;
|
||||
@ -451,6 +451,9 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level)
|
||||
|
||||
/* use a special list to store the blobs */
|
||||
cpc = icpc;
|
||||
if (IsFloatTerm(t)) {
|
||||
Yap_emit(align_float_op, Zero, Zero);
|
||||
}
|
||||
Yap_emit(label_op, l1, Zero);
|
||||
if (IsFloatTerm(t)) {
|
||||
/* let us do floats first */
|
||||
@ -1265,10 +1268,10 @@ c_goal(Term Goal, int mod)
|
||||
int save = onlast;
|
||||
int savegoalno = goalno;
|
||||
int frst = TRUE;
|
||||
int comitflag = 0;
|
||||
int looking_at_comit = FALSE;
|
||||
int optimizing_comit = FALSE;
|
||||
Term comitvar = 0;
|
||||
int commitflag = 0;
|
||||
int looking_at_commit = FALSE;
|
||||
int optimizing_commit = FALSE;
|
||||
Term commitvar = 0;
|
||||
PInstr *FirstP = cpc, *savecpc, *savencpc;
|
||||
|
||||
push_branch(onbranch, TermNil);
|
||||
@ -1277,32 +1280,32 @@ c_goal(Term Goal, int mod)
|
||||
or_found = 1;
|
||||
do {
|
||||
arg = ArgOfTerm(1, Goal);
|
||||
looking_at_comit = IsApplTerm(arg) &&
|
||||
looking_at_commit = IsApplTerm(arg) &&
|
||||
FunctorOfTerm(arg) == FunctorArrow;
|
||||
if (frst) {
|
||||
if (optimizing_comit) {
|
||||
if (optimizing_commit) {
|
||||
Yap_emit(label_op, l, Zero);
|
||||
l = ++labelno;
|
||||
}
|
||||
Yap_emit_3ops(push_or_op, l, Zero, Zero);
|
||||
if (looking_at_comit &&
|
||||
if (looking_at_commit &&
|
||||
Yap_is_a_test_pred(ArgOfTerm(1, arg), mod)) {
|
||||
/*
|
||||
* let them think they are still the
|
||||
* first
|
||||
*/
|
||||
Yap_emit(comit_opt_op, l, Zero);
|
||||
optimizing_comit = TRUE;
|
||||
Yap_emit(commit_opt_op, l, Zero);
|
||||
optimizing_commit = TRUE;
|
||||
}
|
||||
else {
|
||||
optimizing_comit = FALSE;
|
||||
optimizing_commit = FALSE;
|
||||
Yap_emit_3ops(either_op, l, Zero, Zero);
|
||||
Yap_emit(restore_tmps_op, Zero, Zero);
|
||||
frst = FALSE;
|
||||
}
|
||||
}
|
||||
else {
|
||||
optimizing_comit = FALSE;
|
||||
optimizing_commit = FALSE;
|
||||
Yap_emit(label_op, l, Zero);
|
||||
Yap_emit(pushpop_or_op, Zero, Zero);
|
||||
Yap_emit_3ops(orelse_op, l = ++labelno, Zero, Zero);
|
||||
@ -1311,8 +1314,8 @@ c_goal(Term Goal, int mod)
|
||||
* if(IsApplTerm(arg) &&
|
||||
* FunctorOfTerm(arg)==FunctorArrow) {
|
||||
*/
|
||||
if (looking_at_comit) {
|
||||
if (!optimizing_comit && !comitflag) {
|
||||
if (looking_at_commit) {
|
||||
if (!optimizing_commit && !commitflag) {
|
||||
/* This instruction is placed before
|
||||
* the disjunction. This means that
|
||||
* the program counter must point
|
||||
@ -1323,8 +1326,8 @@ c_goal(Term Goal, int mod)
|
||||
int my_goalno = goalno;
|
||||
|
||||
goalno = savegoalno;
|
||||
comitflag = labelno;
|
||||
comitvar = MkVarTerm();
|
||||
commitflag = labelno;
|
||||
commitvar = MkVarTerm();
|
||||
if (H == (CELL *)freep0) {
|
||||
/* oops, too many new variables */
|
||||
save_machine_regs();
|
||||
@ -1334,8 +1337,8 @@ c_goal(Term Goal, int mod)
|
||||
savencpc = FirstP->nextInst;
|
||||
cpc = FirstP;
|
||||
onbranch = pop_branch();
|
||||
c_var(comitvar, save_b_flag, 1, 0);
|
||||
push_branch(onbranch, comitvar);
|
||||
c_var(commitvar, save_b_flag, 1, 0);
|
||||
push_branch(onbranch, commitvar);
|
||||
onbranch = cur_branch;
|
||||
cpc->nextInst = savencpc;
|
||||
cpc = savecpc;
|
||||
@ -1344,8 +1347,8 @@ c_goal(Term Goal, int mod)
|
||||
save = onlast;
|
||||
onlast = FALSE;
|
||||
c_goal(ArgOfTerm(1, arg), mod);
|
||||
if (!optimizing_comit) {
|
||||
c_var((Term) comitvar, comit_b_flag,
|
||||
if (!optimizing_commit) {
|
||||
c_var((Term) commitvar, commit_b_flag,
|
||||
1, 0);
|
||||
}
|
||||
onlast = save;
|
||||
@ -1364,10 +1367,10 @@ c_goal(Term Goal, int mod)
|
||||
&& FunctorOfTerm(Goal) == FunctorOr);
|
||||
Yap_emit(pushpop_or_op, Zero, Zero);
|
||||
Yap_emit(label_op, l, Zero);
|
||||
if (!optimizing_comit)
|
||||
if (!optimizing_commit)
|
||||
Yap_emit(orlast_op, Zero, Zero);
|
||||
else {
|
||||
optimizing_comit = FALSE; /* not really necessary */
|
||||
optimizing_commit = FALSE; /* not really necessary */
|
||||
}
|
||||
c_goal(Goal, mod);
|
||||
/* --onbranch; */
|
||||
@ -1394,25 +1397,25 @@ c_goal(Term Goal, int mod)
|
||||
CELL label = (labelno += 2);
|
||||
CELL end_label = (labelno += 2);
|
||||
int save = onlast;
|
||||
Term comitvar;
|
||||
Term commitvar;
|
||||
|
||||
comitvar = MkVarTerm();
|
||||
commitvar = MkVarTerm();
|
||||
if (H == (CELL *)freep0) {
|
||||
/* oops, too many new variables */
|
||||
save_machine_regs();
|
||||
longjmp(Yap_CompilerBotch,4);
|
||||
}
|
||||
push_branch(onbranch, comitvar);
|
||||
push_branch(onbranch, commitvar);
|
||||
++cur_branch;
|
||||
onbranch = cur_branch;
|
||||
or_found = 1;
|
||||
onlast = FALSE;
|
||||
c_var(comitvar, save_b_flag, 1, 0);
|
||||
c_var(commitvar, save_b_flag, 1, 0);
|
||||
Yap_emit_3ops(push_or_op, label, Zero, Zero);
|
||||
Yap_emit_3ops(either_op, label, Zero, Zero);
|
||||
Yap_emit(restore_tmps_op, Zero, Zero);
|
||||
c_goal(ArgOfTerm(1, Goal), mod);
|
||||
c_var(comitvar, comit_b_flag, 1, 0);
|
||||
c_var(commitvar, commit_b_flag, 1, 0);
|
||||
onlast = save;
|
||||
Yap_emit(fail_op, end_label, Zero);
|
||||
Yap_emit(pushpop_or_op, Zero, Zero);
|
||||
@ -1428,19 +1431,19 @@ c_goal(Term Goal, int mod)
|
||||
return;
|
||||
}
|
||||
else if (f == FunctorArrow) {
|
||||
Term comitvar;
|
||||
Term commitvar;
|
||||
int save = onlast;
|
||||
|
||||
comitvar = MkVarTerm();
|
||||
commitvar = MkVarTerm();
|
||||
if (H == (CELL *)freep0) {
|
||||
/* oops, too many new variables */
|
||||
save_machine_regs();
|
||||
longjmp(Yap_CompilerBotch,4);
|
||||
}
|
||||
onlast = FALSE;
|
||||
c_var(comitvar, save_b_flag, 1, 0);
|
||||
c_var(commitvar, save_b_flag, 1, 0);
|
||||
c_goal(ArgOfTerm(1, Goal), mod);
|
||||
c_var(comitvar, comit_b_flag, 1, 0);
|
||||
c_var(commitvar, commit_b_flag, 1, 0);
|
||||
onlast = save;
|
||||
c_goal(ArgOfTerm(2, Goal), mod);
|
||||
return;
|
||||
@ -1549,8 +1552,7 @@ c_goal(Term Goal, int mod)
|
||||
current_p0 = p0;
|
||||
c_var(t2, bt2_flag, 2, 0);
|
||||
}
|
||||
}
|
||||
else {
|
||||
} else {
|
||||
Term a2 = ArgOfTerm(2,Goal);
|
||||
Term t1 = MkVarTerm();
|
||||
if (H == (CELL *)freep0) {
|
||||
@ -1732,7 +1734,7 @@ usesvar(int ic)
|
||||
return (TRUE);
|
||||
switch (ic) {
|
||||
case save_b_op:
|
||||
case comit_b_op:
|
||||
case commit_b_op:
|
||||
case patch_b_op:
|
||||
case save_appl_op:
|
||||
case save_pair_op:
|
||||
@ -2484,7 +2486,7 @@ c_layout(void)
|
||||
Contents[rn] = NIL;
|
||||
++Uses[rn];
|
||||
break;
|
||||
case comit_b_op:
|
||||
case commit_b_op:
|
||||
#ifdef TABLING_INNER_CUTS
|
||||
cut_mark->op = clause_with_cut_op;
|
||||
#endif /* TABLING_INNER_CUTS */
|
||||
|
@ -82,21 +82,21 @@ int
|
||||
Yap_is_a_test_pred (Term arg, SMALLUNSGN mod)
|
||||
{
|
||||
if (IsVarTerm (arg))
|
||||
return (FALSE);
|
||||
return FALSE;
|
||||
else if (IsAtomTerm (arg)) {
|
||||
Atom At = AtomOfTerm (arg);
|
||||
PredEntry *pe = RepPredProp(PredPropByAtom(At, mod));
|
||||
if (EndOfPAEntr(pe))
|
||||
return (FALSE);
|
||||
return (pe->PredFlags & TestPredFlag);
|
||||
return FALSE;
|
||||
return pe->PredFlags & TestPredFlag;
|
||||
} else if (IsApplTerm (arg)) {
|
||||
Functor f = FunctorOfTerm (arg);
|
||||
PredEntry *pe = RepPredProp(PredPropByFunc(f, mod));
|
||||
if (EndOfPAEntr(pe))
|
||||
return (FALSE);
|
||||
return (pe->PredFlags & TestPredFlag);
|
||||
return FALSE;
|
||||
return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
|
||||
} else {
|
||||
return (FALSE);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
@ -516,6 +516,7 @@ static char *opformat[] =
|
||||
"put_num\t\t%n,%r",
|
||||
"get_float\t\t%l,%r",
|
||||
"put_float\t\t%l,%r",
|
||||
"align_float",
|
||||
"get_longint\t\t%l,%r",
|
||||
"put_longint\t\t%l,%r",
|
||||
"get_bigint\t\t%l,%r",
|
||||
@ -568,7 +569,7 @@ static char *opformat[] =
|
||||
"pushpop_or",
|
||||
"pop_or",
|
||||
"save_by\t\t%v",
|
||||
"comit_by\t\t%v",
|
||||
"commit_by\t\t%v",
|
||||
"patch_by\t\t%v",
|
||||
"try\t\t%g\t%x",
|
||||
"retry\t\t%g\t%x",
|
||||
|
35
C/dbase.c
35
C/dbase.c
@ -684,7 +684,13 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
||||
lr--;
|
||||
#endif
|
||||
if (!(dbentry->Flags & StaticMask)) {
|
||||
dbentry->NOfRefsTo++;
|
||||
if (dbentry->Flags & LogUpdMask) {
|
||||
LogUpdClause *cl = (LogUpdClause *)dbentry;
|
||||
|
||||
cl->ClRefCount++;
|
||||
} else {
|
||||
dbentry->NOfRefsTo++;
|
||||
}
|
||||
}
|
||||
*--tofref = dbentry;
|
||||
db_check_trail(lr);
|
||||
@ -1229,7 +1235,12 @@ CreateDBWithDBRef(Term Tm, DBProp p)
|
||||
INIT_DBREF_COUNT(pp);
|
||||
ppt = &(pp->DBT);
|
||||
}
|
||||
dbr->NOfRefsTo++;
|
||||
if (dbr->Flags & LogUpdMask) {
|
||||
LogUpdClause *cl = (LogUpdClause *)dbr;
|
||||
cl->ClRefCount++;
|
||||
} else {
|
||||
dbr->NOfRefsTo++;
|
||||
}
|
||||
ppt->Entry = Tm;
|
||||
ppt->NOfCells = 0;
|
||||
ppt->Contents[0] = (CELL)NULL;
|
||||
@ -1835,7 +1846,11 @@ p_rcda(void)
|
||||
cl = record_lu(pe, t2, MkFirst);
|
||||
if (cl != NULL) {
|
||||
TRAIL_CLREF(cl);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INC_CLREF_COUNT(cl);
|
||||
#else
|
||||
cl->ClFlags |= InUseMask;
|
||||
#endif
|
||||
TRef = MkDBRefTerm((DBRef)cl);
|
||||
} else {
|
||||
TRef = TermNil;
|
||||
@ -1978,7 +1993,11 @@ p_rcdz(void)
|
||||
LogUpdClause *cl = record_lu(pe, t2, MkLast);
|
||||
if (cl != NULL) {
|
||||
TRAIL_CLREF(cl);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INC_CLREF_COUNT(cl);
|
||||
#else
|
||||
cl->ClFlags |= InUseMask;
|
||||
#endif
|
||||
TRef = MkDBRefTerm((DBRef)cl);
|
||||
} else {
|
||||
TRef = TermNil;
|
||||
@ -4706,12 +4725,14 @@ keepdbrefs(DBTerm *entryref)
|
||||
return;
|
||||
}
|
||||
while ((ref = *--cp) != NIL) {
|
||||
LOCK(ref->lock);
|
||||
if(!(ref->Flags & InUseMask)) {
|
||||
ref->Flags |= InUseMask;
|
||||
TRAIL_REF(ref); /* So that fail will erase it */
|
||||
if (!(ref->Flags & LogUpdMask)) {
|
||||
LOCK(ref->lock);
|
||||
if(!(ref->Flags & InUseMask)) {
|
||||
ref->Flags |= InUseMask;
|
||||
TRAIL_REF(ref); /* So that fail will erase it */
|
||||
}
|
||||
UNLOCK(ref->lock);
|
||||
}
|
||||
UNLOCK(ref->lock);
|
||||
}
|
||||
|
||||
}
|
||||
|
2
C/grow.c
2
C/grow.c
@ -622,7 +622,7 @@ fix_compiler_instructions(PInstr *pcpc)
|
||||
case save_pair_op:
|
||||
case save_appl_op:
|
||||
case save_b_op:
|
||||
case comit_b_op:
|
||||
case commit_b_op:
|
||||
pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
|
||||
break;
|
||||
default:
|
||||
|
50
C/index.c
50
C/index.c
@ -57,7 +57,7 @@ static char SccsId[] = "%W% %G%";
|
||||
#endif
|
||||
|
||||
UInt STATIC_PROTO(do_index, (ClauseDef *,ClauseDef *,PredEntry *,UInt,UInt,int,int,CELL *));
|
||||
UInt STATIC_PROTO(do_compound_index, (ClauseDef *,ClauseDef *,Term *t,PredEntry *,UInt,UInt,UInt,UInt,int,int,int,CELL *));
|
||||
UInt STATIC_PROTO(do_compound_index, (ClauseDef *,ClauseDef *,Term *t,PredEntry *,UInt,UInt,UInt,UInt,int,int,int,CELL *,int));
|
||||
UInt STATIC_PROTO(do_dbref_index, (ClauseDef *,ClauseDef *,Term,PredEntry *,UInt,UInt,int,int,CELL *));
|
||||
UInt STATIC_PROTO(do_blob_index, (ClauseDef *,ClauseDef *,Term,PredEntry *,UInt,UInt,int,int,CELL *));
|
||||
|
||||
@ -337,8 +337,8 @@ has_cut(yamop *pc)
|
||||
case _cut_e:
|
||||
case _p_cut_by_y:
|
||||
case _p_cut_by_x:
|
||||
case _comit_b_y:
|
||||
case _comit_b_x:
|
||||
case _commit_b_y:
|
||||
case _commit_b_x:
|
||||
return TRUE;
|
||||
case _try_me:
|
||||
case _retry_me:
|
||||
@ -781,21 +781,21 @@ has_cut(yamop *pc)
|
||||
case _p_arg_y_cv:
|
||||
pc = NEXTOP(pc,ycx);
|
||||
break;
|
||||
/* instructions type lxx */
|
||||
/* instructions type ycx */
|
||||
case _p_func2s_y_cv:
|
||||
pc = NEXTOP(pc,ycx);
|
||||
break;
|
||||
/* instructions type lxx */
|
||||
/* instructions type llxx */
|
||||
case _call_bfunc_xx:
|
||||
pc = NEXTOP(pc,lxx);
|
||||
pc = NEXTOP(pc,llxx);
|
||||
break;
|
||||
/* instructions type lxy */
|
||||
/* instructions type llxy */
|
||||
case _call_bfunc_yx:
|
||||
case _call_bfunc_xy:
|
||||
pc = NEXTOP(pc,lxy);
|
||||
pc = NEXTOP(pc,llxy);
|
||||
break;
|
||||
case _call_bfunc_yy:
|
||||
pc = NEXTOP(pc,lyy);
|
||||
pc = NEXTOP(pc,llyy);
|
||||
break;
|
||||
}
|
||||
} while (TRUE);
|
||||
@ -833,7 +833,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
cl = NEXTOP(cl,e);
|
||||
break;
|
||||
case _save_b_x:
|
||||
case _comit_b_x:
|
||||
case _commit_b_x:
|
||||
case _p_cut_by_x:
|
||||
case _write_x_val:
|
||||
case _write_x_loc:
|
||||
@ -928,7 +928,7 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
cl = NEXTOP(cl,x);
|
||||
break;
|
||||
case _save_b_y:
|
||||
case _comit_b_y:
|
||||
case _commit_b_y:
|
||||
case _write_y_var:
|
||||
case _write_y_val:
|
||||
case _write_y_loc:
|
||||
@ -1499,14 +1499,14 @@ add_info(ClauseDef *clause, UInt regno)
|
||||
cl = NEXTOP(cl,ycx);
|
||||
break;
|
||||
case _call_bfunc_xx:
|
||||
cl = NEXTOP(cl,lxx);
|
||||
cl = NEXTOP(cl,llxx);
|
||||
break;
|
||||
case _call_bfunc_yx:
|
||||
case _call_bfunc_xy:
|
||||
cl = NEXTOP(cl,lxy);
|
||||
cl = NEXTOP(cl,llxy);
|
||||
break;
|
||||
case _call_bfunc_yy:
|
||||
cl = NEXTOP(cl,lyy);
|
||||
cl = NEXTOP(cl,llyy);
|
||||
break;
|
||||
case _Ystop:
|
||||
case _Nstop:
|
||||
@ -2715,7 +2715,7 @@ do_consts(GroupDef *grp, Term t, PredEntry *ap, int compound_term, CELL *sreg, U
|
||||
if (ap->PredFlags & LogUpdatePredFlag && max > min)
|
||||
ics->Label = suspend_indexing(min, max, ap);
|
||||
else
|
||||
ics->Label = do_compound_index(min, max, sreg, ap, compound_term, arity, argno+1, nxtlbl, first, last_arg, clleft, top);
|
||||
ics->Label = do_compound_index(min, max, sreg, ap, compound_term, arity, argno+1, nxtlbl, first, last_arg, clleft, top, TRUE);
|
||||
} else if (ap->PredFlags & LogUpdatePredFlag) {
|
||||
ics->Label = suspend_indexing(min, max, ap);
|
||||
} else {
|
||||
@ -2804,7 +2804,7 @@ do_funcs(GroupDef *grp, Term t, PredEntry *ap, UInt argno, int first, int last_a
|
||||
} else {
|
||||
sreg = NULL;
|
||||
}
|
||||
ifs->Label = do_compound_index(min, max, sreg, ap, 0, ArityOfFunctor(f), argno+1, nxtlbl, first, last_arg, clleft, top);
|
||||
ifs->Label = do_compound_index(min, max, sreg, ap, 0, ArityOfFunctor(f), argno+1, nxtlbl, first, last_arg, clleft, top, TRUE);
|
||||
}
|
||||
grp->FirstClause = min = max+1;
|
||||
}
|
||||
@ -2832,7 +2832,7 @@ do_pair(GroupDef *grp, Term t, PredEntry *ap, UInt argno, int first, int last_ar
|
||||
if (min != max && !IsPairTerm(t)) {
|
||||
return suspend_indexing(min, max, ap);
|
||||
}
|
||||
return do_compound_index(min, max, (IsPairTerm(t) ? RepPair(t) : NULL), ap, 0, 2, argno+1, nxtlbl, first, last_arg, clleft, top);
|
||||
return do_compound_index(min, max, (IsPairTerm(t) ? RepPair(t) : NULL), ap, 0, 2, argno+1, nxtlbl, first, last_arg, clleft, top, TRUE);
|
||||
}
|
||||
|
||||
static void
|
||||
@ -3161,12 +3161,12 @@ copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top)
|
||||
|
||||
/* execute an index inside a structure */
|
||||
static UInt
|
||||
do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, PredEntry *ap, UInt i, UInt arity, UInt argno, UInt fail_l, int first, int last_arg, int clleft, CELL *top)
|
||||
do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, PredEntry *ap, UInt i, UInt arity, UInt argno, UInt fail_l, int first, int last_arg, int clleft, CELL *top, int done_work)
|
||||
{
|
||||
int ret_lab = 0, *newlabp;
|
||||
CELL *top0 = top;
|
||||
ClauseDef *min, *max;
|
||||
int found_index = FALSE, done_work = FALSE, lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
||||
int found_index = FALSE, lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
||||
|
||||
newlabp = & ret_lab;
|
||||
if (min0 == max0) {
|
||||
@ -3212,7 +3212,7 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, PredEntry *ap, U
|
||||
if (sreg == NULL || !isvt) {
|
||||
found_index = TRUE;
|
||||
} else {
|
||||
done_work = TRUE;
|
||||
done_work |= TRUE;
|
||||
}
|
||||
}
|
||||
top = top0;
|
||||
@ -4053,17 +4053,17 @@ expand_index(PredEntry *ap) {
|
||||
sp--;
|
||||
}
|
||||
}
|
||||
lab = do_compound_index(cls, max, s_reg, ap, i, arity, argno, fail_l, isfirstcl, is_last_arg, clleft, top);
|
||||
lab = do_compound_index(cls, max, s_reg, ap, i, arity, argno, fail_l, isfirstcl, is_last_arg, clleft, top, FALSE);
|
||||
}
|
||||
} else if (IsPairTerm(sp[-1].val) && sp > stack) {
|
||||
lab = do_compound_index(cls, max, s_reg, ap, i, 2, argno, fail_l, isfirstcl, is_last_arg, clleft, top);
|
||||
lab = do_compound_index(cls, max, s_reg, ap, i, 2, argno, fail_l, isfirstcl, is_last_arg, clleft, top, FALSE);
|
||||
} else {
|
||||
Functor f = (Functor)RepAppl(sp[-1].val);
|
||||
/* we are continuing within a compound term */
|
||||
if (IsExtensionFunctor(f)) {
|
||||
lab = do_index(cls, max, ap, argno+1, fail_l, isfirstcl, clleft, top);
|
||||
} else {
|
||||
lab = do_compound_index(cls, max, s_reg, ap, i, ArityOfFunctor(f), argno, fail_l, isfirstcl, is_last_arg, clleft, top);
|
||||
lab = do_compound_index(cls, max, s_reg, ap, i, ArityOfFunctor(f), argno, fail_l, isfirstcl, is_last_arg, clleft, top, FALSE);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
@ -4768,6 +4768,10 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
|
||||
ncl->ClRefCount = 0;
|
||||
ncl->u.ParentIndex = blk->u.ParentIndex;
|
||||
ncl->ChildIndex = NULL;
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INIT_LOCK(ncl->ClLock);
|
||||
INIT_CLREF_COUNT(ncl);
|
||||
#endif
|
||||
codep = start = ncl->ClCode;
|
||||
/* ok, we've allocated and set up things, now let's finish */
|
||||
codep->opc = Yap_opcode(_enter_lu_pred);
|
||||
|
14
C/init.c
14
C/init.c
@ -495,7 +495,7 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int
|
||||
Atom atom = Yap_LookupAtom(Name);
|
||||
PredEntry *pe;
|
||||
yamop *p_code = ((StaticClause *)NULL)->ClCode;
|
||||
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),lxx),e));
|
||||
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),llxx),e));
|
||||
|
||||
cl->ClFlags = 0;
|
||||
p_code = cl->ClCode;
|
||||
@ -508,11 +508,12 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int
|
||||
pe->cs.d_code = cmp_code;
|
||||
pe->ModuleOfPred = CurrentModule;
|
||||
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
|
||||
p_code->u.lxx.p = pe;
|
||||
p_code->u.lxx.x1 = Yap_emit_x(1);
|
||||
p_code->u.lxx.x2 = Yap_emit_x(2);
|
||||
p_code->u.lxx.flags = Yap_compile_cmp_flags(pe);
|
||||
p_code = NEXTOP(p_code,lxx);
|
||||
p_code->u.llxx.p = pe;
|
||||
p_code->u.llxx.f = FAILCODE;
|
||||
p_code->u.llxx.x1 = Yap_emit_x(1);
|
||||
p_code->u.llxx.x2 = Yap_emit_x(2);
|
||||
p_code->u.llxx.flags = Yap_compile_cmp_flags(pe);
|
||||
p_code = NEXTOP(p_code,llxx);
|
||||
p_code->opc = Yap_opcode(_procceed);
|
||||
}
|
||||
|
||||
@ -751,6 +752,7 @@ InitCodes(void)
|
||||
#endif /* YAPOR */
|
||||
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
INIT_RWLOCK(heap_regs->bgl);
|
||||
INIT_LOCK(heap_regs->free_blocks_lock);
|
||||
INIT_LOCK(heap_regs->heap_used_lock);
|
||||
INIT_LOCK(heap_regs->heap_top_lock);
|
||||
|
@ -169,8 +169,8 @@
|
||||
OPCODE(expand_index ,e),
|
||||
OPCODE(save_b_x ,x),
|
||||
OPCODE(save_b_y ,y),
|
||||
OPCODE(comit_b_x ,x),
|
||||
OPCODE(comit_b_y ,y),
|
||||
OPCODE(commit_b_x ,x),
|
||||
OPCODE(commit_b_y ,y),
|
||||
OPCODE(undef_p ,e),
|
||||
OPCODE(spy_pred ,e),
|
||||
OPCODE(spy_or_trymark ,ld),
|
||||
|
23
H/amidefs.h
23
H/amidefs.h
@ -166,6 +166,16 @@ typedef struct yami {
|
||||
CODEADDR l2;
|
||||
CELL next;
|
||||
} fll;
|
||||
struct {
|
||||
wamreg x;
|
||||
struct yami *f;
|
||||
CELL next;
|
||||
} fx;
|
||||
struct {
|
||||
yslot y;
|
||||
struct yami *f;
|
||||
CELL next;
|
||||
} fy;
|
||||
struct {
|
||||
struct logic_upd_index *I;
|
||||
struct yami *l1;
|
||||
@ -265,25 +275,28 @@ typedef struct yami {
|
||||
} sllll;
|
||||
struct {
|
||||
struct pred_entry *p;
|
||||
struct yami *f;
|
||||
wamreg x1;
|
||||
wamreg x2;
|
||||
wamreg flags;
|
||||
CELL next;
|
||||
} lxx;
|
||||
} llxx;
|
||||
struct {
|
||||
struct pred_entry *p;
|
||||
struct pred_entry *p;
|
||||
struct yami *f;
|
||||
wamreg x;
|
||||
yslot y;
|
||||
wamreg flags;
|
||||
CELL next;
|
||||
} lxy;
|
||||
} llxy;
|
||||
struct {
|
||||
struct pred_entry *p;
|
||||
struct pred_entry *p;
|
||||
struct yami *f;
|
||||
wamreg y1;
|
||||
yslot y2;
|
||||
wamreg flags;
|
||||
CELL next;
|
||||
} lyy;
|
||||
} llyy;
|
||||
struct {
|
||||
OPCODE pop;
|
||||
struct yami *l1;
|
||||
|
@ -30,6 +30,7 @@ typedef enum compiler_op {
|
||||
put_num_op,
|
||||
get_float_op,
|
||||
put_float_op,
|
||||
align_float_op,
|
||||
get_longint_op,
|
||||
put_longint_op,
|
||||
get_bigint_op,
|
||||
@ -82,7 +83,7 @@ typedef enum compiler_op {
|
||||
pushpop_or_op,
|
||||
pop_or_op,
|
||||
save_b_op,
|
||||
comit_b_op,
|
||||
commit_b_op,
|
||||
patch_b_op,
|
||||
try_op,
|
||||
retry_op,
|
||||
@ -103,7 +104,7 @@ typedef enum compiler_op {
|
||||
if_nonvar_op,
|
||||
save_pair_op,
|
||||
save_appl_op,
|
||||
comit_opt_op,
|
||||
commit_opt_op,
|
||||
unify_local_op,
|
||||
write_local_op,
|
||||
unify_last_list_op,
|
||||
@ -219,7 +220,7 @@ typedef struct CEXPENTRY {
|
||||
|
||||
|
||||
#define save_b_flag 10000
|
||||
#define comit_b_flag 10001
|
||||
#define commit_b_flag 10001
|
||||
#define save_appl_flag 10002
|
||||
#define save_pair_flag 10004
|
||||
#define f_flag 10008
|
||||
|
37
H/rheap.h
37
H/rheap.h
@ -759,7 +759,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
|
||||
break;
|
||||
/* instructions type x */
|
||||
case _save_b_x:
|
||||
case _comit_b_x:
|
||||
case _commit_b_x:
|
||||
case _get_list:
|
||||
case _put_list:
|
||||
case _write_x_var:
|
||||
@ -781,7 +781,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
|
||||
break;
|
||||
/* instructions type y */
|
||||
case _save_b_y:
|
||||
case _comit_b_y:
|
||||
case _commit_b_y:
|
||||
case _write_y_var:
|
||||
case _write_y_val:
|
||||
case _write_y_loc:
|
||||
@ -1312,7 +1312,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
|
||||
pc->u.ycx.xi = XAdjust(pc->u.ycx.xi);
|
||||
pc = NEXTOP(pc,ycx);
|
||||
break;
|
||||
/* instructions type lxx */
|
||||
/* instructions type ycx */
|
||||
case _p_func2s_y_cv:
|
||||
pc->u.ycx.y = YAdjust(pc->u.ycx.y);
|
||||
if (IsAtomTerm(pc->u.ycx.c))
|
||||
@ -1320,26 +1320,29 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
|
||||
pc->u.ycx.xi = XAdjust(pc->u.ycx.xi);
|
||||
pc = NEXTOP(pc,ycx);
|
||||
break;
|
||||
/* instructions type lxx */
|
||||
/* instructions type llxx */
|
||||
case _call_bfunc_xx:
|
||||
pc->u.lxx.p = PtoPredAdjust(pc->u.lxx.p);
|
||||
pc->u.lxx.x1 = XAdjust(pc->u.lxx.x1);
|
||||
pc->u.lxx.x2 = XAdjust(pc->u.lxx.x2);
|
||||
pc = NEXTOP(pc,lxx);
|
||||
pc->u.llxx.p = PtoPredAdjust(pc->u.llxx.p);
|
||||
pc->u.llxx.f = PtoOpAdjust(pc->u.llxx.f);
|
||||
pc->u.llxx.x1 = XAdjust(pc->u.llxx.x1);
|
||||
pc->u.llxx.x2 = XAdjust(pc->u.llxx.x2);
|
||||
pc = NEXTOP(pc,llxx);
|
||||
break;
|
||||
/* instructions type lxy */
|
||||
/* instructions type llxy */
|
||||
case _call_bfunc_yx:
|
||||
case _call_bfunc_xy:
|
||||
pc->u.lxy.p = PtoPredAdjust(pc->u.lxy.p);
|
||||
pc->u.lxy.x = XAdjust(pc->u.lxy.x);
|
||||
pc->u.lxy.y = YAdjust(pc->u.lxy.y);
|
||||
pc = NEXTOP(pc,lxy);
|
||||
pc->u.llxy.p = PtoPredAdjust(pc->u.llxy.p);
|
||||
pc->u.llxy.f = PtoOpAdjust(pc->u.llxy.f);
|
||||
pc->u.llxy.x = XAdjust(pc->u.llxy.x);
|
||||
pc->u.llxy.y = YAdjust(pc->u.llxy.y);
|
||||
pc = NEXTOP(pc,llxy);
|
||||
break;
|
||||
case _call_bfunc_yy:
|
||||
pc->u.lyy.p = PtoPredAdjust(pc->u.lyy.p);
|
||||
pc->u.lyy.y1 = YAdjust(pc->u.lyy.y1);
|
||||
pc->u.lyy.y2 = YAdjust(pc->u.lyy.y2);
|
||||
pc = NEXTOP(pc,lyy);
|
||||
pc->u.llyy.p = PtoPredAdjust(pc->u.llyy.p);
|
||||
pc->u.llyy.f = PtoOpAdjust(pc->u.llxy.f);
|
||||
pc->u.llyy.y1 = YAdjust(pc->u.llyy.y1);
|
||||
pc->u.llyy.y2 = YAdjust(pc->u.llyy.y2);
|
||||
pc = NEXTOP(pc,llyy);
|
||||
break;
|
||||
}
|
||||
} while (TRUE);
|
||||
|
@ -10,7 +10,7 @@
|
||||
* File: TermExt.h *
|
||||
* mods: *
|
||||
* comments: Extensions to standard terms for YAP *
|
||||
* version: $Id: TermExt.h.m4,v 1.10 2003-08-27 13:37:10 vsc Exp $ *
|
||||
* version: $Id: TermExt.h.m4,v 1.11 2003-12-27 00:38:53 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#if USE_OFFSETS
|
||||
@ -117,18 +117,21 @@ Destructor(Term, FloatOf, Float, t, *(Float *)(RepAppl(t)+1))
|
||||
|
||||
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
|
||||
|
||||
#ifdef i386X
|
||||
#define DOUBLE_ALIGNED(ADDR) TRUE
|
||||
#else
|
||||
/* first, need to address the alignment problem */
|
||||
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
|
||||
#endif
|
||||
|
||||
inline EXTERN Float STD_PROTO(CpFloatUnaligned,(CELL *));
|
||||
|
||||
|
||||
inline EXTERN void STD_PROTO(AlignGlobalForDouble,(void));
|
||||
|
||||
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
|
||||
|
||||
#ifdef i386
|
||||
inline EXTERN Float
|
||||
CpFloatUnaligned(CELL *ptr)
|
||||
{
|
||||
return *((Float *)(ptr+1));
|
||||
}
|
||||
|
||||
#else
|
||||
/* first, need to address the alignment problem */
|
||||
inline EXTERN Float
|
||||
CpFloatUnaligned(CELL *ptr)
|
||||
{
|
||||
@ -138,6 +141,8 @@ CpFloatUnaligned(CELL *ptr)
|
||||
return(u.f);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
Inline(MkFloatTerm, Term, Float, dbl, (AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=((3*sizeof(CELL)+EndSpecials)|MBIT), H+=4, AbsAppl(H-4)))
|
||||
|
||||
Destructor(Term, FloatOf, Float, t, (DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t))))
|
||||
|
@ -353,4 +353,3 @@ succ(M,N) :- integer(M), !, '$plus'(M,1,N).
|
||||
succ(M,N) :- integer(N), !, N > 0, '$plus'(N,-1,M).
|
||||
succ(0,1).
|
||||
|
||||
|
||||
|
@ -14,6 +14,7 @@
|
||||
* comments: boot file for Prolog *
|
||||
* *
|
||||
*************************************************************************/
|
||||
% process an input clause
|
||||
|
||||
|
||||
% This one should come first so that disjunctions and long distance
|
||||
|
@ -633,7 +633,7 @@ debugging :-
|
||||
'$deb_inc_in_sterm_oldie'(C,[],C).
|
||||
|
||||
'$get_sterm_list'(L0,C,N,L) :-
|
||||
( C =:= "^", N \== 0 -> get0(CN),
|
||||
( C =:= "^", N =\= 0 -> get0(CN),
|
||||
'$get_sterm_list'([N|L0],CN,0,L) ;
|
||||
C >= "0", C =< "9" -> NN is 10*N+C-"0", get0(CN),
|
||||
'$get_sterm_list'(L0,CN,NN,L);
|
||||
|
@ -56,6 +56,9 @@ listing(V) :-
|
||||
'$do_error'(domain_error(predicate_spec,Name),listing(Name)).
|
||||
|
||||
'$list_clauses'(Stream, M, Pred) :-
|
||||
'$flags'(Pred,M,Flags,Flags),
|
||||
% has to be dynamic, source, or log update.
|
||||
Flags /\ 0x08402000 =\= 0,
|
||||
'$clause'(Pred, M, Body),
|
||||
'$portray_clause'(Stream,(Pred:-Body)),
|
||||
fail.
|
||||
|
@ -442,6 +442,10 @@ module(N) :-
|
||||
'$meta_predicate'(M:D, _) :- !,
|
||||
'$meta_predicate'(D, M).
|
||||
'$meta_predicate'(P, M1) :-
|
||||
'$install_meta_predicate'(P, M1).
|
||||
|
||||
|
||||
'$install_meta_predicate'(P, M1) :-
|
||||
functor(P,F,N),
|
||||
( M1 = prolog -> M = _ ; M1 = M),
|
||||
( retractall('$meta_predicate'(F,M,N,_)), fail ; true),
|
||||
@ -537,8 +541,10 @@ source_module(Mod) :-
|
||||
'$member'(X,[X|_]) :- !.
|
||||
'$member'(X,[_|L]) :- '$member'(X,L).
|
||||
|
||||
% comma has its own problems.
|
||||
:- '$install_meta_predicate'((:,:), prolog).
|
||||
|
||||
:- meta_predicate
|
||||
% [:,:],
|
||||
abolish(:),
|
||||
abolish(:,+),
|
||||
all(?,:,?),
|
||||
|
@ -760,7 +760,7 @@ dynamic_predicate(P,Sem) :-
|
||||
'$is_dynamic'(T, Mod), !. % all dynamic predicates are public.
|
||||
'$is_public'(T, Mod) :-
|
||||
'$flags'(T,Mod,F,F),
|
||||
F\/0x00400000 \== 0.
|
||||
F\/0x00400000 =\= 0.
|
||||
|
||||
hide_predicate(V) :- var(V), !,
|
||||
'$do_error'(instantiation_error,hide_predicate(V)).
|
||||
|
Reference in New Issue
Block a user