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

fix pruning to handle backtrackable C-predicates in a much nicer way.

Browse Source
This commit is contained in:
ubu32 2011-02-14 11:29:20 -08:00
parent 9691a0843d
commit 67d23051c2
12 changed files with 163 additions and 551 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

510
C/absmi.c
View File

@ -826,11 +826,7 @@ Yap_absmi(int inp)
/* YREG was pointing to where we were going to build the
* next choice-point. The stack shifter will need to know this
* to move the local stack */
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
} else {
ASP = YREG+E_CB;
}
SET_ASP(YREG, E_CB*sizeof(CELL));
cut_b = LCL0-(CELL *)(ASP[E_CB]);
saveregs();
if(!Yap_growtrail (0, FALSE)) {
@ -851,12 +847,7 @@ Yap_absmi(int inp)
#endif /* OS_HANDLES_TR_OVERFLOW */
BOp(Ystop, l);
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
else {
ASP = YREG+E_CB;
}
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
@ -868,12 +859,7 @@ Yap_absmi(int inp)
ENDBOp();
BOp(Nstop, e);
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
else {
ASP = YREG+E_CB;
}
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
@ -1544,11 +1530,7 @@ Yap_absmi(int inp)
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
Term t;
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
} else {
ASP = YREG+E_CB;
}
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
@ -1685,9 +1667,7 @@ Yap_absmi(int inp)
#ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
ASP = YREG+E_CB;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
if (!Yap_gcl(sz, arity, YENV, PREG)) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -2221,43 +2201,10 @@ Yap_absmi(int inp)
}
do_cut:
#endif
SET_ASP(YREG, PREG->u.s.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
{
choiceptr d0;
/* assume cut is always in stack */
d0 = (choiceptr)YREG[E_CB];
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,d0))
{
ASP = (CELL *) (((char *) YREG) + PREG->u.s.s);
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
while (POP_CHOICE_POINT(d0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(d0);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,d0)) {
/* cut ! */
while (B->cp_b < d0) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
trim_trail:
HBREG = PROTECT_FROZEN_H(B->cp_b);
#include "trim_trail.h"
B = B->cp_b;
SET_BB(PROTECT_FROZEN_B(B));
}
}
/* assume cut is always in stack */
prune((choiceptr)YREG[E_CB]);
GONext();
ENDOp();
@ -2272,59 +2219,27 @@ Yap_absmi(int inp)
}
do_cut_t:
#endif
SET_ASP(YREG, PREG->u.s.s);
/* assume cut is always in stack */
prune((choiceptr)YREG[E_CB]);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
{
choiceptr d0;
/* assume cut is always in stack */
d0 = (choiceptr)YREG[E_CB];
#ifdef CUT_C
{
ASP = (CELL *) (((char *) YREG) + PREG->u.s.s);
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
if (SHOULD_CUT_UP_TO(B,d0))
{
while (POP_CHOICE_POINT(d0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(d0);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,d0)) {
/* cut ! */
while (B->cp_b < d0) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B->cp_b);
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (ENV > (CELL *) top_b || ENV < H) YREG = (CELL *) top_b;
if (ENV > (CELL *) top_b || ENV < H) YREG = (CELL *) top_b;
#else
if (ENV > (CELL *) top_b) YREG = (CELL *) top_b;
if (ENV > (CELL *) top_b) YREG = (CELL *) top_b;
#endif /* SBA */
else YREG = (CELL *)((CELL)ENV + ENV_Size(CPREG));
}
#else
if (ENV > (CELL *)B->cp_b) {
YREG = (CELL *)B->cp_b;
}
else {
YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG));
}
#endif /* FROZEN_STACKS */
YREG[E_CB] = (CELL)d0;
goto trim_trail;
}
else YREG = (CELL *)((CELL)ENV + ENV_Size(CPREG));
}
#else
if (ENV > (CELL *)B) {
YREG = (CELL *)B;
} else {
YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG));
}
#endif
GONext();
ENDOp();
@ -2338,39 +2253,9 @@ Yap_absmi(int inp)
}
do_cut_e:
#endif
SET_ASP(YREG, PREG->u.s.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
{
choiceptr d0;
/* we assume dealloc leaves in S the previous env */
d0 = (choiceptr)SREG[E_CB];
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,d0))
{
ASP = (CELL *) (((char *) YREG) + PREG->u.s.s);
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
while (POP_CHOICE_POINT(d0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(d0);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,d0)) {
/* cut ! */
while (B->cp_b < d0) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
goto trim_trail;
}
}
prune((choiceptr)SREG[E_CB]);
GONext();
ENDOp();
@ -2400,17 +2285,20 @@ Yap_absmi(int inp)
ENDOp();
/* commit_b_x Xi */
Op(commit_b_x, xp);
BEGD(d0);
d0 = XREG(PREG->u.xp.x);
Op(commit_b_x, xps);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCommitX, H);
ENDCACHE_Y_AS_ENV();
do_commit_b_x:
#endif
BEGD(d0);
d0 = XREG(PREG->u.xps.x);
deref_head(d0, commit_b_x_unk);
commit_b_x_nvar:
/* skip a void call and a label */
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xp),Osbpp),l);
SET_ASP(YREG, PREG->u.xps.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xps),Osbpp),l);
{
choiceptr pt0;
#if defined(SBA) && defined(FROZEN_STACKS)
@ -2418,78 +2306,51 @@ Yap_absmi(int inp)
#else
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
#endif /* SBA && FROZEN_STACKS */
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,(choiceptr) pt0))
{
while (POP_CHOICE_POINT(pt0))
{
POP_EXECUTE();
}
}
prune(pt0);
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(pt0);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,pt0)) {
while (B->cp_b < pt0) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
goto trim_trail;
}
}
ENDD(d0);
GONext();
BEGP(pt1);
deref_body(d0, pt1, commit_b_x_unk, commit_b_x_nvar);
ENDP(pt1);
/* never cut to a variable */
/* Abort */
FAIL();
ENDD(d0);
ENDOp();
/* commit_b_y Yi */
Op(commit_b_y, yp);
BEGD(d0);
d0 = YREG[PREG->u.yp.y];
Op(commit_b_y, yps);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCommitY, H);
ENDCACHE_Y_AS_ENV();
do_commit_b_y:
#endif
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yp),Osbpp),l);
BEGD(d0);
d0 = YREG[PREG->u.yps.y];
deref_head(d0, commit_b_y_unk);
commit_b_y_nvar:
SET_ASP(YREG, PREG->u.yps.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yps),Osbpp),l);
{
choiceptr pt0;
#if defined(SBA) && defined(FROZEN_STACKS)
pt0 = (choiceptr)IntegerOfTerm(d0);
#else
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
#endif /* SBA && FROZEN_STACKS */
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,(choiceptr) pt0))
{
while (POP_CHOICE_POINT(pt0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(pt0);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,pt0)) {
while (B->cp_b < pt0) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
goto trim_trail;
}
#endif
prune(pt0);
}
ENDD(d0);
GONext();
BEGP(pt1);
deref_body(d0, pt1, commit_b_y_unk, commit_b_y_nvar);
ENDP(pt1);
/* never cut to a variable */
/* Abort */
FAIL();
ENDD(d0);
ENDOp();
/*************************************************************************
@ -2542,10 +2403,8 @@ Yap_absmi(int inp)
SREG = (CELL *) PREG->u.pp.p;
PP = PREG->u.pp.p0;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = YREG+E_CB;
SET_ASP(YREG, E_CB*sizeof(CELL));
SREG = YENV;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
goto noheapleft;
}
if (ActiveSignals)
@ -2698,18 +2557,14 @@ Yap_absmi(int inp)
}
SREG = (CELL *) PREG->u.Osbpp.p;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
SET_ASP(YREG, PREG->u.Osbpp.s);
SREG = YENV;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
goto noheapleft;
}
if (ActiveSignals) {
goto creepc;
}
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
SET_ASP(YREG, PREG->u.Osbpp.s);
saveregs();
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, YREG, NEXTOP(PREG, Osbpp))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -2838,7 +2693,7 @@ Yap_absmi(int inp)
/* This is easier: I know there is an environment so I cannot do allocate */
NoStackCommitY:
PP = PREG->u.yp.p0;
PP = PREG->u.yps.p0;
/* find something to fool S */
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_y;
@ -2851,8 +2706,8 @@ Yap_absmi(int inp)
}
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
SREG = (CELL *)PredRestoreRegs;
XREGS[0] = YREG[PREG->u.yp.y];
PREG = NEXTOP(PREG,yp);
XREGS[0] = YREG[PREG->u.yps.y];
PREG = NEXTOP(PREG,yps);
goto creep_either;
}
/* don't do debugging and friends here */
@ -2860,7 +2715,7 @@ Yap_absmi(int inp)
/* Problem: have I got an environment or not? */
NoStackCommitX:
PP = PREG->u.xp.p0;
PP = PREG->u.xps.p0;
/* find something to fool S */
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_x;
@ -2888,8 +2743,8 @@ Yap_absmi(int inp)
#endif /* DEPTH_LIMIT */
ENDCACHE_Y_AS_ENV();
}
XREGS[0] = XREG(PREG->u.xp.x);
PREG = NEXTOP(PREG,xp);
XREGS[0] = XREG(PREG->u.xps.x);
PREG = NEXTOP(PREG,xps);
goto creep_either;
}
/* don't do debugging and friends here */
@ -2933,9 +2788,7 @@ Yap_absmi(int inp)
/* find something to fool S */
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0));
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
SET_ASP(YREG, PREG->u.Osbpp.s);
SREG = YENV;
goto noheapleft;
}
@ -3148,9 +3001,7 @@ Yap_absmi(int inp)
/* same instruction */
if (Yap_PrologMode & InterruptMode) {
Yap_PrologMode &= ~InterruptMode;
ASP = YREG+E_CB;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
Yap_ProcessSIGINT();
setregs();
@ -7608,11 +7459,7 @@ Yap_absmi(int inp)
else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s);
}
#else
if (YREG > (CELL *) B) {
ASP = (CELL *) B;
} else {
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
}
SET_ASP(YREG, 0);
/* for slots to work */
#endif /* FROZEN_STACKS */
#ifdef LOW_LEVEL_TRACER
@ -7656,11 +7503,7 @@ Yap_absmi(int inp)
else ASP = YREG+E_CB;
}
#else
if (YREG > (CELL *) B) {
ASP = (CELL *) B;
} else {
ASP = YREG+E_CB;
}
SET_ASP(YREG, 0);
/* for slots to work */
#endif /* FROZEN_STACKS */
pt0 = PREG->u.pp.p;
@ -7747,11 +7590,7 @@ Yap_absmi(int inp)
else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s);
}
#else
if (YREG > (CELL *) B)
ASP = (CELL *) B;
else {
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
}
SET_ASP(YREG, 0);
/* for slots to work */
#endif /* FROZEN_STACKS */
{
@ -7984,11 +7823,7 @@ Yap_absmi(int inp)
ENDCACHE_Y();
Yap_PrologMode = UserCCallMode;
if (YREG > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
} else {
ASP = YREG;
}
SET_ASP(YREG, 0);
/* for slots to work */
Yap_StartSlots();
saveregs();
@ -8054,10 +7889,7 @@ Yap_absmi(int inp)
if (ap->cs.p_code.NOfClauses > 1 &&
!(ap->PredFlags & IndexedPredFlag)) {
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
Yap_IPred(ap, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */
@ -8095,10 +7927,7 @@ Yap_absmi(int inp)
}
#endif
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
Yap_IPred(ap, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */
@ -8135,10 +7964,7 @@ Yap_absmi(int inp)
yamop *pt0;
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
PELOCK(12,pe);
@ -8177,10 +8003,7 @@ Yap_absmi(int inp)
yamop *pt0;
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
#if defined(YAPOR) || defined(THREADS)
if (PP == NULL) {
PELOCK(13,pe);
@ -8286,10 +8109,7 @@ Yap_absmi(int inp)
if (!(pe->PredFlags & IndexedPredFlag) &&
pe->cs.p_code.NOfClauses > 1) {
/* update ASP before calling IPred */
ASP = YREG+E_CB;
if (ASP > (CELL *) PROTECT_FROZEN_B(B)) {
ASP = (CELL *) PROTECT_FROZEN_B(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
Yap_IPred(pe, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */
@ -9813,124 +9633,6 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(p_cut_by_x, xl);
BEGD(d0);
d0 = XREG(PREG->u.xl.x);
deref_head(d0, cutby_x_unk);
cutby_x_nvar:
#if defined(SBA) && defined(FROZEN_STACKS)
if (!IsIntegerTerm(d0))
#else
if (!IsIntTerm(d0))
#endif /* SBA && FROZEN_STACKS */
{
PREG = NEXTOP(PREG, xl);
GONext();
}
BEGCHO(pt0);
#if defined(SBA) && defined(FROZEN_STACKS)
pt0 = (choiceptr)IntegerOfTerm(d0);
#else
pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
#endif /* SBA && FROZEN_STACKS */
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B, pt0))
{
while (POP_CHOICE_POINT(pt0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(pt0);
#endif /* YAPOR */
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,pt0)) {
/* Wow, we're gonna cut!!! */
while (B->cp_b < pt0) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
PREG = NEXTOP(PREG, xl);
goto trim_trail;
}
PREG = NEXTOP(PREG, xl);
ENDCHO(pt0);
GONext();
BEGP(pt1);
deref_body(d0, pt1, cutby_x_unk, cutby_x_nvar);
ENDP(pt1);
/* never cut to a variable */
/* Abort */
FAIL();
ENDD(d0);
ENDOp();
Op(p_cut_by_y, yl);
BEGD(d0);
BEGP(pt0);
pt0 = YREG + PREG->u.yl.y;
d0 = *pt0;
deref_head(d0, cutby_y_unk);
cutby_y_nvar:
#if defined(SBA) && defined(FROZEN_STACKS)
if (!IsIntegerTerm(d0))
#else
if (!IsIntTerm(d0))
#endif
{
FAIL();
}
/* find where to cut to */
BEGCHO(pt1);
#if defined(SBA) && defined(FROZEN_STACKS)
pt1 = (choiceptr)IntegerOfTerm(d0);
#else
pt1 = (choiceptr)(LCL0-IntOfTerm(d0));
#endif /* SBA && FROZEN_STACKS */
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,(choiceptr) pt1))
{
while (POP_CHOICE_POINT(pt1))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(pt1);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,pt1)) {
/* Wow, we're gonna cut!!! */
while (B->cp_b < pt1) {
B = B->cp_b;
}
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
PREG = NEXTOP(PREG, xl);
goto trim_trail;
}
PREG = NEXTOP(PREG, yl);
GONext();
ENDCHO(pt1);
derefa_body(d0, pt0, cutby_y_unk, cutby_y_nvar);
/* never cut to a variable */
/* Abort */
FAIL();
ENDP(pt0);
ENDD(d0);
ENDOp();
Op(p_plus_vv, xxx);
BEGD(d0);
BEGD(d1);
@ -14356,32 +14058,8 @@ Yap_absmi(int inp)
arity = 0;
if (at == AtomCut) {
choiceptr cut_pt = (choiceptr)pt0[E_CB];
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,(choiceptr) cut_pt))
{
while (POP_CHOICE_POINT(cut_pt))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif /* YAPOR */
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
/* Wow, we're gonna cut!!! */
#ifdef TABLING
while (B->cp_b < cut_pt) {
B = B->cp_b;
}
abolish_incomplete_subgoals(B);
#endif /* TABLING */
B = cut_pt;
HB = PROTECT_FROZEN_H(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
prune(cut_pt);
}
pen = RepPredProp(PredPropByAtom(at, mod));
goto execute_comma;
@ -14458,32 +14136,8 @@ Yap_absmi(int inp)
CACHE_A1();
} else if ((Atom)(pen->FunctorOfPred) == AtomCut) {
choiceptr cut_pt = (choiceptr)pt0[E_CB];
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,(choiceptr) cut_pt))
{
while (POP_CHOICE_POINT(cut_pt))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif /* YAPOR */
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
/* Wow, we're gonna cut!!! */
#ifdef TABLING
while (B->cp_b < cut_pt) {
B = B->cp_b;
}
abolish_incomplete_subgoals(B);
#endif /* TABLING */
B = cut_pt;
HB = PROTECT_FROZEN_H(B);
}
SET_ASP(YREG, E_CB*sizeof(CELL));
prune(cut_pt);
}
execute_after_comma:

18
C/amasm.c
View File

@ -672,18 +672,20 @@ a_vp(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct
if (is_y_var) {
if (pass_no) {
code_p->opc = emit_op(opcodey);
code_p->u.yp.y = emit_yreg(var_offset);
code_p->u.yp.p0 = clinfo->CurrentPred;
code_p->u.yps.y = emit_yreg(var_offset);
code_p->u.yps.p0 = clinfo->CurrentPred;
code_p->u.yps.s = -Signed(RealEnvSize) - CELLSIZE * cpc->rnd2;
}
GONEXT(yp);
GONEXT(yps);
}
else {
if (pass_no) {
code_p->opc = emit_op(opcodex);
code_p->u.xp.x = emit_xreg(var_offset);
code_p->u.xp.p0 = clinfo->CurrentPred;
code_p->u.xps.x = emit_xreg(var_offset);
code_p->u.xps.p0 = clinfo->CurrentPred;
code_p->u.xps.s = -Signed(RealEnvSize) - CELLSIZE * cpc->rnd2;
}
GONEXT(xp);
GONEXT(xps);
}
return code_p;
}
@ -2536,7 +2538,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
code_p->opc = opcode(_p_db_ref_y);
break;
case _cut_by:
code_p->opc = opcode(_p_cut_by_y);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "internal assembler error: cut_by should be handled as ->");
break;
case _primitive:
code_p->opc = opcode(_p_primitive_y);
@ -2578,7 +2580,7 @@ a_f2(cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermediates *ci
code_p->opc = opcode(_p_db_ref_x);
break;
case _cut_by:
code_p->opc = opcode(_p_cut_by_x);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "internal assembler error: cut_by should be handled as ->");
break;
case _primitive:
code_p->opc = opcode(_p_primitive_x);

12
C/compiler.c
View File

@ -441,8 +441,9 @@ c_var(Term t, Int argno, unsigned int arity, unsigned int level, compiler_struct
if (new) {
++cglobs->nvars;
Yap_emit(f_var_op, t, (CELL)arity, &cglobs->cint);
} else
} else {
Yap_emit(f_val_op, t, (CELL)arity, &cglobs->cint);
}
break;
case bt1_flag:
Yap_emit(fetch_args_for_bccall, t, 0, &cglobs->cint);
@ -920,7 +921,10 @@ c_test(Int Op, Term t1, compiler_struct *cglobs) {
c_eq(t, tn, cglobs);
t = tn;
}
c_var(t,f_flag,(unsigned int)Op, 0, cglobs);
if (Op == _cut_by)
c_var(t, commit_b_flag, 1, 0, cglobs);
else
c_var(t, f_flag,(unsigned int)Op, 0, cglobs);
}
/* Arithmetic builtins will be compiled in the form:
@ -2253,7 +2257,9 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
}
#endif
pc->rnd2 = nperm;
} else if (pc->op == cut_op || pc->op == cutexit_op) {
} else if (pc->op == cut_op ||
pc->op == cutexit_op ||
pc->op == commit_b_op) {
pc->rnd2 = nperm;
}
opc = pc;

5
C/index.c
View File

@ -955,11 +955,10 @@ has_cut(yamop *pc)
case _Ystop:
case _Nstop:
return FALSE;
/* instructions type ld */
case _p_cut_by_y:
case _p_cut_by_x:
case _commit_b_y:
case _commit_b_x:
return TRUE;
/* instructions type ld */
#if CUT_C
case _cut_c:
case _cut_userc:

84
C/iopreds.c
View File

@ -102,7 +102,6 @@ STATIC_PROTO (int ReadlinePutc, (int,int));
#endif
STATIC_PROTO (int PlUnGetc, (int));
STATIC_PROTO (Term MkStream, (int));
STATIC_PROTO (Int p_stream_flags, (void));
STATIC_PROTO (int CheckStream, (Term, int, char *));
STATIC_PROTO (Int p_close, (void));
STATIC_PROTO (Int p_set_input, (void));
@ -122,11 +121,8 @@ STATIC_PROTO (Int p_past_eof, (void));
STATIC_PROTO (Int p_put, (void));
STATIC_PROTO (Int p_put_byte, (void));
STATIC_PROTO (Int p_skip, (void));
STATIC_PROTO (Int p_flush, (void));
STATIC_PROTO (Int p_flush_all_streams, (void));
STATIC_PROTO (Int p_write_depth, (void));
STATIC_PROTO (Int p_user_file_name, (void));
STATIC_PROTO (Int p_show_stream_flags, (void));
STATIC_PROTO (Int p_show_stream_position, (void));
STATIC_PROTO (Int p_set_stream_position, (void));
STATIC_PROTO (Int p_format, (void));
@ -211,30 +207,6 @@ Yap_GetFreeStreamDForReading(void)
}
static int
yap_fflush(int sno)
{
#if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H
if (Stream[sno].status & Tty_Stream_f &&
Stream[sno].status & Output_Stream_f) {
if (ReadlinePos != ReadlineBuf) {
ReadlinePos[0] = '\0';
fputs( ReadlineBuf, Stream[sno].u.file.file);
}
ReadlinePos = ReadlineBuf;
}
#endif
if ( (Stream[sno].status & Output_Stream_f) &&
! (Stream[sno].status &
(Free_Stream_f)) ) {
if (Stream[sno].status & SWI_Stream_f) {
return SWIFlush(Stream[sno].u.swi_stream.swi_ptr);
}
return(fflush(Stream[sno].u.file.file));
} else
return(0);
}
static void
unix_upd_stream_info (StreamDesc * s)
{
@ -1361,16 +1333,6 @@ MkStream (int n)
return (Yap_MkApplTerm (FunctorStream, 1, t));
}
static Int
p_stream_flags (void)
{ /* '$stream_flags'(+N,-Flags) */
Term trm;
trm = Deref (ARG1);
if (IsVarTerm (trm) || !IsIntTerm (trm))
return (FALSE);
return (Yap_unify_constant (ARG2, MkIntTerm (Stream[IntOfTerm (trm)].status)));
}
/* given a stream index, get the corresponding fd */
static Int
GetStreamFd(int sno)
@ -2575,19 +2537,6 @@ p_user_file_name (void)
return (Yap_unify_constant (ARG2, tout));
}
static Int
p_show_stream_flags(void)
{ /* '$show_stream_flags'(+Stream,Pos) */
Term tout;
int sno =
CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "stream_property/2");
if (sno < 0)
return (FALSE);
tout = MkIntTerm(Stream[sno].status);
UNLOCK(Stream[sno].streamlock);
return (Yap_unify (ARG2, tout));
}
static Term
StreamPosition(int sno)
{
@ -3810,37 +3759,8 @@ p_skip (void)
return (TRUE);
}
static Int
p_flush (void)
{ /* flush_output(Stream) */
int sno = CheckStream (ARG1, Output_Stream_f, "flush_output/1");
if (sno < 0)
return (FALSE);
yap_fflush (sno);
UNLOCK(Stream[sno].streamlock);
return (TRUE);
}
static Int
p_flush_all_streams (void)
{ /* $flush_all_streams */
#if BROKEN_FFLUSH_NULL
int i;
for (i = 0; i < MaxStreams; ++i) {
LOCK(Stream[i].streamlock);
yap_fflush (i);
UNLOCK(Stream[i].streamlock);
}
#else
fflush (NULL);
#endif
return TRUE;
}
void Yap_FlushStreams(void)
{
(void)p_flush_all_streams();
}
#if HAVE_SELECT
@ -4386,10 +4306,7 @@ Yap_InitIOPreds(void)
if (!Stream)
Stream = (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc)*MaxStreams);
/* here the Input/Output predicates */
Yap_InitCPred ("$stream_flags", 2, p_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$close", 1, p_close, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("flush_output", 1, p_flush, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$flush_all_streams", 0, p_flush_all_streams, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("get", 2, p_get, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("get0", 2, p_get0, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$get0_line_codes", 2, p_get0_line_codes, SafePredFlag|SyncPredFlag|HiddenPredFlag);
@ -4413,7 +4330,6 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("format", 2, p_format, SyncPredFlag);
Yap_InitCPred ("format", 3, p_format2, SyncPredFlag);
Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$show_stream_flags", 2, p_show_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$set_stream_position", 2, p_set_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$user_file_name", 2, p_user_file_name, SafePredFlag|SyncPredFlag),

5
C/tracer.c
View File

@ -172,12 +172,13 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs;
vsc_count++;
if (vsc_count==29)
jmp_deb(1);
#ifdef THREADS
MY_ThreadHandle.thread_inst_count++;
#endif
#ifdef COMMENTED
{ choiceptr myB = B;
while (myB) myB = myB->cp_b;
}
//*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc ||
//0x4fd4d
if (vsc_count == 40650191LL)

6
H/YapOpcodes.h
View File

@ -37,8 +37,8 @@
OPCODE(cut_e ,s),
OPCODE(save_b_x ,x),
OPCODE(save_b_y ,y),
OPCODE(commit_b_x ,xp),
OPCODE(commit_b_y ,yp),
OPCODE(commit_b_x ,xps),
OPCODE(commit_b_y ,yps),
OPCODE(execute ,pp),
OPCODE(dexecute ,pp),
OPCODE(fcall ,Osbpp),
@ -259,8 +259,6 @@
OPCODE(p_compound_y ,yl),
OPCODE(p_float_x ,xl),
OPCODE(p_float_y ,yl),
OPCODE(p_cut_by_x ,xl),
OPCODE(p_cut_by_y ,yl),
OPCODE(p_plus_vv ,xxx),
OPCODE(p_plus_vc ,xxn),
OPCODE(p_plus_y_vv ,yxx),

36
H/absmi.h
View File

@ -1548,3 +1548,39 @@ Yap_regtoregno(wamreg reg)
#define copy_jmp_addressa(X)
#endif
static inline void
prune(choiceptr cp)
{
if (SHOULD_CUT_UP_TO(B,cp))
{
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
while (B->cp_b < cp) {
if (POP_CHOICE_POINT(cp))
{
POP_EXECUTE();
}
B = B->cp_b;
}
}
#ifdef YAPOR
CUT_prune_to(cp);
#endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,cp)) {
/* cut ! */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HB = PROTECT_FROZEN_H(B->cp_b);
#include "trim_trail.h"
B = B->cp_b;
SET_BB(PROTECT_FROZEN_B(B));
}
}
static inline
void SET_ASP(CELL *yreg, Int sz) {
ASP = (CELL *) (((char *) yreg) + sz);
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
}

6
H/amidefs.h
View File

@ -717,8 +717,9 @@ typedef struct yami {
struct {
wamreg x;
struct pred_entry *p0;
COUNT s;
CELL next;
} xp;
} xps;
struct {
wamreg x;
CELL c;
@ -804,8 +805,9 @@ typedef struct yami {
struct {
yslot y;
struct pred_entry *p0;
COUNT s;
CELL next;
} yp;
} yps;
struct {
yslot y;
struct yami *F;

2
H/cut_c.h
View File

@ -32,7 +32,7 @@ struct cut_c_str{
#define POP_CHOICE_POINT(B) \
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)Yap_LocalBase) && ((CELL *)B > (CELL *)Yap_REGS.CUT_C_TOP))
(((CELL *)Yap_REGS.CUT_C_TOP != (CELL *)Yap_LocalBase) && ((CELL *)B == (CELL *)Yap_REGS.CUT_C_TOP))
//(((int)Yap_REGS.CUT_C_TOP != (int)Yap_LocalBase) && ((int)B > (int)Yap_REGS.CUT_C_TOP))

20
H/rclause.h
View File

@ -592,7 +592,6 @@ restore_opcodes(yamop *pc, yamop *max)
case _p_atom_x:
case _p_atomic_x:
case _p_compound_x:
case _p_cut_by_x:
case _p_db_ref_x:
case _p_float_x:
case _p_integer_x:
@ -620,11 +619,12 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.xllll.l4 = PtoOpAdjust(pc->u.xllll.l4);
pc = NEXTOP(pc,xllll);
break;
/* instructions type xp */
/* instructions type xps */
case _commit_b_x:
pc->u.xp.x = XAdjust(pc->u.xp.x);
pc->u.xp.p0 = PtoPredAdjust(pc->u.xp.p0);
pc = NEXTOP(pc,xp);
pc->u.xps.x = XAdjust(pc->u.xps.x);
pc->u.xps.p0 = PtoPredAdjust(pc->u.xps.p0);
pc->u.xps.s = ConstantAdjust(pc->u.xps.s);
pc = NEXTOP(pc,xps);
break;
/* instructions type xx */
case _get_x_val:
@ -708,7 +708,6 @@ restore_opcodes(yamop *pc, yamop *max)
case _p_atom_y:
case _p_atomic_y:
case _p_compound_y:
case _p_cut_by_y:
case _p_db_ref_y:
case _p_float_y:
case _p_integer_y:
@ -720,11 +719,12 @@ restore_opcodes(yamop *pc, yamop *max)
pc->u.yl.F = PtoOpAdjust(pc->u.yl.F);
pc = NEXTOP(pc,yl);
break;
/* instructions type yp */
/* instructions type yps */
case _commit_b_y:
pc->u.yp.y = YAdjust(pc->u.yp.y);
pc->u.yp.p0 = PtoPredAdjust(pc->u.yp.p0);
pc = NEXTOP(pc,yp);
pc->u.yps.y = YAdjust(pc->u.yps.y);
pc->u.yps.p0 = PtoPredAdjust(pc->u.yps.p0);
pc->u.yps.s = ConstantAdjust(pc->u.yps.s);
pc = NEXTOP(pc,yps);
break;
/* instructions type yx */
case _get_y_val:

10
H/walkclause.h
View File

@ -448,7 +448,6 @@
case _p_atom_x:
case _p_atomic_x:
case _p_compound_x:
case _p_cut_by_x:
case _p_db_ref_x:
case _p_float_x:
case _p_integer_x:
@ -466,9 +465,9 @@
case _switch_on_arg_type:
pc = NEXTOP(pc,xllll);
break;
/* instructions type xp */
/* instructions type xps */
case _commit_b_x:
pc = NEXTOP(pc,xp);
pc = NEXTOP(pc,xps);
break;
/* instructions type xx */
case _get_x_val:
@ -533,7 +532,6 @@
case _p_atom_y:
case _p_atomic_y:
case _p_compound_y:
case _p_cut_by_y:
case _p_db_ref_y:
case _p_float_y:
case _p_integer_y:
@ -543,9 +541,9 @@
case _p_var_y:
pc = NEXTOP(pc,yl);
break;
/* instructions type yp */
/* instructions type yps */
case _commit_b_y:
pc = NEXTOP(pc,yp);
pc = NEXTOP(pc,yps);
break;
/* instructions type yx */
case _get_y_val: