302 lines
7.4 KiB
C
302 lines
7.4 KiB
C
|
|
||
|
|
#ifdef INDENT_CODE
|
||
|
|
{
|
||
|
|
{
|
||
|
|
{
|
||
|
|
#endif /* INDENT_CODE */
|
||
|
|
|
||
|
|
/* join all the meta-call code into a single procedure with three entry points */
|
||
|
|
{
|
||
|
|
CACHE_Y_AS_ENV(YREG);
|
||
|
|
BEGD(d0); /* term to be meta-called */
|
||
|
|
Term mod; /* module to be used */
|
||
|
|
PredEntry *pen; /* predicate */
|
||
|
|
choiceptr b_ptr; /* cut point */
|
||
|
|
Functor f;
|
||
|
|
|
||
|
|
/* we are doing the rhs of a , */
|
||
|
|
BOp(p_execute_tail, Osbmp);
|
||
|
|
|
||
|
|
FETCH_Y_FROM_ENV(YREG);
|
||
|
|
/* place to cut to */
|
||
|
|
b_ptr = (choiceptr)ENV_YREG[E_CB];
|
||
|
|
/* original goal */
|
||
|
|
d0 = ENV_YREG[-EnvSizeInCells-1];
|
||
|
|
/* predicate we had used */
|
||
|
|
pen = RepPredProp((Prop)IntegerOfTerm(ENV_YREG[-EnvSizeInCells-2]));
|
||
|
|
/* current module at the time */
|
||
|
|
mod = ENV_YREG[-EnvSizeInCells-3];
|
||
|
|
/* set YREG */
|
||
|
|
/* Try to preserve the environment */
|
||
|
|
ENV_YREG = (CELL *) (((char *) YREG) + PREG->y_u.Osbmp.s);
|
||
|
|
#ifdef FROZEN_STACKS
|
||
|
|
{
|
||
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||
|
|
#ifdef YAPOR_SBA
|
||
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b;
|
||
|
|
#else
|
||
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||
|
|
#endif /* YAPOR_SBA */
|
||
|
|
}
|
||
|
|
#else
|
||
|
|
if (ENV_YREG > (CELL *) B) {
|
||
|
|
ENV_YREG = (CELL *) B;
|
||
|
|
}
|
||
|
|
#endif /* FROZEN_STACKS */
|
||
|
|
/* now, jump to actual execution */
|
||
|
|
if (pen->ArityOfPE) {
|
||
|
|
f = pen->FunctorOfPred;
|
||
|
|
/* reuse environment if we are continuining a comma, ie, (g1,g2,g3) */
|
||
|
|
/* can only do it deterministically */
|
||
|
|
/* broken
|
||
|
|
if (f == FunctorComma && (CELL *)B >= ENV) {
|
||
|
|
ENV_YREG = ENV;
|
||
|
|
ENV = (CELL *)ENV[E_E];
|
||
|
|
}
|
||
|
|
*/
|
||
|
|
goto execute_pred_f;
|
||
|
|
} else
|
||
|
|
goto execute_pred_a;
|
||
|
|
ENDBOp();
|
||
|
|
|
||
|
|
/* fetch the module from ARG2 */
|
||
|
|
BOp(p_execute2, Osbpp);
|
||
|
|
|
||
|
|
mod = ARG2;
|
||
|
|
deref_head(mod, execute2_unk0);
|
||
|
|
execute2_nvar0:
|
||
|
|
if (!IsAtomTerm(mod)) {
|
||
|
|
saveregs();
|
||
|
|
Yap_Error(TYPE_ERROR_ATOM, mod, "call/2");
|
||
|
|
setregs();
|
||
|
|
}
|
||
|
|
goto start_execute;
|
||
|
|
|
||
|
|
BEGP(pt1);
|
||
|
|
deref_body(mod, pt1, execute2_unk0, execute2_nvar0);
|
||
|
|
saveregs();
|
||
|
|
Yap_Error(INSTANTIATION_ERROR, mod, "call/2");
|
||
|
|
setregs();
|
||
|
|
ENDP(pt1);
|
||
|
|
/* Oops, second argument was unbound too */
|
||
|
|
FAIL();
|
||
|
|
ENDBOp();
|
||
|
|
|
||
|
|
BOp(p_execute, Osbmp);
|
||
|
|
/* fetch the module from PREG */
|
||
|
|
mod = PREG->y_u.Osbmp.mod;
|
||
|
|
start_execute:
|
||
|
|
/* place to cut to */
|
||
|
|
b_ptr = B;
|
||
|
|
/* we have mod, and ARG1 has the goal, let us roll */
|
||
|
|
/* Try to preserve the environment */
|
||
|
|
ENV_YREG = (CELL *) (((char *) YREG) + PREG->y_u.Osbmp.s);
|
||
|
|
#ifdef FROZEN_STACKS
|
||
|
|
{
|
||
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||
|
|
#ifdef YAPOR_SBA
|
||
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b;
|
||
|
|
#else
|
||
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
||
|
|
#endif /* YAPOR_SBA */
|
||
|
|
}
|
||
|
|
#else
|
||
|
|
if (ENV_YREG > (CELL *) B) {
|
||
|
|
ENV_YREG = (CELL *) B;
|
||
|
|
}
|
||
|
|
#endif /* FROZEN_STACKS */
|
||
|
|
d0 = ARG1;
|
||
|
|
if (PRED_GOAL_EXPANSION_ALL) {
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
restart_execute:
|
||
|
|
deref_head(d0, execute_unk);
|
||
|
|
execute_nvar:
|
||
|
|
if (IsApplTerm(d0)) {
|
||
|
|
f = FunctorOfTerm(d0);
|
||
|
|
if (IsExtensionFunctor(f)) {
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
pen = RepPredProp(PredPropByFunc(f, mod));
|
||
|
|
execute_pred_f:
|
||
|
|
if (pen->PredFlags & (MetaPredFlag|GoalExPredFlag)) {
|
||
|
|
/* just strip all of M:G */
|
||
|
|
if (f == FunctorModule) {
|
||
|
|
Term tmod = ArgOfTerm(1,d0);
|
||
|
|
/* loop on modules */
|
||
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||
|
|
d0 = ArgOfTerm(2,d0);
|
||
|
|
mod = tmod;
|
||
|
|
goto execute_nvar;
|
||
|
|
}
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
if (f == FunctorComma) {
|
||
|
|
Term nmod = mod;
|
||
|
|
|
||
|
|
/* optimise conj */
|
||
|
|
SREG = RepAppl(d0);
|
||
|
|
BEGD(d1);
|
||
|
|
d1 = SREG[2];
|
||
|
|
/* create an environment to execute the call */
|
||
|
|
deref_head(d1, execute_comma_unk);
|
||
|
|
execute_comma_nvar:
|
||
|
|
if (IsAtomTerm(d1)) {
|
||
|
|
/* atomic goal is simpler */
|
||
|
|
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),nmod));
|
||
|
|
} else if (IsApplTerm(d1)) {
|
||
|
|
Functor f1 = FunctorOfTerm(d1);
|
||
|
|
if (IsExtensionFunctor(f1)) {
|
||
|
|
goto execute_metacall;
|
||
|
|
} else {
|
||
|
|
/* check for modules when looking up */
|
||
|
|
if (f1 == FunctorModule) {
|
||
|
|
Term tmod = ArgOfTerm(1,d1);
|
||
|
|
/* loop on modules */
|
||
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||
|
|
d1 = ArgOfTerm(2,d1);
|
||
|
|
nmod = tmod;
|
||
|
|
goto execute_comma_nvar;
|
||
|
|
}
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f1,nmod));
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
ENV_YREG[-EnvSizeInCells-3] = mod;
|
||
|
|
/* now, we can create the new environment for the meta-call */
|
||
|
|
/* notice that we are at a call, so we should ignore CP */
|
||
|
|
ENV_YREG[E_CP] = (CELL)NEXTOP(PREG,Osbmp);
|
||
|
|
ENV_YREG[E_CB] = (CELL)b_ptr;
|
||
|
|
ENV_YREG[E_E] = (CELL)ENV;
|
||
|
|
#ifdef DEPTH_LIMIT
|
||
|
|
ENV_YREG[E_DEPTH] = DEPTH;
|
||
|
|
#endif /* DEPTH_LIMIT */
|
||
|
|
ENV_YREG[-EnvSizeInCells-1] = d1;
|
||
|
|
ENV = ENV_YREG;
|
||
|
|
ENV_YREG -= EnvSizeInCells+3;
|
||
|
|
CPREG = NEXTOP(PREG, Osbmp);
|
||
|
|
PREG = COMMA_CODE;
|
||
|
|
/* for profiler */
|
||
|
|
save_pc();
|
||
|
|
d0 = SREG[1];
|
||
|
|
goto restart_execute;
|
||
|
|
|
||
|
|
BEGP(pt1);
|
||
|
|
deref_body(d1, pt1, execute_comma_unk, execute_comma_nvar);
|
||
|
|
goto execute_metacall;
|
||
|
|
ENDP(pt1);
|
||
|
|
ENDD(d1);
|
||
|
|
} else if (mod != CurrentModule) {
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
/* copy arguments of meta-call to XREGS */
|
||
|
|
BEGP(pt1);
|
||
|
|
pt1 = RepAppl(d0);
|
||
|
|
BEGD(d2);
|
||
|
|
for (d2 = ArityOfFunctor(f); d2; d2--) {
|
||
|
|
#ifdef YAPOR_SBA
|
||
|
|
BEGD(d1);
|
||
|
|
d1 = pt1[d2];
|
||
|
|
if (d1 == 0) {
|
||
|
|
XREGS[d2] = (CELL)(pt1+d2);
|
||
|
|
} else {
|
||
|
|
XREGS[d2] = d1;
|
||
|
|
}
|
||
|
|
#else
|
||
|
|
XREGS[d2] = pt1[d2];
|
||
|
|
#endif
|
||
|
|
}
|
||
|
|
ENDD(d2);
|
||
|
|
ENDP(pt1);
|
||
|
|
CACHE_A1();
|
||
|
|
} else if (IsAtomTerm(d0)) {
|
||
|
|
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
|
||
|
|
execute_pred_a:
|
||
|
|
/* handle extra pruning */
|
||
|
|
if (pen->FunctorOfPred == (Functor)AtomCut) {
|
||
|
|
if (b_ptr != B) {
|
||
|
|
saveregs();
|
||
|
|
prune(b_ptr PASS_REGS);
|
||
|
|
setregs();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
goto execute_metacall;
|
||
|
|
}
|
||
|
|
|
||
|
|
/* execute, but test first for interrupts */
|
||
|
|
execute_end:
|
||
|
|
/* code copied from call */
|
||
|
|
#ifndef NO_CHECKING
|
||
|
|
check_stack(NoStackPExecute, HR);
|
||
|
|
#endif
|
||
|
|
execute_stack_checked:
|
||
|
|
CPREG = NEXTOP(PREG, Osbmp);
|
||
|
|
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
|
||
|
|
PREG = pen->CodeOfPred;
|
||
|
|
/* for profiler */
|
||
|
|
save_pc();
|
||
|
|
#ifdef DEPTH_LIMIT
|
||
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
||
|
|
if (pen->ModuleOfPred) {
|
||
|
|
if (DEPTH == MkIntTerm(0))
|
||
|
|
FAIL();
|
||
|
|
else DEPTH = RESET_DEPTH();
|
||
|
|
}
|
||
|
|
} else if (pen->ModuleOfPred)
|
||
|
|
DEPTH -= MkIntConstant(2);
|
||
|
|
#endif /* DEPTH_LIMIT */
|
||
|
|
#ifdef LOW_LEVEL_TRACER
|
||
|
|
if (Yap_do_low_level_trace)
|
||
|
|
low_level_trace(enter_pred,pen,XREGS+1);
|
||
|
|
#endif /* LOW_LEVEL_TRACER */
|
||
|
|
WRITEBACK_Y_AS_ENV();
|
||
|
|
/* setup GB */
|
||
|
|
ENV_YREG[E_CB] = (CELL) B;
|
||
|
|
#ifdef YAPOR
|
||
|
|
SCH_check_requests();
|
||
|
|
#endif /* YAPOR */
|
||
|
|
CACHE_A1();
|
||
|
|
ALWAYS_GONext();
|
||
|
|
ALWAYS_END_PREFETCH();
|
||
|
|
|
||
|
|
/* meta-call: Prolog to the rescue */
|
||
|
|
BEGP(pt1);
|
||
|
|
deref_body(d0, pt1, execute_unk, execute_nvar);
|
||
|
|
execute_metacall:
|
||
|
|
ARG1 = ARG3 = d0;
|
||
|
|
pen = PredMetaCall;
|
||
|
|
ARG2 = Yap_cp_as_integer(b_ptr);
|
||
|
|
if (mod)
|
||
|
|
ARG4 = mod;
|
||
|
|
else
|
||
|
|
ARG4 = TermProlog;
|
||
|
|
goto execute_end;
|
||
|
|
ENDP(pt1);
|
||
|
|
|
||
|
|
/* at this point, we have the arguments all set in the argument registers, pen says who is the current predicate. don't remove. */
|
||
|
|
NoStackPExecute:
|
||
|
|
WRITEBACK_Y_AS_ENV();
|
||
|
|
#ifdef SHADOW_S
|
||
|
|
Yap_REGS.S_ = SREG;
|
||
|
|
#endif
|
||
|
|
saveregs_and_ycache();
|
||
|
|
d0 = interrupt_pexecute( pen PASS_REGS );
|
||
|
|
setregs_and_ycache();
|
||
|
|
#ifdef SHADOW_S
|
||
|
|
SREG = Yap_REGS.S_;
|
||
|
|
#endif
|
||
|
|
if (!d0) FAIL();
|
||
|
|
if (d0 == 2) goto execute_stack_checked;
|
||
|
|
goto execute_end;
|
||
|
|
ENDBOp();
|
||
|
|
|
||
|
|
ENDD(d0);
|
||
|
|
ENDCACHE_Y_AS_ENV();
|
||
|
|
}
|