diff --git a/C/absmi.c b/C/absmi.c index 28d6240a3..759c6463f 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -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: diff --git a/C/amasm.c b/C/amasm.c index 1fcc467a4..d81e5834a 100755 --- a/C/amasm.c +++ b/C/amasm.c @@ -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); diff --git a/C/compiler.c b/C/compiler.c index bdd4d0e3e..043f23fe0 100755 --- a/C/compiler.c +++ b/C/compiler.c @@ -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; diff --git a/C/index.c b/C/index.c index 18394adc6..acfc33118 100644 --- a/C/index.c +++ b/C/index.c @@ -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: diff --git a/C/iopreds.c b/C/iopreds.c index e70e362e2..4de0361ce 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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), diff --git a/C/tracer.c b/C/tracer.c index 7f7fbc012..bf05d1bc5 100755 --- a/C/tracer.c +++ b/C/tracer.c @@ -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) diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 1d85de608..8ad92a081 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -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), diff --git a/H/absmi.h b/H/absmi.h index 2310c6acb..f04f094d6 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -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); +} diff --git a/H/amidefs.h b/H/amidefs.h index 3ce1413fd..c8a1f1061 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -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; diff --git a/H/cut_c.h b/H/cut_c.h index 7f3d1f375..c4a004896 100755 --- a/H/cut_c.h +++ b/H/cut_c.h @@ -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)) diff --git a/H/rclause.h b/H/rclause.h index af680f8a8..7b70282cd 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -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: diff --git a/H/walkclause.h b/H/walkclause.h index 02572d432..ba2c86955 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -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: