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

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:
vsc 2003-12-27 00:38:53 +00:00
parent b16de6ad3d
commit 80fd1bcc91
20 changed files with 441 additions and 293 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

283
C/absmi.c
View File

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

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

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

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

15
C/computils.c
View File

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

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

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

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

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

4
H/YapOpcodes.h
View File

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

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

7
H/compile.h
View File

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

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

23
m4/TermExt.h.m4
View File

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

1
pl/arith.yap
View File

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

1
pl/boot.yap
View File

@ -14,6 +14,7 @@
* comments: boot file for Prolog *
* *
*************************************************************************/
% process an input clause
% This one should come first so that disjunctions and long distance

2
pl/debug.yap
View File

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

3
pl/listing.yap
View File

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

8
pl/modules.yap
View File

@ -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(?,:,?),

2
pl/preds.yap
View File

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