2015-01-18 03:00:19 +00:00
|
|
|
|
/************************************************************************\
|
|
|
|
|
|
* Call C predicates instructions *
|
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#ifdef INDENT_CODE
|
|
|
|
|
|
{
|
|
|
|
|
|
{
|
|
|
|
|
|
{
|
|
|
|
|
|
#endif /* INDENT_CODE */
|
|
|
|
|
|
|
|
|
|
|
|
BOp(call_cpred, Osbpp);
|
2015-03-16 17:25:09 +00:00
|
|
|
|
#if __ANDROID__ && STRONG_DEBUG
|
2015-03-11 22:18:00 +00:00
|
|
|
|
char *s; Atom name;
|
|
|
|
|
|
if (PREG->y_u.Osbpp.p->ArityOfPE) {
|
|
|
|
|
|
Functor f = PREG->y_u.Osbpp.p->FunctorOfPred;
|
2015-04-13 13:28:17 +01:00
|
|
|
|
name = f->NameOfFE;
|
2015-03-11 22:18:00 +00:00
|
|
|
|
} else {
|
|
|
|
|
|
name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred);
|
|
|
|
|
|
}
|
|
|
|
|
|
s = name->StrOfAE;
|
2015-04-13 13:28:17 +01:00
|
|
|
|
|
|
|
|
|
|
LOG( " %s ", s);
|
2015-03-11 22:18:00 +00:00
|
|
|
|
#endif
|
2015-01-18 03:00:19 +00:00
|
|
|
|
check_trail(TR);
|
|
|
|
|
|
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) {
|
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
|
check_stack(NoStackCCall, HR);
|
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
|
}
|
|
|
|
|
|
do_c_call:
|
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
|
{
|
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
|
|
|
|
|
|
|
|
|
|
|
#ifdef YAPOR_SBA
|
|
|
|
|
|
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b;
|
|
|
|
|
|
#else
|
|
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
|
|
|
|
|
|
#endif /* YAPOR_SBA */
|
|
|
|
|
|
else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s);
|
|
|
|
|
|
}
|
|
|
|
|
|
#else
|
|
|
|
|
|
SET_ASP(YREG, PREG->y_u.Osbpp.s);
|
|
|
|
|
|
/* for slots to work */
|
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
|
if (Yap_do_low_level_trace)
|
|
|
|
|
|
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1);
|
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
|
CPredicate f = PREG->y_u.Osbpp.p->cs.f_code;
|
|
|
|
|
|
PREG = NEXTOP(PREG, Osbpp);
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
d0 = (f)(PASS_REGS1);
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
|
SREG = Yap_REGS.S_;
|
|
|
|
|
|
#endif
|
|
|
|
|
|
if (!d0) {
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
|
|
NoStackCCall:
|
|
|
|
|
|
PROCESS_INT(interrupt_call, do_c_call);
|
|
|
|
|
|
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
/* execute Label */
|
|
|
|
|
|
BOp(execute_cpred, pp);
|
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *pt0;
|
|
|
|
|
|
|
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
|
#ifndef NO_CHECKING
|
|
|
|
|
|
check_stack(NoStackExecuteC, HR);
|
|
|
|
|
|
do_executec:
|
|
|
|
|
|
#endif
|
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
|
{
|
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
|
|
|
|
|
|
|
|
|
|
|
#ifdef YAPOR_SBA
|
|
|
|
|
|
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b;
|
|
|
|
|
|
#else
|
|
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
|
|
|
|
|
|
#endif /* YAPOR_SBA */
|
|
|
|
|
|
else ASP = YREG+E_CB;
|
|
|
|
|
|
}
|
|
|
|
|
|
#else
|
|
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
|
|
|
|
|
/* for slots to work */
|
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
|
pt0 = PREG->y_u.pp.p;
|
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
|
if (Yap_do_low_level_trace) {
|
|
|
|
|
|
low_level_trace(enter_pred,pt0,XREGS+1);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
|
d0 = (CELL)B;
|
|
|
|
|
|
/* for profiler */
|
|
|
|
|
|
save_pc();
|
|
|
|
|
|
ENV_YREG[E_CB] = d0;
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
|
|
|
|
|
if (pt0->ModuleOfPred) {
|
2015-01-20 03:00:42 +00:00
|
|
|
|
if (DEPTH == MkIntTerm(0)) {
|
2015-01-18 03:00:19 +00:00
|
|
|
|
FAIL();
|
2015-01-20 03:00:42 +00:00
|
|
|
|
} else{
|
|
|
|
|
|
DEPTH = RESET_DEPTH();
|
|
|
|
|
|
}
|
2015-01-18 03:00:19 +00:00
|
|
|
|
}
|
|
|
|
|
|
} else if (pt0->ModuleOfPred) {
|
|
|
|
|
|
DEPTH -= MkIntConstant(2);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
|
/* now call C-Code */
|
|
|
|
|
|
{
|
|
|
|
|
|
CPredicate f = PREG->y_u.pp.p->cs.f_code;
|
|
|
|
|
|
yamop *oldPREG = PREG;
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
d0 = (f)(PASS_REGS1);
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
|
SREG = Yap_REGS.S_;
|
|
|
|
|
|
#endif
|
|
|
|
|
|
if (!d0) {
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
if (oldPREG == PREG) {
|
|
|
|
|
|
/* we did not update PREG */
|
|
|
|
|
|
/* we can proceed */
|
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
|
ENV_YREG = ENV;
|
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
|
DEPTH = ENV_YREG[E_DEPTH];
|
|
|
|
|
|
#endif
|
|
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
|
|
|
|
|
} else {
|
|
|
|
|
|
/* call the new code */
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
NoStackExecuteC:
|
|
|
|
|
|
PROCESS_INT(interrupt_execute, do_executec);
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
/* Like previous, the only difference is that we do not */
|
|
|
|
|
|
/* trust the C-function we are calling and hence we must */
|
|
|
|
|
|
/* guarantee that *all* machine registers are saved and */
|
|
|
|
|
|
/* restored */
|
|
|
|
|
|
BOp(call_usercpred, Osbpp);
|
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
|
check_stack(NoStackUserCall, HR);
|
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
|
do_user_call:
|
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
|
if (Yap_do_low_level_trace) {
|
|
|
|
|
|
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
|
{
|
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
|
|
|
|
|
#ifdef YAPOR_SBA
|
|
|
|
|
|
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b;
|
|
|
|
|
|
#else
|
|
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b;
|
|
|
|
|
|
#endif /* YAPOR_SBA */
|
|
|
|
|
|
else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s);
|
|
|
|
|
|
}
|
|
|
|
|
|
#else
|
|
|
|
|
|
SET_ASP(YREG, PREG->y_u.Osbpp.s);
|
|
|
|
|
|
/* for slots to work */
|
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
|
{
|
|
|
|
|
|
/* make sure that we can still have access to our old PREG after calling user defined goals and backtracking or failing */
|
|
|
|
|
|
yamop *savedP;
|
|
|
|
|
|
|
|
|
|
|
|
LOCAL_PrologMode |= UserCCallMode;
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *p = PREG->y_u.Osbpp.p;
|
|
|
|
|
|
|
|
|
|
|
|
PREG = NEXTOP(PREG, Osbpp);
|
|
|
|
|
|
savedP = PREG;
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
|
|
|
|
|
|
|
SREG = (CELL *) YAP_Execute(p, p->cs.f_code);
|
|
|
|
|
|
}
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
LOCAL_PrologMode &= ~UserCCallMode;
|
|
|
|
|
|
restore_machine_regs();
|
|
|
|
|
|
PREG = savedP;
|
|
|
|
|
|
}
|
|
|
|
|
|
if (EX) {
|
|
|
|
|
|
struct DB_TERM *exp = EX;
|
|
|
|
|
|
EX = NULL;
|
|
|
|
|
|
Yap_JumpToEnv(Yap_PopTermFromDB(exp));
|
|
|
|
|
|
SREG = NULL;
|
|
|
|
|
|
}
|
|
|
|
|
|
if (!SREG) {
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
/* in case we call Execute */
|
|
|
|
|
|
YENV = ENV;
|
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
|
|
NoStackUserCall:
|
|
|
|
|
|
PROCESS_INT(interrupt_call, do_user_call);
|
|
|
|
|
|
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(call_c_wfail, slp);
|
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
|
if (Yap_do_low_level_trace) {
|
|
|
|
|
|
low_level_trace(enter_pred,PREG->y_u.slp.p,XREGS+1);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
|
{
|
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
|
|
|
|
|
#ifdef YAPOR_SBA
|
|
|
|
|
|
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b;
|
|
|
|
|
|
#else
|
|
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b;
|
|
|
|
|
|
#endif /* YAPOR_SBA */
|
|
|
|
|
|
else {
|
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
|
d0 = PREG->y_u.slp.s;
|
|
|
|
|
|
ASP = ((CELL *)YREG) + d0;
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
#else
|
|
|
|
|
|
if (YREG > (CELL *) B)
|
|
|
|
|
|
ASP = (CELL *) B;
|
|
|
|
|
|
else {
|
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
|
d0 = PREG->y_u.slp.s;
|
|
|
|
|
|
ASP = ((CELL *) YREG) + d0;
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
|
{
|
|
|
|
|
|
CPredicate f = PREG->y_u.slp.p->cs.f_code;
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
SREG = (CELL *)((f)(PASS_REGS1));
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
}
|
|
|
|
|
|
if (!SREG) {
|
|
|
|
|
|
/* be careful about error handling */
|
|
|
|
|
|
if (PREG != FAILCODE)
|
|
|
|
|
|
PREG = PREG->y_u.slp.l;
|
|
|
|
|
|
} else {
|
|
|
|
|
|
PREG = NEXTOP(PREG, slp);
|
|
|
|
|
|
}
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(try_c, OtapFs);
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
|
/* Alocate space for the cut_c structure*/
|
|
|
|
|
|
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
|
|
|
|
|
|
S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
|
|
|
|
|
|
store_args(PREG->y_u.OtapFs.s);
|
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
|
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
|
|
|
|
|
|
|
TRYCC:
|
|
|
|
|
|
ASP = (CELL *)B;
|
|
|
|
|
|
{
|
|
|
|
|
|
CPredicate f = (CPredicate)(PREG->y_u.OtapFs.f);
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
SREG = (CELL *) ((f) (PASS_REGS1));
|
|
|
|
|
|
/* This last instruction changes B B*/
|
|
|
|
|
|
while (POP_CHOICE_POINT(B)){
|
|
|
|
|
|
cut_c_pop();
|
|
|
|
|
|
}
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
}
|
|
|
|
|
|
if (!SREG) {
|
|
|
|
|
|
/* Removes the cut functions from the stack
|
|
|
|
|
|
without executing them because we have fail
|
|
|
|
|
|
and not cuted the predicate*/
|
|
|
|
|
|
while(POP_CHOICE_POINT(B))
|
|
|
|
|
|
cut_c_pop();
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
if ((CELL *) B == YREG && ASP != (CELL *) B) {
|
|
|
|
|
|
/* as Luis says, the predicate that did the try C might
|
|
|
|
|
|
* have left some data on the stack. We should preserve
|
|
|
|
|
|
* it, unless the builtin also did cut */
|
|
|
|
|
|
YREG = ASP;
|
|
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
|
SET_BB(B);
|
|
|
|
|
|
}
|
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(retry_c, OtapFs);
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
|
CPREG = B_YREG->cp_cp;
|
|
|
|
|
|
ENV = B_YREG->cp_env;
|
|
|
|
|
|
HR = PROTECT_FROZEN_H(B);
|
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
|
DEPTH =B->cp_depth;
|
|
|
|
|
|
#endif
|
|
|
|
|
|
HBREG = HR;
|
|
|
|
|
|
restore_args(PREG->y_u.OtapFs.s);
|
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
|
goto TRYCC;
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(cut_c, OtapFs);
|
|
|
|
|
|
/*This is a phantom instruction. This is not executed by the WAM*/
|
|
|
|
|
|
#ifdef DEBUG
|
|
|
|
|
|
/*If WAM executes this instruction, probably there's an error
|
|
|
|
|
|
when we put this instruction, cut_c, after retry_c*/
|
|
|
|
|
|
printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__);
|
|
|
|
|
|
#endif /*DEBUG*/
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(try_userc, OtapFs);
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
|
/* Alocate space for the cut_c structure*/
|
|
|
|
|
|
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
|
|
|
|
|
|
S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
|
|
|
|
|
|
store_args(PREG->y_u.OtapFs.s);
|
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
|
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
|
#endif
|
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
|
ENDCACHE_Y();
|
2015-01-20 03:00:42 +00:00
|
|
|
|
LOCAL_PrologMode = UserCCallMode;
|
2015-01-18 03:00:19 +00:00
|
|
|
|
ASP = YREG;
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
|
SREG = (CELL *) YAP_ExecuteFirst(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f));
|
|
|
|
|
|
EX = NULL;
|
|
|
|
|
|
restore_machine_regs();
|
|
|
|
|
|
setregs();
|
2015-01-20 03:00:42 +00:00
|
|
|
|
LOCAL_PrologMode &= UserMode;
|
2015-01-18 03:00:19 +00:00
|
|
|
|
if (!SREG) {
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
if ((CELL *) B == YREG && ASP != (CELL *) B) {
|
|
|
|
|
|
/* as Luis says, the predicate that did the try C might
|
|
|
|
|
|
* have left some data on the stack. We should preserve
|
|
|
|
|
|
* it, unless the builtin also did cut */
|
|
|
|
|
|
YREG = ASP;
|
|
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
|
}
|
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(retry_userc, OtapFs);
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
|
CPREG = B_YREG->cp_cp;
|
|
|
|
|
|
ENV = B_YREG->cp_env;
|
|
|
|
|
|
HR = PROTECT_FROZEN_H(B);
|
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
|
DEPTH =B->cp_depth;
|
|
|
|
|
|
#endif
|
|
|
|
|
|
HBREG = HR;
|
|
|
|
|
|
restore_args(PREG->y_u.OtapFs.s);
|
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
|
|
|
|
|
|
|
LOCAL_PrologMode |= UserCCallMode;
|
|
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
|
SREG = (CELL *) YAP_ExecuteNext(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f));
|
|
|
|
|
|
EX = NULL;
|
|
|
|
|
|
restore_machine_regs();
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
LOCAL_PrologMode &= ~UserCCallMode;
|
|
|
|
|
|
if (!SREG) {
|
|
|
|
|
|
/* Removes the cut functions from the stack
|
|
|
|
|
|
without executing them because we have fail
|
|
|
|
|
|
and not cuted the predicate*/
|
|
|
|
|
|
while(POP_CHOICE_POINT(B))
|
|
|
|
|
|
cut_c_pop();
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
if ((CELL *) B == YREG && ASP != (CELL *) B) {
|
|
|
|
|
|
/* as Luis says, the predicate that did the try C might
|
|
|
|
|
|
* have left some data on the stack. We should preserve
|
|
|
|
|
|
* it, unless the builtin also did cut */
|
|
|
|
|
|
YREG = ASP;
|
|
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
|
}
|
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(cut_userc, OtapFs);
|
|
|
|
|
|
/*This is a phantom instruction. This is not executed by the WAM*/
|
|
|
|
|
|
#ifdef DEBUG
|
|
|
|
|
|
/*If WAM executes this instruction, probably there's an error
|
|
|
|
|
|
when we put this instruction, cut_userc, after retry_userc*/
|
|
|
|
|
|
printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__);
|
|
|
|
|
|
#endif /*DEBUG*/
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
|
* support instructions *
|
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
|
|
BOp(lock_pred, e);
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *ap = PredFromDefCode(PREG);
|
|
|
|
|
|
PELOCK(10,ap);
|
|
|
|
|
|
PP = ap;
|
|
|
|
|
|
if (!ap->cs.p_code.NOfClauses) {
|
|
|
|
|
|
UNLOCKPE(11,ap);
|
|
|
|
|
|
FAIL();
|
|
|
|
|
|
}
|
|
|
|
|
|
/*
|
|
|
|
|
|
we do not lock access to the predicate,
|
|
|
|
|
|
we must take extra care here
|
|
|
|
|
|
*/
|
|
|
|
|
|
if (ap->cs.p_code.NOfClauses > 1 &&
|
|
|
|
|
|
!(ap->PredFlags & IndexedPredFlag)) {
|
|
|
|
|
|
/* update ASP before calling IPred */
|
|
|
|
|
|
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 */
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
/* for profiler */
|
|
|
|
|
|
save_pc();
|
|
|
|
|
|
}
|
|
|
|
|
|
PREG = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
|
}
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(index_pred, e);
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *ap = PredFromDefCode(PREG);
|
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
|
/*
|
|
|
|
|
|
we do not lock access to the predicate,
|
|
|
|
|
|
we must take extra care here
|
|
|
|
|
|
*/
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
PELOCK(11,ap);
|
|
|
|
|
|
}
|
|
|
|
|
|
if (ap->OpcodeOfPred != INDEX_OPCODE) {
|
|
|
|
|
|
/* someone was here before we were */
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
UNLOCKPE(11,ap);
|
|
|
|
|
|
}
|
|
|
|
|
|
PREG = ap->CodeOfPred;
|
|
|
|
|
|
/* for profiler */
|
|
|
|
|
|
save_pc();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif
|
|
|
|
|
|
/* update ASP before calling IPred */
|
|
|
|
|
|
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 */
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
PREG = ap->CodeOfPred;
|
|
|
|
|
|
/* for profiler */
|
|
|
|
|
|
save_pc();
|
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
|
if (!PP)
|
|
|
|
|
|
#endif
|
|
|
|
|
|
UNLOCKPE(14,ap);
|
|
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
#if THREADS
|
|
|
|
|
|
BOp(thread_local, e);
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *ap = PredFromDefCode(PREG);
|
|
|
|
|
|
ap = Yap_GetThreadPred(ap PASS_REGS);
|
|
|
|
|
|
PREG = ap->CodeOfPred;
|
|
|
|
|
|
/* for profiler */
|
|
|
|
|
|
save_pc();
|
|
|
|
|
|
}
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
|
BOp(expand_index, e);
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *pe = PredFromExpandCode(PREG);
|
|
|
|
|
|
yamop *pt0;
|
|
|
|
|
|
|
|
|
|
|
|
/* update ASP before calling IPred */
|
|
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
PELOCK(12,pe);
|
|
|
|
|
|
}
|
|
|
|
|
|
if (!same_lu_block(PREG_ADDR, PREG)) {
|
|
|
|
|
|
PREG = *PREG_ADDR;
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
UNLOCKPE(15,pe);
|
|
|
|
|
|
}
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif
|
|
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
|
S = SREG;
|
|
|
|
|
|
#endif /* SHADOW_S */
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
pt0 = Yap_ExpandIndex(pe, 0);
|
|
|
|
|
|
/* restart index */
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
|
SREG = S;
|
|
|
|
|
|
#endif /* SHADOW_S */
|
|
|
|
|
|
PREG = pt0;
|
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
UNLOCKPE(12,pe);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
}
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(expand_clauses, sssllp);
|
|
|
|
|
|
{
|
|
|
|
|
|
PredEntry *pe = PREG->y_u.sssllp.p;
|
|
|
|
|
|
yamop *pt0;
|
|
|
|
|
|
|
|
|
|
|
|
/* update ASP before calling IPred */
|
|
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
|
if (PP == NULL) {
|
|
|
|
|
|
PELOCK(13,pe);
|
|
|
|
|
|
}
|
|
|
|
|
|
if (!same_lu_block(PREG_ADDR, PREG)) {
|
|
|
|
|
|
PREG = *PREG_ADDR;
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
UNLOCKPE(16,pe);
|
|
|
|
|
|
}
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
pt0 = Yap_ExpandIndex(pe, 0);
|
|
|
|
|
|
/* restart index */
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
PREG = pt0;
|
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
|
if (!PP) {
|
|
|
|
|
|
UNLOCKPE(18,pe);
|
|
|
|
|
|
}
|
|
|
|
|
|
#endif
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
}
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(undef_p, e);
|
|
|
|
|
|
/* save S for module name */
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
undef_goal( PASS_REGS1 );
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
/* for profiler */
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
BOp(spy_pred, e);
|
|
|
|
|
|
saveregs();
|
|
|
|
|
|
spy_goal( PASS_REGS1 );
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
