629 lines
16 KiB
C
629 lines
16 KiB
C
/************************************************************************\
|
||
* 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();
|
||
|
||
|