/************************************************************************\ * Call C predicates instructions * \************************************************************************/ #ifdef INDENT_CODE { { { #endif /* INDENT_CODE */ BOp(call_cpred, Osbpp); #if __ANDROID__ && STRONG_DEBUG char *s; Atom name; if (PREG->y_u.Osbpp.p->ArityOfPE) { Functor f = PREG->y_u.Osbpp.p->FunctorOfPred; name = f->NameOfFE; } else { name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred); } s = name->StrOfAE; LOG( " %s ", s); #endif 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) { if (DEPTH == MkIntTerm(0)) { FAIL(); } else{ DEPTH = RESET_DEPTH(); } } } 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, slpp); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { low_level_trace(enter_pred,PREG->y_u.slpp.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.slpp.s; ASP = ((CELL *)YREG) + d0; ENDD(d0); } } #else if (YREG > (CELL *) B) ASP = (CELL *) B; else { BEGD(d0); d0 = PREG->y_u.slpp.s; ASP = ((CELL *) YREG) + d0; ENDD(d0); } #endif /* FROZEN_STACKS */ { CPredicate f = PREG->y_u.slpp.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.slpp.l; } else { PREG = NEXTOP(PREG, slpp); } 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(); LOCAL_PrologMode = UserCCallMode; 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(); LOCAL_PrologMode &= UserMode; 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();