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) if ((ADDR) pt1 >= Yap_TrailBase)
#endif /* SBA */ #endif /* SBA */
{ {
pt0 = (tr_fr_ptr) pt1;
goto failloop; goto failloop;
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
flags = *pt1; flags = *pt1;
#if defined(YAPOR) || defined(THREADS) #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) { if (flags & LogUpdMask) {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1); if (flags & IndexMask) {
int erase; LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
LOCK(cl->ClLock); int erase;
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); LOCK(cl->ClLock);
UNLOCK(cl->ClLock); DEC_CLREF_COUNT(cl);
if (erase) { erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
saveregs(); UNLOCK(cl->ClLock);
/* at this point, if (erase) {
we are the only ones accessing the clause, saveregs();
hence we don't need to have a lock it */ /* at this point,
Yap_ErLogUpdCl(cl); we are the only ones accessing the clause,
setregs(); 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 { } else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1); DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase; int erase;
LOCK(cl->ClLock); LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount); erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
@ -1643,19 +1677,6 @@ Yap_absmi(int inp)
setregs(); 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 #else
ResetFlag(InUseMask, flags); ResetFlag(InUseMask, flags);
@ -1810,15 +1831,15 @@ Yap_absmi(int inp)
GONext(); GONext();
ENDOp(); ENDOp();
/* comit_b_x Xi */ /* commit_b_x Xi */
Op(comit_b_x, x); Op(commit_b_x, x);
BEGD(d0); BEGD(d0);
d0 = XREG(PREG->u.x.x); d0 = XREG(PREG->u.x.x);
#ifdef COROUTINING #ifdef COROUTINING
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
check_stack(NoStackComitX, H); check_stack(NoStackCommitX, H);
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();
do_comit_b_x: do_commit_b_x:
#endif #endif
/* skip a void call and a label */ /* skip a void call and a label */
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, x),sla),l); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, x),sla),l);
@ -1847,15 +1868,15 @@ Yap_absmi(int inp)
GONext(); GONext();
ENDOp(); ENDOp();
/* comit_b_y Yi */ /* commit_b_y Yi */
Op(comit_b_y, y); Op(commit_b_y, y);
BEGD(d0); BEGD(d0);
d0 = YREG[PREG->u.y.y]; d0 = YREG[PREG->u.y.y];
#ifdef COROUTINING #ifdef COROUTINING
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
check_stack(NoStackComitY, H); check_stack(NoStackCommitY, H);
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();
do_comit_b_y: do_commit_b_y:
#endif #endif
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, y),sla),l); PREG = NEXTOP(NEXTOP(NEXTOP(PREG, y),sla),l);
{ {
@ -2199,7 +2220,7 @@ Yap_absmi(int inp)
#ifdef COROUTINING #ifdef COROUTINING
/* This is easier: I know there is an environment so I cannot do allocate */ /* This is easier: I know there is an environment so I cannot do allocate */
NoStackComitY: NoStackCommitY:
/* find something to fool S */ /* find something to fool S */
if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) { if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0)); SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
@ -2208,10 +2229,10 @@ Yap_absmi(int inp)
goto creep_either; goto creep_either;
} }
/* don't do debugging and friends here */ /* 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? */ /* Problem: have I got an environment or not? */
NoStackComitX: NoStackCommitX:
/* find something to fool S */ /* find something to fool S */
if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) { if (CFREG == Unsigned(LCL0) && Yap_ReadTimedVar(WokenGoals) != TermNil) {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0)); SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
@ -2235,7 +2256,7 @@ Yap_absmi(int inp)
goto creep_either; goto creep_either;
} }
/* don't do debugging and friends here */ /* don't do debugging and friends here */
goto do_comit_b_x; goto do_commit_b_x;
/* don't forget I cannot creep at ; */ /* don't forget I cannot creep at ; */
NoStackEither: NoStackEither:
@ -6352,31 +6373,33 @@ Yap_absmi(int inp)
BOp(index_pred, e); BOp(index_pred, e);
saveregs(); saveregs();
WRITE_LOCK(PredFromDefCode(PREG)->PRWLock); {
PredEntry *ap = PredFromDefCode(PREG);
WRITE_LOCK(ap->PRWLock);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
/* /*
we do not lock access to the predicate, we do not lock access to the predicate,
we must take extra care here we must take extra care here
*/ */
if (PredFromDefCode(PREG)->OpcodeOfPred != INDEX_OPCODE) { if (ap->OpcodeOfPred != INDEX_OPCODE) {
/* someone was here before we were */ /* someone was here before we were */
Yap_Error(SYSTEM_ERROR,TermNil,"Bad locking"); PREG = ap->CodeOfPred;
PREG = PredFromDefCode(PREG)->CodeOfPred; WRITE_UNLOCK(ap->PRWLock);
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock); JMPNext();
JMPNext(); }
}
#endif #endif
/* update ASP before calling IPred */ /* update ASP before calling IPred */
ASP = YREG+E_CB; ASP = YREG+E_CB;
if (ASP > (CELL *) B) { if (ASP > (CELL *) B) {
ASP = (CELL *) B; ASP = (CELL *) B;
} }
Yap_IPred(PredFromDefCode(PREG)); Yap_IPred(ap);
/* IPred can generate errors, it thus must get rid of the lock itself */ /* IPred can generate errors, it thus must get rid of the lock itself */
setregs(); setregs();
CACHED_A1() = ARG1; CACHED_A1() = ARG1;
PREG = PredFromDefCode(PREG)->CodeOfPred; PREG = ap->CodeOfPred;
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock); WRITE_UNLOCK(ap->PRWLock);
}
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -9246,12 +9269,12 @@ Yap_absmi(int inp)
ENDD(d0); ENDD(d0);
ENDOp(); ENDOp();
BOp(call_bfunc_xx, lxx); BOp(call_bfunc_xx, llxx);
BEGD(d0); BEGD(d0);
BEGD(d1); BEGD(d1);
d0 = XREG(PREG->u.lxx.x1); d0 = XREG(PREG->u.llxx.x1);
call_bfunc_xx_nvar: call_bfunc_xx_nvar:
d1 = XREG(PREG->u.lxx.x2); d1 = XREG(PREG->u.llxx.x2);
call_bfunc_xx2_nvar: call_bfunc_xx2_nvar:
deref_head(d0, call_bfunc_xx_unk); deref_head(d0, call_bfunc_xx_unk);
deref_head(d1, call_bfunc_xx2_unk); deref_head(d1, call_bfunc_xx2_unk);
@ -9259,37 +9282,46 @@ Yap_absmi(int inp)
int flags; int flags;
Int v = IntOfTerm(d0) - IntOfTerm(d1); Int v = IntOfTerm(d0) - IntOfTerm(d1);
flags = PREG->u.lxx.flags; flags = PREG->u.llxx.flags;
PREG = NEXTOP(PREG, lxx);
if (v > 0) { if (v > 0) {
if (flags & GT_OK_IN_CMP) { if (flags & GT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxx);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxx.f;
JMPNext();
}
} else if (v < 0) { } else if (v < 0) {
if (flags & LT_OK_IN_CMP) { if (flags & LT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxx);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxx.f;
JMPNext();
}
} else /* if (v == 0) */ { } else /* if (v == 0) */ {
if (flags & EQ_OK_IN_CMP) { if (flags & EQ_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxx);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxx.f;
JMPNext();
}
} }
} }
exec_bin_cmp_xx: exec_bin_cmp_xx:
{ {
CmpPredicate f = PREG->u.lxx.p->cs.d_code; CmpPredicate f = PREG->u.llxx.p->cs.d_code;
PREG = NEXTOP(PREG, lxx);
saveregs(); saveregs();
d0 = (CELL) (f) (d0,d1); d0 = (CELL) (f) (d0,d1);
} }
setregs(); setregs();
if (!d0) { if (!d0) {
FAIL(); PREG = PREG->u.llxx.f;
JMPNext();
} }
PREG = NEXTOP(PREG, llxx);
JMPNext(); JMPNext();
BEGP(pt0); BEGP(pt0);
@ -9306,12 +9338,12 @@ Yap_absmi(int inp)
ENDD(d0); ENDD(d0);
ENDBOp(); ENDBOp();
BOp(call_bfunc_yx, lxy); BOp(call_bfunc_yx, llxy);
BEGD(d0); BEGD(d0);
BEGD(d1); BEGD(d1);
BEGP(pt0); BEGP(pt0);
pt0 = YREG + PREG->u.lxy.y; pt0 = YREG + PREG->u.llxy.y;
d1 = XREG(PREG->u.lxy.x); d1 = XREG(PREG->u.llxy.x);
d0 = *pt0; d0 = *pt0;
ENDP(pt0); ENDP(pt0);
deref_head(d0, call_bfunc_yx_unk); deref_head(d0, call_bfunc_yx_unk);
@ -9322,36 +9354,45 @@ Yap_absmi(int inp)
int flags; int flags;
Int v = IntOfTerm(d0) - IntOfTerm(d1); Int v = IntOfTerm(d0) - IntOfTerm(d1);
flags = PREG->u.lxy.flags; flags = PREG->u.llxy.flags;
PREG = NEXTOP(PREG, lxy);
if (v > 0) { if (v > 0) {
if (flags & GT_OK_IN_CMP) { if (flags & GT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
}
} else if (v < 0) { } else if (v < 0) {
if (flags & LT_OK_IN_CMP) { if (flags & LT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
}
} else /* if (v == 0) */ { } else /* if (v == 0) */ {
if (flags & EQ_OK_IN_CMP) { if (flags & EQ_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
}
} }
} }
exec_bin_cmp_yx: exec_bin_cmp_yx:
{ {
CmpPredicate f = PREG->u.lxy.p->cs.d_code; CmpPredicate f = PREG->u.llxy.p->cs.d_code;
PREG = NEXTOP(PREG, lxy);
saveregs(); saveregs();
d0 = (CELL) (f) (d0,d1); d0 = (CELL) (f) (d0,d1);
} }
setregs(); setregs();
if (!d0) { if (!d0) {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
} }
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
BEGP(pt0); BEGP(pt0);
@ -9368,12 +9409,12 @@ Yap_absmi(int inp)
ENDD(d0); ENDD(d0);
ENDBOp(); ENDBOp();
BOp(call_bfunc_xy, lxy); BOp(call_bfunc_xy, llxy);
BEGD(d0); BEGD(d0);
BEGD(d1); BEGD(d1);
BEGP(pt0); BEGP(pt0);
pt0 = YREG + PREG->u.lxy.y; pt0 = YREG + PREG->u.llxy.y;
d0 = XREG(PREG->u.lxy.x); d0 = XREG(PREG->u.llxy.x);
d1 = *pt0; d1 = *pt0;
ENDP(pt0); ENDP(pt0);
deref_head(d0, call_bfunc_xy_unk); deref_head(d0, call_bfunc_xy_unk);
@ -9384,36 +9425,45 @@ Yap_absmi(int inp)
int flags; int flags;
Int v = IntOfTerm(d0) - IntOfTerm(d1); Int v = IntOfTerm(d0) - IntOfTerm(d1);
flags = PREG->u.lxy.flags; flags = PREG->u.llxy.flags;
PREG = NEXTOP(PREG, lxy);
if (v > 0) { if (v > 0) {
if (flags & GT_OK_IN_CMP) { if (flags & GT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
}
} else if (v < 0) { } else if (v < 0) {
if (flags & LT_OK_IN_CMP) { if (flags & LT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
}
} else /* if (v == 0) */ { } else /* if (v == 0) */ {
if (flags & EQ_OK_IN_CMP) { if (flags & EQ_OK_IN_CMP) {
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
}
} }
} }
exec_bin_cmp_xy: exec_bin_cmp_xy:
{ {
CmpPredicate f = PREG->u.lxy.p->cs.d_code; CmpPredicate f = PREG->u.llxy.p->cs.d_code;
PREG = NEXTOP(PREG, lxy);
saveregs(); saveregs();
d0 = (CELL) (f) (d0,d1); d0 = (CELL) (f) (d0,d1);
} }
setregs(); setregs();
if (!d0) { if (!d0) {
FAIL(); PREG = PREG->u.llxy.f;
JMPNext();
} }
PREG = NEXTOP(PREG, llxy);
JMPNext(); JMPNext();
BEGP(pt0); BEGP(pt0);
@ -9430,13 +9480,13 @@ Yap_absmi(int inp)
ENDD(d0); ENDD(d0);
ENDBOp(); ENDBOp();
BOp(call_bfunc_yy, lyy); BOp(call_bfunc_yy, llyy);
BEGD(d0); BEGD(d0);
BEGD(d1); BEGD(d1);
BEGP(pt0); BEGP(pt0);
pt0 = YREG + PREG->u.lyy.y1; pt0 = YREG + PREG->u.llyy.y1;
BEGP(pt1); BEGP(pt1);
pt1 = YREG + PREG->u.lyy.y2; pt1 = YREG + PREG->u.llyy.y2;
d0 = *pt0; d0 = *pt0;
d1 = *pt1; d1 = *pt1;
ENDP(pt1); ENDP(pt1);
@ -9449,36 +9499,45 @@ Yap_absmi(int inp)
int flags; int flags;
Int v = IntOfTerm(d0) - IntOfTerm(d1); Int v = IntOfTerm(d0) - IntOfTerm(d1);
flags = PREG->u.lyy.flags; flags = PREG->u.llyy.flags;
PREG = NEXTOP(PREG, lyy);
if (v > 0) { if (v > 0) {
if (flags & GT_OK_IN_CMP) { if (flags & GT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llyy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llyy.f;
JMPNext();
}
} else if (v < 0) { } else if (v < 0) {
if (flags & LT_OK_IN_CMP) { if (flags & LT_OK_IN_CMP) {
PREG = NEXTOP(PREG, llyy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llyy.f;
JMPNext();
}
} else /* if (v == 0) */ { } else /* if (v == 0) */ {
if (flags & EQ_OK_IN_CMP) { if (flags & EQ_OK_IN_CMP) {
PREG = NEXTOP(PREG, llyy);
JMPNext(); JMPNext();
} else } else {
FAIL(); PREG = PREG->u.llyy.f;
JMPNext();
}
} }
} }
exec_bin_cmp_yy: exec_bin_cmp_yy:
{ {
CmpPredicate f = PREG->u.lyy.p->cs.d_code; CmpPredicate f = PREG->u.llyy.p->cs.d_code;
PREG = NEXTOP(PREG, lyy);
saveregs(); saveregs();
d0 = (CELL) (f) (d0,d1); d0 = (CELL) (f) (d0,d1);
} }
setregs(); setregs();
if (!d0) { if (!d0) {
FAIL(); PREG = PREG->u.llyy.f;
JMPNext();
} }
PREG = NEXTOP(PREG, llyy);
JMPNext(); JMPNext();
BEGP(pt0); BEGP(pt0);

121
C/amasm.c
View File

@ -122,7 +122,7 @@ static int asm_error = FALSE;
static int assembling; static int assembling;
static CELL comit_lab; static CELL commit_lab;
static int do_not_optimize_uatom = FALSE; static int do_not_optimize_uatom = FALSE;
@ -742,7 +742,6 @@ check_alloc(void)
static void static void
a_p(op_numbers opcode) a_p(op_numbers opcode)
{ /* emit opcode & predicate code address */ { /* emit opcode & predicate code address */
int comit_ok = (comit_lab == 0);
Prop fe = (Prop) (cpc->rnd1); Prop fe = (Prop) (cpc->rnd1);
CELL Flags = RepPredProp(fe)->PredFlags; CELL Flags = RepPredProp(fe)->PredFlags;
if (Flags & AsmPredFlag) { if (Flags & AsmPredFlag) {
@ -769,16 +768,11 @@ a_p(op_numbers opcode)
longjmp(Yap_CompilerBotch, 1); longjmp(Yap_CompilerBotch, 1);
} }
a_e(op); a_e(op);
if (!comit_ok) {
Yap_Error(SYSTEM_ERROR, TermNil,"internal assembler error for commit");
save_machine_regs();
longjmp(Yap_CompilerBotch, 1);
}
return; return;
} }
if (Flags & CPredFlag) { if (Flags & CPredFlag) {
check_alloc(); check_alloc();
if (!comit_ok && (Flags & TestPredFlag)) { if (commit_lab && (Flags & TestPredFlag)) {
if (pass_no) { if (pass_no) {
if (Flags & UserCPredFlag) { if (Flags & UserCPredFlag) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_Error(SYSTEM_ERROR, TermNil,
@ -790,13 +784,12 @@ a_p(op_numbers opcode)
code_p->u.sdl.s = code_p->u.sdl.s =
emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2); emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
code_p->u.sdl.l = 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 = code_p->u.sdl.p =
emit_pe(RepPredProp(fe)); emit_pe(RepPredProp(fe));
} }
GONEXT(sdl); GONEXT(sdl);
comit_lab = 0; commit_lab = 0;
comit_ok = TRUE;
} }
else { else {
if (pass_no) { if (pass_no) {
@ -826,11 +819,6 @@ a_p(op_numbers opcode)
} }
GONEXT(sla); GONEXT(sla);
} }
if (!comit_ok) {
Yap_Error(SYSTEM_ERROR, TermNil, "internal assembler error for commit");
save_machine_regs();
longjmp(Yap_CompilerBotch,1);
}
return; return;
} }
@ -866,11 +854,6 @@ a_p(op_numbers opcode)
code_p->u.p.p = RepPredProp(fe); code_p->u.p.p = RepPredProp(fe);
GONEXT(p); 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 (ve->KindOfVE == PermVar) {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yy); code_p->opc = emit_op(_call_bfunc_yy);
code_p->u.lxy.p = RepPredProp(((Prop)pred)); code_p->u.llyy.p = RepPredProp(((Prop)pred));
code_p->u.lyy.y1 = v1; if (commit_lab) {
code_p->u.lyy.y2 = emit_yreg(var_offset); code_p->u.llyy.f =
code_p->u.lyy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE); 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 { } else {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_yx); code_p->opc = emit_op(_call_bfunc_yx);
code_p->u.lxy.p = RepPredProp(((Prop)pred)); code_p->u.llxy.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = emit_xreg(var_offset); if (commit_lab) {
code_p->u.lxy.y = v1; code_p->u.llxy.f =
code_p->u.lxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE); 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 { } else {
wamreg x1 = emit_xreg(var_offset); wamreg x1 = emit_xreg(var_offset);
@ -992,21 +989,35 @@ a_bfunc(CELL pred)
if (ve->KindOfVE == PermVar) { if (ve->KindOfVE == PermVar) {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xy); code_p->opc = emit_op(_call_bfunc_xy);
code_p->u.lxy.p = RepPredProp(((Prop)pred)); code_p->u.llxy.p = RepPredProp(((Prop)pred));
code_p->u.lxy.x = x1; if (commit_lab) {
code_p->u.lxy.y = emit_yreg(var_offset); code_p->u.llxy.f =
code_p->u.lxy.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE); 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 { } else {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(_call_bfunc_xx); code_p->opc = emit_op(_call_bfunc_xx);
code_p->u.lxy.p = RepPredProp(((Prop)pred)); code_p->u.llxx.p = RepPredProp(((Prop)pred));
code_p->u.lxx.x1 = x1; if (commit_lab) {
code_p->u.lxx.x2 = emit_xreg(var_offset); code_p->u.llxx.f =
code_p->u.lxx.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE); 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; code_p = code_addr;
cl_u = (union clause_obj *)code_p; cl_u = (union clause_obj *)code_p;
cpc = CodeStart; cpc = CodeStart;
comit_lab = 0L; commit_lab = 0L;
/* Space while for the clause flags */ /* Space while for the clause flags */
log_update = CurrentPred->PredFlags & LogUpdatePredFlag; log_update = CurrentPred->PredFlags & LogUpdatePredFlag;
dynamic = CurrentPred->PredFlags & DynamicPredFlag; dynamic = CurrentPred->PredFlags & DynamicPredFlag;
@ -2115,6 +2126,10 @@ do_pass(void)
cl_u->lui.SiblingIndex = NULL; cl_u->lui.SiblingIndex = NULL;
cl_u->lui.u.pred = CurrentPred; cl_u->lui.u.pred = CurrentPred;
cl_u->lui.ClRefCount = 0; 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; code_p = cl_u->lui.ClCode;
} else { } else {
@ -2331,8 +2346,8 @@ do_pass(void)
case patch_b_op: case patch_b_op:
a_v(_save_b_x); a_v(_save_b_x);
break; break;
case comit_b_op: case commit_b_op:
a_v(_comit_b_x); a_v(_commit_b_x);
#ifdef YAPOR #ifdef YAPOR
if (pass_no) if (pass_no)
PUT_YAMOP_CUT(entry_code); PUT_YAMOP_CUT(entry_code);
@ -2390,7 +2405,7 @@ do_pass(void)
break; break;
case trustme_op: case trustme_op:
if (log_update && assembling == ASSEMBLING_INDEX) { if (log_update && assembling == ASSEMBLING_INDEX) {
a_gl(_trust_logical_pred); a_cl(_trust_logical_pred);
} }
#ifdef TABLING #ifdef TABLING
if (tabled) if (tabled)
@ -2593,8 +2608,8 @@ do_pass(void)
case mark_live_regs_op: case mark_live_regs_op:
a_bregs(); a_bregs();
break; break;
case comit_opt_op: case commit_opt_op:
comit_lab = cpc->rnd1; commit_lab = cpc->rnd1;
break; break;
case fetch_args_vv_op: case fetch_args_vv_op:
a_fetch_vv(); a_fetch_vv();
@ -2631,6 +2646,18 @@ do_pass(void)
} }
a_bfunc(cpc->nextInst->rnd2); a_bfunc(cpc->nextInst->rnd2);
break; 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: case blob_op:
/* install a blob */ /* install a blob */
copy_blob(); copy_blob();

29
C/cmppreds.c
View File

@ -452,10 +452,11 @@ p_acomp(void)
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2"); Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE); return(FALSE);
} }
if (IsFloatTerm(t1) && IsFloatTerm(t2)) {
return(flt_cmp(FloatOfTerm(t1)-FloatOfTerm(t2)));
}
if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) { if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) {
return(int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(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); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
@ -532,10 +533,10 @@ a_eq(Term t1, Term t2)
Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2"); Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) == FloatOfTerm(t2)); return (FloatOfTerm(t1) == FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) == IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
@ -611,10 +612,10 @@ a_dif(Term t1, Term t2)
Yap_Error(INSTANTIATION_ERROR, t2, "=\\=/2"); Yap_Error(INSTANTIATION_ERROR, t2, "=\\=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) != FloatOfTerm(t2)); return (FloatOfTerm(t1) != FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) != IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
@ -690,10 +691,10 @@ a_gt(Term t1, Term t2)
Yap_Error(INSTANTIATION_ERROR, t2, ">/2"); Yap_Error(INSTANTIATION_ERROR, t2, ">/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) > FloatOfTerm(t2)); return (FloatOfTerm(t1) > FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) > IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
@ -769,10 +770,10 @@ a_ge(Term t1, Term t2)
Yap_Error(INSTANTIATION_ERROR, t1, ">=/2"); Yap_Error(INSTANTIATION_ERROR, t1, ">=/2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) >= FloatOfTerm(t2)); return (FloatOfTerm(t1) >= FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) >= IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
@ -848,10 +849,10 @@ a_lt(Term t1, Term t2)
Yap_Error(INSTANTIATION_ERROR, t2, "</2"); Yap_Error(INSTANTIATION_ERROR, t2, "</2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) < FloatOfTerm(t2)); return (FloatOfTerm(t1) < FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) < IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: case long_int_e:
@ -927,10 +928,10 @@ a_le(Term t1, Term t2)
Yap_Error(INSTANTIATION_ERROR, t2, "=</2"); Yap_Error(INSTANTIATION_ERROR, t2, "=</2");
return(FALSE); return(FALSE);
} }
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
if (IsFloatTerm(t1) && IsFloatTerm(t2)) if (IsFloatTerm(t1) && IsFloatTerm(t2))
return (FloatOfTerm(t1) <= FloatOfTerm(t2)); return (FloatOfTerm(t1) <= FloatOfTerm(t2));
if (IsIntegerTerm(t1) && IsIntegerTerm(t2))
return (IntegerOfTerm(t1) <= IntegerOfTerm(t2));
bt1 = Yap_Eval(t1, &v1); bt1 = Yap_Eval(t1, &v1);
switch (bt1) { switch (bt1) {
case long_int_e: 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: case save_b_flag:
Yap_emit(save_b_op, (CELL) v, Zero); Yap_emit(save_b_op, (CELL) v, Zero);
break; break;
case comit_b_flag: case commit_b_flag:
Yap_emit(comit_b_op, (CELL) v, Zero); Yap_emit(commit_b_op, (CELL) v, Zero);
Yap_emit(empty_call_op, Zero, Zero); Yap_emit(empty_call_op, Zero, Zero);
Yap_emit(restore_tmps_and_skip_op, Zero, Zero); Yap_emit(restore_tmps_and_skip_op, Zero, Zero);
break; 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 */ /* use a special list to store the blobs */
cpc = icpc; cpc = icpc;
if (IsFloatTerm(t)) {
Yap_emit(align_float_op, Zero, Zero);
}
Yap_emit(label_op, l1, Zero); Yap_emit(label_op, l1, Zero);
if (IsFloatTerm(t)) { if (IsFloatTerm(t)) {
/* let us do floats first */ /* let us do floats first */
@ -1265,10 +1268,10 @@ c_goal(Term Goal, int mod)
int save = onlast; int save = onlast;
int savegoalno = goalno; int savegoalno = goalno;
int frst = TRUE; int frst = TRUE;
int comitflag = 0; int commitflag = 0;
int looking_at_comit = FALSE; int looking_at_commit = FALSE;
int optimizing_comit = FALSE; int optimizing_commit = FALSE;
Term comitvar = 0; Term commitvar = 0;
PInstr *FirstP = cpc, *savecpc, *savencpc; PInstr *FirstP = cpc, *savecpc, *savencpc;
push_branch(onbranch, TermNil); push_branch(onbranch, TermNil);
@ -1277,32 +1280,32 @@ c_goal(Term Goal, int mod)
or_found = 1; or_found = 1;
do { do {
arg = ArgOfTerm(1, Goal); arg = ArgOfTerm(1, Goal);
looking_at_comit = IsApplTerm(arg) && looking_at_commit = IsApplTerm(arg) &&
FunctorOfTerm(arg) == FunctorArrow; FunctorOfTerm(arg) == FunctorArrow;
if (frst) { if (frst) {
if (optimizing_comit) { if (optimizing_commit) {
Yap_emit(label_op, l, Zero); Yap_emit(label_op, l, Zero);
l = ++labelno; l = ++labelno;
} }
Yap_emit_3ops(push_or_op, l, Zero, Zero); 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)) { Yap_is_a_test_pred(ArgOfTerm(1, arg), mod)) {
/* /*
* let them think they are still the * let them think they are still the
* first * first
*/ */
Yap_emit(comit_opt_op, l, Zero); Yap_emit(commit_opt_op, l, Zero);
optimizing_comit = TRUE; optimizing_commit = TRUE;
} }
else { else {
optimizing_comit = FALSE; optimizing_commit = FALSE;
Yap_emit_3ops(either_op, l, Zero, Zero); Yap_emit_3ops(either_op, l, Zero, Zero);
Yap_emit(restore_tmps_op, Zero, Zero); Yap_emit(restore_tmps_op, Zero, Zero);
frst = FALSE; frst = FALSE;
} }
} }
else { else {
optimizing_comit = FALSE; optimizing_commit = FALSE;
Yap_emit(label_op, l, Zero); Yap_emit(label_op, l, Zero);
Yap_emit(pushpop_or_op, Zero, Zero); Yap_emit(pushpop_or_op, Zero, Zero);
Yap_emit_3ops(orelse_op, l = ++labelno, Zero, Zero); Yap_emit_3ops(orelse_op, l = ++labelno, Zero, Zero);
@ -1311,8 +1314,8 @@ c_goal(Term Goal, int mod)
* if(IsApplTerm(arg) && * if(IsApplTerm(arg) &&
* FunctorOfTerm(arg)==FunctorArrow) { * FunctorOfTerm(arg)==FunctorArrow) {
*/ */
if (looking_at_comit) { if (looking_at_commit) {
if (!optimizing_comit && !comitflag) { if (!optimizing_commit && !commitflag) {
/* This instruction is placed before /* This instruction is placed before
* the disjunction. This means that * the disjunction. This means that
* the program counter must point * the program counter must point
@ -1323,8 +1326,8 @@ c_goal(Term Goal, int mod)
int my_goalno = goalno; int my_goalno = goalno;
goalno = savegoalno; goalno = savegoalno;
comitflag = labelno; commitflag = labelno;
comitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)freep0) { if (H == (CELL *)freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
@ -1334,8 +1337,8 @@ c_goal(Term Goal, int mod)
savencpc = FirstP->nextInst; savencpc = FirstP->nextInst;
cpc = FirstP; cpc = FirstP;
onbranch = pop_branch(); onbranch = pop_branch();
c_var(comitvar, save_b_flag, 1, 0); c_var(commitvar, save_b_flag, 1, 0);
push_branch(onbranch, comitvar); push_branch(onbranch, commitvar);
onbranch = cur_branch; onbranch = cur_branch;
cpc->nextInst = savencpc; cpc->nextInst = savencpc;
cpc = savecpc; cpc = savecpc;
@ -1344,8 +1347,8 @@ c_goal(Term Goal, int mod)
save = onlast; save = onlast;
onlast = FALSE; onlast = FALSE;
c_goal(ArgOfTerm(1, arg), mod); c_goal(ArgOfTerm(1, arg), mod);
if (!optimizing_comit) { if (!optimizing_commit) {
c_var((Term) comitvar, comit_b_flag, c_var((Term) commitvar, commit_b_flag,
1, 0); 1, 0);
} }
onlast = save; onlast = save;
@ -1364,10 +1367,10 @@ c_goal(Term Goal, int mod)
&& FunctorOfTerm(Goal) == FunctorOr); && FunctorOfTerm(Goal) == FunctorOr);
Yap_emit(pushpop_or_op, Zero, Zero); Yap_emit(pushpop_or_op, Zero, Zero);
Yap_emit(label_op, l, Zero); Yap_emit(label_op, l, Zero);
if (!optimizing_comit) if (!optimizing_commit)
Yap_emit(orlast_op, Zero, Zero); Yap_emit(orlast_op, Zero, Zero);
else { else {
optimizing_comit = FALSE; /* not really necessary */ optimizing_commit = FALSE; /* not really necessary */
} }
c_goal(Goal, mod); c_goal(Goal, mod);
/* --onbranch; */ /* --onbranch; */
@ -1394,25 +1397,25 @@ c_goal(Term Goal, int mod)
CELL label = (labelno += 2); CELL label = (labelno += 2);
CELL end_label = (labelno += 2); CELL end_label = (labelno += 2);
int save = onlast; int save = onlast;
Term comitvar; Term commitvar;
comitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)freep0) { if (H == (CELL *)freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
longjmp(Yap_CompilerBotch,4); longjmp(Yap_CompilerBotch,4);
} }
push_branch(onbranch, comitvar); push_branch(onbranch, commitvar);
++cur_branch; ++cur_branch;
onbranch = cur_branch; onbranch = cur_branch;
or_found = 1; or_found = 1;
onlast = FALSE; 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(push_or_op, label, Zero, Zero);
Yap_emit_3ops(either_op, label, Zero, Zero); Yap_emit_3ops(either_op, label, Zero, Zero);
Yap_emit(restore_tmps_op, Zero, Zero); Yap_emit(restore_tmps_op, Zero, Zero);
c_goal(ArgOfTerm(1, Goal), mod); c_goal(ArgOfTerm(1, Goal), mod);
c_var(comitvar, comit_b_flag, 1, 0); c_var(commitvar, commit_b_flag, 1, 0);
onlast = save; onlast = save;
Yap_emit(fail_op, end_label, Zero); Yap_emit(fail_op, end_label, Zero);
Yap_emit(pushpop_or_op, Zero, Zero); Yap_emit(pushpop_or_op, Zero, Zero);
@ -1428,19 +1431,19 @@ c_goal(Term Goal, int mod)
return; return;
} }
else if (f == FunctorArrow) { else if (f == FunctorArrow) {
Term comitvar; Term commitvar;
int save = onlast; int save = onlast;
comitvar = MkVarTerm(); commitvar = MkVarTerm();
if (H == (CELL *)freep0) { if (H == (CELL *)freep0) {
/* oops, too many new variables */ /* oops, too many new variables */
save_machine_regs(); save_machine_regs();
longjmp(Yap_CompilerBotch,4); longjmp(Yap_CompilerBotch,4);
} }
onlast = FALSE; 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_goal(ArgOfTerm(1, Goal), mod);
c_var(comitvar, comit_b_flag, 1, 0); c_var(commitvar, commit_b_flag, 1, 0);
onlast = save; onlast = save;
c_goal(ArgOfTerm(2, Goal), mod); c_goal(ArgOfTerm(2, Goal), mod);
return; return;
@ -1549,8 +1552,7 @@ c_goal(Term Goal, int mod)
current_p0 = p0; current_p0 = p0;
c_var(t2, bt2_flag, 2, 0); c_var(t2, bt2_flag, 2, 0);
} }
} } else {
else {
Term a2 = ArgOfTerm(2,Goal); Term a2 = ArgOfTerm(2,Goal);
Term t1 = MkVarTerm(); Term t1 = MkVarTerm();
if (H == (CELL *)freep0) { if (H == (CELL *)freep0) {
@ -1732,7 +1734,7 @@ usesvar(int ic)
return (TRUE); return (TRUE);
switch (ic) { switch (ic) {
case save_b_op: case save_b_op:
case comit_b_op: case commit_b_op:
case patch_b_op: case patch_b_op:
case save_appl_op: case save_appl_op:
case save_pair_op: case save_pair_op:
@ -2484,7 +2486,7 @@ c_layout(void)
Contents[rn] = NIL; Contents[rn] = NIL;
++Uses[rn]; ++Uses[rn];
break; break;
case comit_b_op: case commit_b_op:
#ifdef TABLING_INNER_CUTS #ifdef TABLING_INNER_CUTS
cut_mark->op = clause_with_cut_op; cut_mark->op = clause_with_cut_op;
#endif /* TABLING_INNER_CUTS */ #endif /* TABLING_INNER_CUTS */

15
C/computils.c
View File

@ -82,21 +82,21 @@ int
Yap_is_a_test_pred (Term arg, SMALLUNSGN mod) Yap_is_a_test_pred (Term arg, SMALLUNSGN mod)
{ {
if (IsVarTerm (arg)) if (IsVarTerm (arg))
return (FALSE); return FALSE;
else if (IsAtomTerm (arg)) { else if (IsAtomTerm (arg)) {
Atom At = AtomOfTerm (arg); Atom At = AtomOfTerm (arg);
PredEntry *pe = RepPredProp(PredPropByAtom(At, mod)); PredEntry *pe = RepPredProp(PredPropByAtom(At, mod));
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return (FALSE); return FALSE;
return (pe->PredFlags & TestPredFlag); return pe->PredFlags & TestPredFlag;
} else if (IsApplTerm (arg)) { } else if (IsApplTerm (arg)) {
Functor f = FunctorOfTerm (arg); Functor f = FunctorOfTerm (arg);
PredEntry *pe = RepPredProp(PredPropByFunc(f, mod)); PredEntry *pe = RepPredProp(PredPropByFunc(f, mod));
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return (FALSE); return FALSE;
return (pe->PredFlags & TestPredFlag); return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
} else { } else {
return (FALSE); return FALSE;
} }
} }
@ -516,6 +516,7 @@ static char *opformat[] =
"put_num\t\t%n,%r", "put_num\t\t%n,%r",
"get_float\t\t%l,%r", "get_float\t\t%l,%r",
"put_float\t\t%l,%r", "put_float\t\t%l,%r",
"align_float",
"get_longint\t\t%l,%r", "get_longint\t\t%l,%r",
"put_longint\t\t%l,%r", "put_longint\t\t%l,%r",
"get_bigint\t\t%l,%r", "get_bigint\t\t%l,%r",
@ -568,7 +569,7 @@ static char *opformat[] =
"pushpop_or", "pushpop_or",
"pop_or", "pop_or",
"save_by\t\t%v", "save_by\t\t%v",
"comit_by\t\t%v", "commit_by\t\t%v",
"patch_by\t\t%v", "patch_by\t\t%v",
"try\t\t%g\t%x", "try\t\t%g\t%x",
"retry\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--; lr--;
#endif #endif
if (!(dbentry->Flags & StaticMask)) { if (!(dbentry->Flags & StaticMask)) {
dbentry->NOfRefsTo++; if (dbentry->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbentry;
cl->ClRefCount++;
} else {
dbentry->NOfRefsTo++;
}
} }
*--tofref = dbentry; *--tofref = dbentry;
db_check_trail(lr); db_check_trail(lr);
@ -1229,7 +1235,12 @@ CreateDBWithDBRef(Term Tm, DBProp p)
INIT_DBREF_COUNT(pp); INIT_DBREF_COUNT(pp);
ppt = &(pp->DBT); ppt = &(pp->DBT);
} }
dbr->NOfRefsTo++; if (dbr->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbr;
cl->ClRefCount++;
} else {
dbr->NOfRefsTo++;
}
ppt->Entry = Tm; ppt->Entry = Tm;
ppt->NOfCells = 0; ppt->NOfCells = 0;
ppt->Contents[0] = (CELL)NULL; ppt->Contents[0] = (CELL)NULL;
@ -1835,7 +1846,11 @@ p_rcda(void)
cl = record_lu(pe, t2, MkFirst); cl = record_lu(pe, t2, MkFirst);
if (cl != NULL) { if (cl != NULL) {
TRAIL_CLREF(cl); TRAIL_CLREF(cl);
#if defined(YAPOR) || defined(THREADS)
INC_CLREF_COUNT(cl);
#else
cl->ClFlags |= InUseMask; cl->ClFlags |= InUseMask;
#endif
TRef = MkDBRefTerm((DBRef)cl); TRef = MkDBRefTerm((DBRef)cl);
} else { } else {
TRef = TermNil; TRef = TermNil;
@ -1978,7 +1993,11 @@ p_rcdz(void)
LogUpdClause *cl = record_lu(pe, t2, MkLast); LogUpdClause *cl = record_lu(pe, t2, MkLast);
if (cl != NULL) { if (cl != NULL) {
TRAIL_CLREF(cl); TRAIL_CLREF(cl);
#if defined(YAPOR) || defined(THREADS)
INC_CLREF_COUNT(cl);
#else
cl->ClFlags |= InUseMask; cl->ClFlags |= InUseMask;
#endif
TRef = MkDBRefTerm((DBRef)cl); TRef = MkDBRefTerm((DBRef)cl);
} else { } else {
TRef = TermNil; TRef = TermNil;
@ -4706,12 +4725,14 @@ keepdbrefs(DBTerm *entryref)
return; return;
} }
while ((ref = *--cp) != NIL) { while ((ref = *--cp) != NIL) {
LOCK(ref->lock); if (!(ref->Flags & LogUpdMask)) {
if(!(ref->Flags & InUseMask)) { LOCK(ref->lock);
ref->Flags |= InUseMask; if(!(ref->Flags & InUseMask)) {
TRAIL_REF(ref); /* So that fail will erase it */ 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_pair_op:
case save_appl_op: case save_appl_op:
case save_b_op: case save_b_op:
case comit_b_op: case commit_b_op:
pcpc->rnd1 = GlobalAdjust(pcpc->rnd1); pcpc->rnd1 = GlobalAdjust(pcpc->rnd1);
break; break;
default: default:

50
C/index.c
View File

@ -57,7 +57,7 @@ static char SccsId[] = "%W% %G%";
#endif #endif
UInt STATIC_PROTO(do_index, (ClauseDef *,ClauseDef *,PredEntry *,UInt,UInt,int,int,CELL *)); 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_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 *)); 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 _cut_e:
case _p_cut_by_y: case _p_cut_by_y:
case _p_cut_by_x: case _p_cut_by_x:
case _comit_b_y: case _commit_b_y:
case _comit_b_x: case _commit_b_x:
return TRUE; return TRUE;
case _try_me: case _try_me:
case _retry_me: case _retry_me:
@ -781,21 +781,21 @@ has_cut(yamop *pc)
case _p_arg_y_cv: case _p_arg_y_cv:
pc = NEXTOP(pc,ycx); pc = NEXTOP(pc,ycx);
break; break;
/* instructions type lxx */ /* instructions type ycx */
case _p_func2s_y_cv: case _p_func2s_y_cv:
pc = NEXTOP(pc,ycx); pc = NEXTOP(pc,ycx);
break; break;
/* instructions type lxx */ /* instructions type llxx */
case _call_bfunc_xx: case _call_bfunc_xx:
pc = NEXTOP(pc,lxx); pc = NEXTOP(pc,llxx);
break; break;
/* instructions type lxy */ /* instructions type llxy */
case _call_bfunc_yx: case _call_bfunc_yx:
case _call_bfunc_xy: case _call_bfunc_xy:
pc = NEXTOP(pc,lxy); pc = NEXTOP(pc,llxy);
break; break;
case _call_bfunc_yy: case _call_bfunc_yy:
pc = NEXTOP(pc,lyy); pc = NEXTOP(pc,llyy);
break; break;
} }
} while (TRUE); } while (TRUE);
@ -833,7 +833,7 @@ add_info(ClauseDef *clause, UInt regno)
cl = NEXTOP(cl,e); cl = NEXTOP(cl,e);
break; break;
case _save_b_x: case _save_b_x:
case _comit_b_x: case _commit_b_x:
case _p_cut_by_x: case _p_cut_by_x:
case _write_x_val: case _write_x_val:
case _write_x_loc: case _write_x_loc:
@ -928,7 +928,7 @@ add_info(ClauseDef *clause, UInt regno)
cl = NEXTOP(cl,x); cl = NEXTOP(cl,x);
break; break;
case _save_b_y: case _save_b_y:
case _comit_b_y: case _commit_b_y:
case _write_y_var: case _write_y_var:
case _write_y_val: case _write_y_val:
case _write_y_loc: case _write_y_loc:
@ -1499,14 +1499,14 @@ add_info(ClauseDef *clause, UInt regno)
cl = NEXTOP(cl,ycx); cl = NEXTOP(cl,ycx);
break; break;
case _call_bfunc_xx: case _call_bfunc_xx:
cl = NEXTOP(cl,lxx); cl = NEXTOP(cl,llxx);
break; break;
case _call_bfunc_yx: case _call_bfunc_yx:
case _call_bfunc_xy: case _call_bfunc_xy:
cl = NEXTOP(cl,lxy); cl = NEXTOP(cl,llxy);
break; break;
case _call_bfunc_yy: case _call_bfunc_yy:
cl = NEXTOP(cl,lyy); cl = NEXTOP(cl,llyy);
break; break;
case _Ystop: case _Ystop:
case _Nstop: 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) if (ap->PredFlags & LogUpdatePredFlag && max > min)
ics->Label = suspend_indexing(min, max, ap); ics->Label = suspend_indexing(min, max, ap);
else 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) { } else if (ap->PredFlags & LogUpdatePredFlag) {
ics->Label = suspend_indexing(min, max, ap); ics->Label = suspend_indexing(min, max, ap);
} else { } else {
@ -2804,7 +2804,7 @@ do_funcs(GroupDef *grp, Term t, PredEntry *ap, UInt argno, int first, int last_a
} else { } else {
sreg = NULL; 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; 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)) { if (min != max && !IsPairTerm(t)) {
return suspend_indexing(min, max, ap); 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 static void
@ -3161,12 +3161,12 @@ copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top)
/* execute an index inside a structure */ /* execute an index inside a structure */
static UInt 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; int ret_lab = 0, *newlabp;
CELL *top0 = top; CELL *top0 = top;
ClauseDef *min, *max; 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; newlabp = & ret_lab;
if (min0 == max0) { if (min0 == max0) {
@ -3212,7 +3212,7 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, PredEntry *ap, U
if (sreg == NULL || !isvt) { if (sreg == NULL || !isvt) {
found_index = TRUE; found_index = TRUE;
} else { } else {
done_work = TRUE; done_work |= TRUE;
} }
} }
top = top0; top = top0;
@ -4053,17 +4053,17 @@ expand_index(PredEntry *ap) {
sp--; 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) { } 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 { } else {
Functor f = (Functor)RepAppl(sp[-1].val); Functor f = (Functor)RepAppl(sp[-1].val);
/* we are continuing within a compound term */ /* we are continuing within a compound term */
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
lab = do_index(cls, max, ap, argno+1, fail_l, isfirstcl, clleft, top); lab = do_index(cls, max, ap, argno+1, fail_l, isfirstcl, clleft, top);
} else { } 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 { } else {
@ -4768,6 +4768,10 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
ncl->ClRefCount = 0; ncl->ClRefCount = 0;
ncl->u.ParentIndex = blk->u.ParentIndex; ncl->u.ParentIndex = blk->u.ParentIndex;
ncl->ChildIndex = NULL; ncl->ChildIndex = NULL;
#if defined(YAPOR) || defined(THREADS)
INIT_LOCK(ncl->ClLock);
INIT_CLREF_COUNT(ncl);
#endif
codep = start = ncl->ClCode; codep = start = ncl->ClCode;
/* ok, we've allocated and set up things, now let's finish */ /* ok, we've allocated and set up things, now let's finish */
codep->opc = Yap_opcode(_enter_lu_pred); 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); Atom atom = Yap_LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
yamop *p_code = ((StaticClause *)NULL)->ClCode; 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; cl->ClFlags = 0;
p_code = cl->ClCode; 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->cs.d_code = cmp_code;
pe->ModuleOfPred = CurrentModule; pe->ModuleOfPred = CurrentModule;
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx); p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
p_code->u.lxx.p = pe; p_code->u.llxx.p = pe;
p_code->u.lxx.x1 = Yap_emit_x(1); p_code->u.llxx.f = FAILCODE;
p_code->u.lxx.x2 = Yap_emit_x(2); p_code->u.llxx.x1 = Yap_emit_x(1);
p_code->u.lxx.flags = Yap_compile_cmp_flags(pe); p_code->u.llxx.x2 = Yap_emit_x(2);
p_code = NEXTOP(p_code,lxx); p_code->u.llxx.flags = Yap_compile_cmp_flags(pe);
p_code = NEXTOP(p_code,llxx);
p_code->opc = Yap_opcode(_procceed); p_code->opc = Yap_opcode(_procceed);
} }
@ -751,6 +752,7 @@ InitCodes(void)
#endif /* YAPOR */ #endif /* YAPOR */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
INIT_RWLOCK(heap_regs->bgl);
INIT_LOCK(heap_regs->free_blocks_lock); INIT_LOCK(heap_regs->free_blocks_lock);
INIT_LOCK(heap_regs->heap_used_lock); INIT_LOCK(heap_regs->heap_used_lock);
INIT_LOCK(heap_regs->heap_top_lock); INIT_LOCK(heap_regs->heap_top_lock);

4
H/YapOpcodes.h
View File

@ -169,8 +169,8 @@
OPCODE(expand_index ,e), OPCODE(expand_index ,e),
OPCODE(save_b_x ,x), OPCODE(save_b_x ,x),
OPCODE(save_b_y ,y), OPCODE(save_b_y ,y),
OPCODE(comit_b_x ,x), OPCODE(commit_b_x ,x),
OPCODE(comit_b_y ,y), OPCODE(commit_b_y ,y),
OPCODE(undef_p ,e), OPCODE(undef_p ,e),
OPCODE(spy_pred ,e), OPCODE(spy_pred ,e),
OPCODE(spy_or_trymark ,ld), OPCODE(spy_or_trymark ,ld),

23
H/amidefs.h
View File

@ -166,6 +166,16 @@ typedef struct yami {
CODEADDR l2; CODEADDR l2;
CELL next; CELL next;
} fll; } fll;
struct {
wamreg x;
struct yami *f;
CELL next;
} fx;
struct {
yslot y;
struct yami *f;
CELL next;
} fy;
struct { struct {
struct logic_upd_index *I; struct logic_upd_index *I;
struct yami *l1; struct yami *l1;
@ -265,25 +275,28 @@ typedef struct yami {
} sllll; } sllll;
struct { struct {
struct pred_entry *p; struct pred_entry *p;
struct yami *f;
wamreg x1; wamreg x1;
wamreg x2; wamreg x2;
wamreg flags; wamreg flags;
CELL next; CELL next;
} lxx; } llxx;
struct { struct {
struct pred_entry *p; struct pred_entry *p;
struct yami *f;
wamreg x; wamreg x;
yslot y; yslot y;
wamreg flags; wamreg flags;
CELL next; CELL next;
} lxy; } llxy;
struct { struct {
struct pred_entry *p; struct pred_entry *p;
struct yami *f;
wamreg y1; wamreg y1;
yslot y2; yslot y2;
wamreg flags; wamreg flags;
CELL next; CELL next;
} lyy; } llyy;
struct { struct {
OPCODE pop; OPCODE pop;
struct yami *l1; struct yami *l1;

7
H/compile.h
View File

@ -30,6 +30,7 @@ typedef enum compiler_op {
put_num_op, put_num_op,
get_float_op, get_float_op,
put_float_op, put_float_op,
align_float_op,
get_longint_op, get_longint_op,
put_longint_op, put_longint_op,
get_bigint_op, get_bigint_op,
@ -82,7 +83,7 @@ typedef enum compiler_op {
pushpop_or_op, pushpop_or_op,
pop_or_op, pop_or_op,
save_b_op, save_b_op,
comit_b_op, commit_b_op,
patch_b_op, patch_b_op,
try_op, try_op,
retry_op, retry_op,
@ -103,7 +104,7 @@ typedef enum compiler_op {
if_nonvar_op, if_nonvar_op,
save_pair_op, save_pair_op,
save_appl_op, save_appl_op,
comit_opt_op, commit_opt_op,
unify_local_op, unify_local_op,
write_local_op, write_local_op,
unify_last_list_op, unify_last_list_op,
@ -219,7 +220,7 @@ typedef struct CEXPENTRY {
#define save_b_flag 10000 #define save_b_flag 10000
#define comit_b_flag 10001 #define commit_b_flag 10001
#define save_appl_flag 10002 #define save_appl_flag 10002
#define save_pair_flag 10004 #define save_pair_flag 10004
#define f_flag 10008 #define f_flag 10008

37
H/rheap.h
View File

@ -759,7 +759,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
break; break;
/* instructions type x */ /* instructions type x */
case _save_b_x: case _save_b_x:
case _comit_b_x: case _commit_b_x:
case _get_list: case _get_list:
case _put_list: case _put_list:
case _write_x_var: case _write_x_var:
@ -781,7 +781,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode)
break; break;
/* instructions type y */ /* instructions type y */
case _save_b_y: case _save_b_y:
case _comit_b_y: case _commit_b_y:
case _write_y_var: case _write_y_var:
case _write_y_val: case _write_y_val:
case _write_y_loc: 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->u.ycx.xi = XAdjust(pc->u.ycx.xi);
pc = NEXTOP(pc,ycx); pc = NEXTOP(pc,ycx);
break; break;
/* instructions type lxx */ /* instructions type ycx */
case _p_func2s_y_cv: case _p_func2s_y_cv:
pc->u.ycx.y = YAdjust(pc->u.ycx.y); pc->u.ycx.y = YAdjust(pc->u.ycx.y);
if (IsAtomTerm(pc->u.ycx.c)) 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->u.ycx.xi = XAdjust(pc->u.ycx.xi);
pc = NEXTOP(pc,ycx); pc = NEXTOP(pc,ycx);
break; break;
/* instructions type lxx */ /* instructions type llxx */
case _call_bfunc_xx: case _call_bfunc_xx:
pc->u.lxx.p = PtoPredAdjust(pc->u.lxx.p); pc->u.llxx.p = PtoPredAdjust(pc->u.llxx.p);
pc->u.lxx.x1 = XAdjust(pc->u.lxx.x1); pc->u.llxx.f = PtoOpAdjust(pc->u.llxx.f);
pc->u.lxx.x2 = XAdjust(pc->u.lxx.x2); pc->u.llxx.x1 = XAdjust(pc->u.llxx.x1);
pc = NEXTOP(pc,lxx); pc->u.llxx.x2 = XAdjust(pc->u.llxx.x2);
pc = NEXTOP(pc,llxx);
break; break;
/* instructions type lxy */ /* instructions type llxy */
case _call_bfunc_yx: case _call_bfunc_yx:
case _call_bfunc_xy: case _call_bfunc_xy:
pc->u.lxy.p = PtoPredAdjust(pc->u.lxy.p); pc->u.llxy.p = PtoPredAdjust(pc->u.llxy.p);
pc->u.lxy.x = XAdjust(pc->u.lxy.x); pc->u.llxy.f = PtoOpAdjust(pc->u.llxy.f);
pc->u.lxy.y = YAdjust(pc->u.lxy.y); pc->u.llxy.x = XAdjust(pc->u.llxy.x);
pc = NEXTOP(pc,lxy); pc->u.llxy.y = YAdjust(pc->u.llxy.y);
pc = NEXTOP(pc,llxy);
break; break;
case _call_bfunc_yy: case _call_bfunc_yy:
pc->u.lyy.p = PtoPredAdjust(pc->u.lyy.p); pc->u.llyy.p = PtoPredAdjust(pc->u.llyy.p);
pc->u.lyy.y1 = YAdjust(pc->u.lyy.y1); pc->u.llyy.f = PtoOpAdjust(pc->u.llxy.f);
pc->u.lyy.y2 = YAdjust(pc->u.lyy.y2); pc->u.llyy.y1 = YAdjust(pc->u.llyy.y1);
pc = NEXTOP(pc,lyy); pc->u.llyy.y2 = YAdjust(pc->u.llyy.y2);
pc = NEXTOP(pc,llyy);
break; break;
} }
} while (TRUE); } while (TRUE);

23
m4/TermExt.h.m4
View File

@ -10,7 +10,7 @@
* File: TermExt.h * * File: TermExt.h *
* mods: * * mods: *
* comments: Extensions to standard terms for YAP * * 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 #if USE_OFFSETS
@ -117,18 +117,21 @@ Destructor(Term, FloatOf, Float, t, *(Float *)(RepAppl(t)+1))
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT #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 Float STD_PROTO(CpFloatUnaligned,(CELL *));
inline EXTERN void STD_PROTO(AlignGlobalForDouble,(void)); 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 inline EXTERN Float
CpFloatUnaligned(CELL *ptr) CpFloatUnaligned(CELL *ptr)
{ {
@ -138,6 +141,8 @@ CpFloatUnaligned(CELL *ptr)
return(u.f); 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))) 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)))) 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(M,N) :- integer(N), !, N > 0, '$plus'(N,-1,M).
succ(0,1). succ(0,1).

1
pl/boot.yap
View File

@ -14,6 +14,7 @@
* comments: boot file for Prolog * * comments: boot file for Prolog *
* * * *
*************************************************************************/ *************************************************************************/
% process an input clause
% This one should come first so that disjunctions and long distance % 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). '$deb_inc_in_sterm_oldie'(C,[],C).
'$get_sterm_list'(L0,C,N,L) :- '$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) ; '$get_sterm_list'([N|L0],CN,0,L) ;
C >= "0", C =< "9" -> NN is 10*N+C-"0", get0(CN), C >= "0", C =< "9" -> NN is 10*N+C-"0", get0(CN),
'$get_sterm_list'(L0,CN,NN,L); '$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)). '$do_error'(domain_error(predicate_spec,Name),listing(Name)).
'$list_clauses'(Stream, M, Pred) :- '$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), '$clause'(Pred, M, Body),
'$portray_clause'(Stream,(Pred:-Body)), '$portray_clause'(Stream,(Pred:-Body)),
fail. fail.

8
pl/modules.yap
View File

@ -442,6 +442,10 @@ module(N) :-
'$meta_predicate'(M:D, _) :- !, '$meta_predicate'(M:D, _) :- !,
'$meta_predicate'(D, M). '$meta_predicate'(D, M).
'$meta_predicate'(P, M1) :- '$meta_predicate'(P, M1) :-
'$install_meta_predicate'(P, M1).
'$install_meta_predicate'(P, M1) :-
functor(P,F,N), functor(P,F,N),
( M1 = prolog -> M = _ ; M1 = M), ( M1 = prolog -> M = _ ; M1 = M),
( retractall('$meta_predicate'(F,M,N,_)), fail ; true), ( retractall('$meta_predicate'(F,M,N,_)), fail ; true),
@ -537,8 +541,10 @@ source_module(Mod) :-
'$member'(X,[X|_]) :- !. '$member'(X,[X|_]) :- !.
'$member'(X,[_|L]) :- '$member'(X,L). '$member'(X,[_|L]) :- '$member'(X,L).
% comma has its own problems.
:- '$install_meta_predicate'((:,:), prolog).
:- meta_predicate :- meta_predicate
% [:,:],
abolish(:), abolish(:),
abolish(:,+), abolish(:,+),
all(?,:,?), 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_dynamic'(T, Mod), !. % all dynamic predicates are public.
'$is_public'(T, Mod) :- '$is_public'(T, Mod) :-
'$flags'(T,Mod,F,F), '$flags'(T,Mod,F,F),
F\/0x00400000 \== 0. F\/0x00400000 =\= 0.
hide_predicate(V) :- var(V), !, hide_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,hide_predicate(V)). '$do_error'(instantiation_error,hide_predicate(V)).