2041 lines
57 KiB
C
Executable File
2041 lines
57 KiB
C
Executable File
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: exec.c *
|
|
* Last rev: 8/2/88 *
|
|
* mods: *
|
|
* comments: Execute Prolog code *
|
|
* *
|
|
*************************************************************************/
|
|
#ifdef SCCS
|
|
static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
|
|
#endif
|
|
|
|
#include "absmi.h"
|
|
#include "yapio.h"
|
|
#include "attvar.h"
|
|
#include "cut_c.h"
|
|
|
|
static Int CallPredicate(PredEntry *, choiceptr, yamop * CACHE_TYPE);
|
|
// must hold thread worker comm lock at call.
|
|
static Int EnterCreepMode(Term, Term CACHE_TYPE);
|
|
static Int p_save_cp( USES_REGS1 );
|
|
static Int p_execute( USES_REGS1 );
|
|
static Int p_execute0( USES_REGS1 );
|
|
|
|
static Term
|
|
cp_as_integer(choiceptr cp USES_REGS)
|
|
{
|
|
return(MkIntegerTerm(LCL0-(CELL *)cp));
|
|
}
|
|
|
|
static choiceptr
|
|
cp_from_integer(Term cpt USES_REGS)
|
|
{
|
|
return (choiceptr)(LCL0-IntegerOfTerm(cpt));
|
|
}
|
|
|
|
Term
|
|
Yap_cp_as_integer(choiceptr cp)
|
|
{
|
|
CACHE_REGS
|
|
return cp_as_integer(cp PASS_REGS);
|
|
}
|
|
|
|
static inline Int
|
|
CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code USES_REGS) {
|
|
#ifdef LOW_LEVEL_TRACER
|
|
if (Yap_do_low_level_trace)
|
|
low_level_trace(enter_pred,pen,XREGS+1);
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
#ifdef DEPTH_LIMIT
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
|
if (pen->ModuleOfPred) {
|
|
if (DEPTH == MkIntTerm(0)) {
|
|
UNLOCK(pen->PELock);
|
|
return FALSE;
|
|
}
|
|
else DEPTH = RESET_DEPTH();
|
|
}
|
|
} else if (pen->ModuleOfPred)
|
|
DEPTH -= MkIntConstant(2);
|
|
#endif /* DEPTH_LIMIT */
|
|
if (P->opc != EXECUTE_CPRED_OP_CODE) {
|
|
CP = P;
|
|
ENV = YENV;
|
|
YENV = ASP;
|
|
}
|
|
/* make sure we have access to the user given cut */
|
|
YENV[E_CB] = (CELL) cut_pt;
|
|
P = code;
|
|
return TRUE;
|
|
}
|
|
|
|
inline static Int
|
|
CallMetaCall(Term t, Term mod USES_REGS) {
|
|
ARG1 = t;
|
|
ARG2 = cp_as_integer(B PASS_REGS); /* p_save_cp */
|
|
ARG3 = t;
|
|
if (mod) {
|
|
ARG4 = mod;
|
|
} else {
|
|
ARG4 = TermProlog;
|
|
}
|
|
return CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred PASS_REGS);
|
|
}
|
|
|
|
Term
|
|
Yap_ExecuteCallMetaCall(Term mod) {
|
|
CACHE_REGS
|
|
Term ts[4];
|
|
ts[0] = ARG1;
|
|
ts[1] = cp_as_integer(B PASS_REGS); /* p_save_cp */
|
|
ts[2] = ARG1;
|
|
ts[3] = mod;
|
|
return Yap_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts);
|
|
}
|
|
|
|
Term
|
|
Yap_PredicateIndicator(Term t, Term mod)
|
|
{
|
|
CACHE_REGS
|
|
// generate predicate indicator in this case
|
|
Term ti[2];
|
|
t = Yap_StripModule( t, &mod );
|
|
if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) {
|
|
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
|
|
ti[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t)));
|
|
} else if (IsPairTerm(t)) {
|
|
ti[0] = MkAtomTerm(AtomDot);
|
|
ti[1] = MkIntTerm(2);
|
|
} else {
|
|
ti[0] = t;
|
|
ti[1] = MkIntTerm(0);
|
|
}
|
|
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
|
|
if (mod != CurrentModule) {
|
|
ti[0] = mod;
|
|
ti[1] = t;
|
|
return Yap_MkApplTerm(FunctorModule, 2, ti);
|
|
}
|
|
return t;
|
|
}
|
|
|
|
static Int
|
|
CallError(yap_error_number err, Term t, Term mod USES_REGS)
|
|
{
|
|
if (isoLanguageFlag()) {
|
|
return(CallMetaCall(t, mod PASS_REGS));
|
|
} else {
|
|
if (err == TYPE_ERROR_CALLABLE) {
|
|
t = Yap_StripModule(t, &mod);
|
|
}
|
|
Yap_Error(err, t, "call/1");
|
|
return FALSE;
|
|
}
|
|
}
|
|
|
|
static Int
|
|
p_save_cp( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG1);
|
|
Term td;
|
|
#if SHADOW_HB
|
|
register CELL *HBREG = HB;
|
|
#endif
|
|
if (!IsVarTerm(t)) return(FALSE);
|
|
td = cp_as_integer(B PASS_REGS);
|
|
YapBind((CELL *)t,td);
|
|
return TRUE;
|
|
}
|
|
|
|
static Int
|
|
p_save_env_b( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG1);
|
|
Term td;
|
|
#if SHADOW_HB
|
|
register CELL *HBREG = HB;
|
|
#endif
|
|
if (!IsVarTerm(t)) return(FALSE);
|
|
td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS);
|
|
YapBind((CELL *)t,td);
|
|
return TRUE;
|
|
}
|
|
|
|
static Int
|
|
p_trail_suspension_marker( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG1);
|
|
|
|
TrailTerm(TR) = AbsPair((CELL*)t);
|
|
TR++;
|
|
return TRUE;
|
|
}
|
|
|
|
inline static Int
|
|
do_execute(Term t, Term mod USES_REGS)
|
|
{
|
|
Term t0 = t;
|
|
/* first do predicate expansion, even before you process signals.
|
|
This way you don't get to spy goal_expansion(). */
|
|
if (PRED_GOAL_EXPANSION_ALL) {
|
|
/* disable creeping when we do goal expansion */
|
|
if (!LOCAL_InterruptsDisabled &&
|
|
Yap_get_signal( YAP_CREEP_SIGNAL ) ) {
|
|
CalculateStackGap( PASS_REGS1 );
|
|
}
|
|
return CallMetaCall(ARG1, mod PASS_REGS);
|
|
} else if (Yap_has_a_signal() &&
|
|
!LOCAL_InterruptsDisabled &&
|
|
!(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) {
|
|
return EnterCreepMode(t, mod PASS_REGS);
|
|
}
|
|
restart_exec:
|
|
if (IsVarTerm(t)) {
|
|
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
|
|
} else if (IsApplTerm(t)) {
|
|
register Functor f = FunctorOfTerm(t);
|
|
register CELL *pt;
|
|
PredEntry *pen;
|
|
unsigned int i, arity;
|
|
|
|
f = FunctorOfTerm(t);
|
|
if (IsExtensionFunctor(f)) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
arity = ArityOfFunctor(f);
|
|
if (arity > MaxTemps) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
pen = RepPredProp(PredPropByFunc(f, mod));
|
|
/* You thought we would be over by now */
|
|
/* but no meta calls require special preprocessing */
|
|
if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) {
|
|
if (f == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1,t);
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
mod = tmod;
|
|
t = ArgOfTerm(2,t);
|
|
goto restart_exec;
|
|
} else {
|
|
if (IsVarTerm(tmod)) {
|
|
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
|
|
} else {
|
|
return CallError(TYPE_ERROR_ATOM, t0, mod PASS_REGS);
|
|
}
|
|
}
|
|
} else {
|
|
return CallMetaCall(t, mod PASS_REGS);
|
|
}
|
|
}
|
|
/* now let us do what we wanted to do from the beginning !! */
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
pt = RepAppl(t)+1;
|
|
for (i = 1; i <= arity; i++) {
|
|
#if YAPOR_SBA
|
|
Term d0 = *pt++;
|
|
if (d0 == 0)
|
|
` XREGS[i] = (CELL)(pt-1);
|
|
else
|
|
XREGS[i] = d0;
|
|
#else
|
|
|
|
|
|
XREGS[i] = *pt++;
|
|
#endif
|
|
}
|
|
return (CallPredicate(pen, B, pen->CodeOfPred PASS_REGS));
|
|
} else if (IsAtomTerm(t)) {
|
|
PredEntry *pe;
|
|
Atom a = AtomOfTerm(t);
|
|
|
|
if (a == AtomTrue || a == AtomOtherwise || a == AtomCut)
|
|
return(TRUE);
|
|
else if (a == AtomFail || (a == AtomFalse && !RepPredProp(PredPropByAtom(a, mod))->ModuleOfPred) )
|
|
return(FALSE);
|
|
/* call may not define new system predicates!! */
|
|
pe = RepPredProp(PredPropByAtom(a, mod));
|
|
return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS));
|
|
} else if (IsIntTerm(t)) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
} else {
|
|
/* Is Pair Term */
|
|
return(CallMetaCall(t, mod PASS_REGS));
|
|
}
|
|
}
|
|
|
|
static Term
|
|
copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, unsigned int arity, Term mod USES_REGS)
|
|
{
|
|
CELL *h0 = HR;
|
|
Term tf;
|
|
unsigned int i;
|
|
|
|
if (arity == 2 &&
|
|
NameOfFunctor(f) == AtomDot) {
|
|
for (i = 0; i<arity-n;i++) {
|
|
*HR++ = pt[i];
|
|
}
|
|
for (i=0; i< n; i++) {
|
|
*HR++ = h0[(int)(i-n)];
|
|
}
|
|
tf = AbsPair(h0);
|
|
} else {
|
|
*HR++ = (CELL)f;
|
|
for (i = 0; i<arity-n;i++) {
|
|
*HR++ = pt[i];
|
|
}
|
|
for (i=0; i< n; i++) {
|
|
*HR++ = h0[(int)(i-n)];
|
|
}
|
|
tf = AbsAppl(h0);
|
|
}
|
|
if (mod != CurrentModule) {
|
|
CELL *h0 = HR;
|
|
*HR++ = (CELL)FunctorModule;
|
|
*HR++ = mod;
|
|
*HR++ = tf;
|
|
tf = AbsAppl(h0);
|
|
}
|
|
return tf;
|
|
}
|
|
|
|
inline static Int
|
|
do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
|
|
{
|
|
Functor f;
|
|
Atom Name;
|
|
register CELL *pt;
|
|
PredEntry *pen;
|
|
unsigned int i, arity;
|
|
int j = -n;
|
|
Term t0 = t;
|
|
|
|
restart_exec:
|
|
if (IsVarTerm(t)) {
|
|
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
|
|
} else if (IsAtomTerm(t)) {
|
|
arity = n;
|
|
Name = AtomOfTerm(t);
|
|
pt = NULL;
|
|
} else if (IsIntTerm(t)) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
} else if (IsPairTerm(t)) {
|
|
arity = n+2;
|
|
pt = RepPair(t);
|
|
Name = AtomOfTerm(TermNil);
|
|
} else /* if (IsApplTerm(t)) */ {
|
|
f = FunctorOfTerm(t);
|
|
while (f == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1,t);
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
mod = tmod;
|
|
t = ArgOfTerm(2,t);
|
|
goto restart_exec;
|
|
} else {
|
|
if (IsVarTerm(tmod)) {
|
|
return CallError(INSTANTIATION_ERROR, t0, tmod PASS_REGS);
|
|
} else {
|
|
return CallError(TYPE_ERROR_ATOM, t0, tmod PASS_REGS);
|
|
}
|
|
}
|
|
}
|
|
arity = ArityOfFunctor(f)+n;
|
|
Name = NameOfFunctor(f);
|
|
pt = RepAppl(t)+1;
|
|
}
|
|
f = Yap_MkFunctor(Name,arity);
|
|
if (IsExtensionFunctor(f)) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
if (PRED_GOAL_EXPANSION_ALL) {
|
|
/* disable creeping when we do goal expansion */
|
|
if (Yap_get_signal( YAP_CREEP_SIGNAL ) &&
|
|
!LOCAL_InterruptsDisabled) {
|
|
CalculateStackGap( PASS_REGS1 );
|
|
}
|
|
t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
|
|
return CallMetaCall(t, mod PASS_REGS);
|
|
} else if (Yap_has_a_signal() &&
|
|
!LOCAL_InterruptsDisabled) {
|
|
return EnterCreepMode(copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS), mod PASS_REGS);
|
|
}
|
|
if (arity > MaxTemps) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
pen = RepPredProp(PredPropByFunc(f, mod));
|
|
/* You thought we would be over by now */
|
|
/* but no meta calls require special preprocessing */
|
|
if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) {
|
|
Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
|
|
return(CallMetaCall(t, mod PASS_REGS));
|
|
}
|
|
/* now let us do what we wanted to do from the beginning !! */
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
for (i = 1; i <= arity-n; i++) {
|
|
#if YAPOR_SBA
|
|
Term d0 = *pt++;
|
|
if (d0 == 0)
|
|
XREGS[i] = (CELL)(pt-1);
|
|
else
|
|
XREGS[i] = d0;
|
|
#else
|
|
XREGS[i] = *pt++;
|
|
#endif
|
|
}
|
|
for (i = arity-n+1; i <= arity; i++,j++) {
|
|
XREGS[i] = HR[j];
|
|
}
|
|
return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS);
|
|
}
|
|
|
|
// enter locked
|
|
static Int
|
|
EnterCreepMode(Term t, Term mod USES_REGS) {
|
|
PredEntry *PredCreep;
|
|
|
|
if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) {
|
|
ARG1 = t;
|
|
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
|
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at meta-call");
|
|
}
|
|
if (!Yap_has_a_signal()) {
|
|
return do_execute(ARG1, mod PASS_REGS);
|
|
}
|
|
}
|
|
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1));
|
|
PP = PredCreep;
|
|
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) {
|
|
ARG1 = MkPairTerm(ArgOfTerm(1,t),ArgOfTerm(2,t));
|
|
} else {
|
|
if (mod) {
|
|
ARG1 = MkPairTerm(mod,t);
|
|
} else {
|
|
ARG1 = MkPairTerm(TermProlog,t);
|
|
}
|
|
}
|
|
CalculateStackGap( PASS_REGS1 );
|
|
P_before_spy = P;
|
|
return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
return do_execute(t, CurrentModule PASS_REGS);
|
|
}
|
|
|
|
static void
|
|
heap_store(Term t USES_REGS)
|
|
{
|
|
if (IsVarTerm(t)) {
|
|
if (VarOfTerm(t) < HR) {
|
|
*HR++ = t;
|
|
} else {
|
|
RESET_VARIABLE(HR);
|
|
Bind_Local(VarOfTerm(t), (CELL)HR);
|
|
HR++;
|
|
}
|
|
} else {
|
|
*HR++ = t;
|
|
}
|
|
}
|
|
|
|
static Int
|
|
p_execute2( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 1 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute3( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 2 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute4( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 3 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute5( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 4 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute6( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 5 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute7( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
heap_store(Deref(ARG7) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 6 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute8( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
heap_store(Deref(ARG7) PASS_REGS);
|
|
heap_store(Deref(ARG8) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 7 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute9( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
heap_store(Deref(ARG7) PASS_REGS);
|
|
heap_store(Deref(ARG8) PASS_REGS);
|
|
heap_store(Deref(ARG9) PASS_REGS);
|
|
return do_execute_n(t, CurrentModule, 8 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute10( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
heap_store(Deref(ARG7) PASS_REGS);
|
|
heap_store(Deref(ARG8) PASS_REGS);
|
|
heap_store(Deref(ARG9) PASS_REGS);
|
|
heap_store(Deref(ARG10) PASS_REGS);
|
|
return(do_execute_n(t, CurrentModule, 9 PASS_REGS));
|
|
}
|
|
|
|
static Int
|
|
p_execute11( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
heap_store(Deref(ARG7) PASS_REGS);
|
|
heap_store(Deref(ARG8) PASS_REGS);
|
|
heap_store(Deref(ARG9) PASS_REGS);
|
|
heap_store(Deref(ARG10) PASS_REGS);
|
|
heap_store(Deref(ARG11) PASS_REGS);
|
|
return(do_execute_n(t, CurrentModule, 10 PASS_REGS));
|
|
}
|
|
|
|
static Int
|
|
p_execute12( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
heap_store(Deref(ARG2) PASS_REGS);
|
|
heap_store(Deref(ARG3) PASS_REGS);
|
|
heap_store(Deref(ARG4) PASS_REGS);
|
|
heap_store(Deref(ARG5) PASS_REGS);
|
|
heap_store(Deref(ARG6) PASS_REGS);
|
|
heap_store(Deref(ARG7) PASS_REGS);
|
|
heap_store(Deref(ARG8) PASS_REGS);
|
|
heap_store(Deref(ARG9) PASS_REGS);
|
|
heap_store(Deref(ARG10) PASS_REGS);
|
|
heap_store(Deref(ARG11) PASS_REGS);
|
|
heap_store(Deref(ARG12) PASS_REGS);
|
|
return(do_execute_n(t, CurrentModule, 11 PASS_REGS));
|
|
}
|
|
|
|
static Int
|
|
p_execute_clause( USES_REGS1 )
|
|
{ /* '$execute_clause'(Goal) */
|
|
Term t = Deref(ARG1);
|
|
Term mod = Deref(ARG2);
|
|
choiceptr cut_cp = cp_from_integer(Deref(ARG4) PASS_REGS);
|
|
unsigned int arity;
|
|
Prop pe;
|
|
yamop *code;
|
|
Term clt = Deref(ARG3);
|
|
|
|
restart_exec:
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
|
|
return FALSE;
|
|
} else if (IsAtomTerm(t)) {
|
|
Atom a = AtomOfTerm(t);
|
|
pe = PredPropByAtom(a, mod);
|
|
} else if (IsApplTerm(t)) {
|
|
register Functor f = FunctorOfTerm(t);
|
|
register unsigned int i;
|
|
register CELL *pt;
|
|
|
|
if (IsExtensionFunctor(f))
|
|
return(FALSE);
|
|
if (f == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1,t);
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
mod = tmod;
|
|
t = ArgOfTerm(2,t);
|
|
goto restart_exec;
|
|
}
|
|
}
|
|
pe = PredPropByFunc(f, mod);
|
|
arity = ArityOfFunctor(f);
|
|
if (arity > MaxTemps) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
pt = RepAppl(t)+1;
|
|
for (i = 1; i <= arity; ++i) {
|
|
#if YAPOR_SBA
|
|
Term d0 = *pt++;
|
|
if (d0 == 0)
|
|
XREGS[i] = (CELL)(pt-1);
|
|
else
|
|
XREGS[i] = d0;
|
|
#else
|
|
XREGS[i] = *pt++;
|
|
#endif
|
|
}
|
|
} else {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
/* N = arity; */
|
|
/* call may not define new system predicates!! */
|
|
if (RepPredProp(pe)->PredFlags & MegaClausePredFlag) {
|
|
code = Yap_MegaClauseFromTerm(clt);
|
|
} else {
|
|
code = Yap_ClauseFromTerm(clt)->ClCode;
|
|
}
|
|
if (Yap_get_signal(YAP_CREEP_SIGNAL)) {
|
|
Yap_signal(YAP_CREEP_SIGNAL);
|
|
}
|
|
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_in_mod( USES_REGS1 )
|
|
{ /* '$execute'(Goal) */
|
|
return(do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS));
|
|
}
|
|
|
|
static Int
|
|
p_do_goal_expansion( USES_REGS1 )
|
|
{
|
|
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
|
|
Int out = FALSE;
|
|
PredEntry *pe;
|
|
Term cmod = Deref(ARG2);
|
|
|
|
ARG2 = ARG3;
|
|
|
|
/* CurMod:goal_expansion(A,B) */
|
|
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
out = TRUE;
|
|
ARG3 = ARG2;
|
|
goto complete;
|
|
}
|
|
/* system:goal_expansion(A,B) */
|
|
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
out = TRUE;
|
|
ARG3 = ARG2;
|
|
goto complete;
|
|
}
|
|
ARG3 = ARG2;
|
|
ARG2 = cmod;
|
|
/* user:goal_expansion(A,CurMod,B) */
|
|
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
out = TRUE;
|
|
goto complete;
|
|
}
|
|
ARG2 = ARG3;
|
|
/* user:goal_expansion(A,B) */
|
|
if ( cmod != USER_MODULE && /* we have tried this before */
|
|
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
ARG3 = ARG2;
|
|
out = TRUE;
|
|
}
|
|
complete:
|
|
if (creeping) {
|
|
Yap_signal( YAP_CREEP_SIGNAL );
|
|
}
|
|
return out;
|
|
}
|
|
|
|
static Int
|
|
p_do_term_expansion( USES_REGS1 )
|
|
{
|
|
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
|
|
Int out = FALSE;
|
|
PredEntry *pe;
|
|
Term cmod = CurrentModule;
|
|
|
|
/* CurMod:term_expansion(A,B) */
|
|
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
out = TRUE;
|
|
goto complete;
|
|
}
|
|
/* system:term_expansion(A,B) */
|
|
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
out = TRUE;
|
|
goto complete;
|
|
}
|
|
/* user:term_expansion(A,B) */
|
|
if ( cmod != USER_MODULE && /* we have tried this before */
|
|
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) &&
|
|
pe->OpcodeOfPred != FAIL_OPCODE &&
|
|
pe->OpcodeOfPred != UNDEF_OPCODE &&
|
|
Yap_execute_pred(pe, NULL PASS_REGS, false) ) {
|
|
out = TRUE;
|
|
}
|
|
complete:
|
|
if (creeping) {
|
|
Yap_signal(YAP_CREEP_SIGNAL);
|
|
}
|
|
return out;
|
|
}
|
|
|
|
static Int
|
|
p_execute0( USES_REGS1 )
|
|
{ /* '$execute0'(Goal,Mod) */
|
|
Term t = Deref(ARG1), t0 = t;
|
|
Term mod = Deref(ARG2);
|
|
unsigned int arity;
|
|
Prop pe;
|
|
|
|
if (Yap_has_a_signal() &&
|
|
!LOCAL_InterruptsDisabled) {
|
|
return EnterCreepMode(t, mod PASS_REGS);
|
|
}
|
|
restart_exec:
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
|
|
return FALSE;
|
|
} else if (IsAtomTerm(t)) {
|
|
Atom a = AtomOfTerm(t);
|
|
pe = PredPropByAtom(a, mod);
|
|
} else if (IsApplTerm(t)) {
|
|
register Functor f = FunctorOfTerm(t);
|
|
register unsigned int i;
|
|
register CELL *pt;
|
|
|
|
if (IsExtensionFunctor(f))
|
|
return FALSE;
|
|
if (f == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1,t);
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
mod = tmod;
|
|
t = ArgOfTerm(2,t);
|
|
goto restart_exec;
|
|
} else {
|
|
if (IsVarTerm(tmod)) {
|
|
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
|
|
} else {
|
|
return CallError(TYPE_ERROR_ATOM, t0, mod PASS_REGS);
|
|
}
|
|
}
|
|
}
|
|
pe = PredPropByFunc(f, mod);
|
|
// Yap_DebugPlWrite(mod);fprintf(stderr,"\n");
|
|
arity = ArityOfFunctor(f);
|
|
if (arity > MaxTemps) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
pt = RepAppl(t)+1;
|
|
for (i = 1; i <= arity; ++i) {
|
|
#if YAPOR_SBA
|
|
Term d0 = *pt++;
|
|
if (d0 == 0)
|
|
XREGS[i] = (CELL)(pt-1);
|
|
else
|
|
XREGS[i] = d0;
|
|
#else
|
|
XREGS[i] = *pt++;
|
|
#endif
|
|
}
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_CALLABLE, t,"call/1");
|
|
return FALSE;
|
|
}
|
|
/* N = arity; */
|
|
/* call may not define new system predicates!! */
|
|
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_nonstop( USES_REGS1 )
|
|
{ /* '$execute_nonstop'(Goal,Mod) */
|
|
Term t = Deref(ARG1), t0 = t;
|
|
Term mod = Deref(ARG2);
|
|
unsigned int arity;
|
|
Prop pe;
|
|
|
|
restart_exec:
|
|
if (IsVarTerm(mod)) {
|
|
mod = CurrentModule;
|
|
} else if (!IsAtomTerm(mod)) {
|
|
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
|
|
return FALSE;
|
|
}
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR,ARG1,"call/1");
|
|
return FALSE;
|
|
} else if (IsAtomTerm(t)) {
|
|
Atom a = AtomOfTerm(t);
|
|
pe = PredPropByAtom(a, mod);
|
|
} else if (IsApplTerm(t)) {
|
|
register Functor f = FunctorOfTerm(t);
|
|
register unsigned int i;
|
|
register CELL *pt;
|
|
|
|
if (IsExtensionFunctor(f))
|
|
return(FALSE);
|
|
if (f == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1,t);
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
mod = tmod;
|
|
t = ArgOfTerm(2,t);
|
|
goto restart_exec;
|
|
} else {
|
|
if (IsVarTerm(tmod)) {
|
|
return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS);
|
|
} else {
|
|
return CallError(TYPE_ERROR_ATOM, t, mod PASS_REGS);
|
|
}
|
|
}
|
|
}
|
|
pe = PredPropByFunc(f, mod);
|
|
arity = ArityOfFunctor(f);
|
|
if (arity > MaxTemps) {
|
|
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
|
|
}
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
pt = RepAppl(t)+1;
|
|
for (i = 1; i <= arity; ++i) {
|
|
#if YAPOR_SBA
|
|
Term d0 = *pt++;
|
|
if (d0 == 0)
|
|
XREGS[i] = (CELL)(pt-1);
|
|
else
|
|
XREGS[i] = d0;
|
|
#else
|
|
XREGS[i] = *pt++;
|
|
#endif
|
|
}
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
return FALSE;
|
|
}
|
|
/* N = arity; */
|
|
/* call may not define new system predicates!! */
|
|
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
|
|
if (!LOCAL_InterruptsDisabled &&
|
|
Yap_get_signal(YAP_CREEP_SIGNAL)) {
|
|
Yap_signal(YAP_CREEP_SIGNAL);
|
|
}
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
if (RepPredProp(pe)->PredFlags & LogUpdatePredFlag) {
|
|
PP = RepPredProp(pe);
|
|
PELOCK(80,PP);
|
|
}
|
|
#endif
|
|
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
|
|
} else { if (Yap_get_signal( YAP_CREEP_SIGNAL ) &&
|
|
!LOCAL_InterruptsDisabled &&
|
|
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) ||
|
|
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
|
|
Yap_signal(YAP_CREEP_SIGNAL);
|
|
}
|
|
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS);
|
|
}
|
|
}
|
|
|
|
static Term
|
|
slice_module_for_call_with_args(Term tin, Term *modp, int arity)
|
|
{
|
|
if (IsVarTerm(tin)) {
|
|
Yap_Error(INSTANTIATION_ERROR,tin,"call_with_args/%d", arity);
|
|
return 0L;
|
|
}
|
|
while (IsApplTerm(tin)) {
|
|
Functor f = FunctorOfTerm(tin);
|
|
Term newmod;
|
|
if (f != FunctorModule) {
|
|
Yap_Error(TYPE_ERROR_ATOM,tin,"call_with_args/%d", arity);
|
|
return 0L;
|
|
}
|
|
newmod = ArgOfTerm(1,tin);
|
|
if (IsVarTerm(newmod)) {
|
|
Yap_Error(INSTANTIATION_ERROR,tin,"call_with_args/%d",arity);
|
|
return 0L;
|
|
} else if (!IsAtomTerm(newmod)) {
|
|
Yap_Error(TYPE_ERROR_ATOM,newmod,"call_with_args/%d",arity);
|
|
return 0L;
|
|
}
|
|
*modp = newmod;
|
|
tin = ArgOfTerm(2,tin);
|
|
}
|
|
if (!IsAtomTerm(tin)) {
|
|
Yap_Error(TYPE_ERROR_ATOM,tin,"call_with_args/%d",arity);
|
|
return 0L;
|
|
}
|
|
return tin;
|
|
}
|
|
|
|
static Int
|
|
p_execute_0( USES_REGS1 )
|
|
{ /* '$execute_0'(Goal) */
|
|
Term mod = CurrentModule;
|
|
Term t = slice_module_for_call_with_args(Deref(ARG1),&mod,0);
|
|
if (!t)
|
|
return FALSE;
|
|
return do_execute(t, mod PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
call_with_args(int i USES_REGS)
|
|
{
|
|
Term mod = CurrentModule, t;
|
|
int j;
|
|
|
|
t = slice_module_for_call_with_args(Deref(ARG1),&mod,i);
|
|
if (!t)
|
|
return FALSE;
|
|
for (j=0;j<i;j++)
|
|
heap_store(Deref(XREGS[j+2]) PASS_REGS);
|
|
return(do_execute_n(t, mod, i PASS_REGS));
|
|
}
|
|
|
|
|
|
static Int
|
|
p_execute_1( USES_REGS1 )
|
|
{ /* '$execute_0'(Goal) */
|
|
return call_with_args(1 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_2( USES_REGS1 )
|
|
{ /* '$execute_2'(Goal) */
|
|
return call_with_args(2 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_3( USES_REGS1 )
|
|
{ /* '$execute_3'(Goal) */
|
|
return call_with_args(3 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_4( USES_REGS1 )
|
|
{ /* '$execute_4'(Goal) */
|
|
return call_with_args(4 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_5( USES_REGS1 )
|
|
{ /* '$execute_5'(Goal) */
|
|
return call_with_args(5 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_6( USES_REGS1 )
|
|
{ /* '$execute_6'(Goal) */
|
|
return call_with_args(6 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_7( USES_REGS1 )
|
|
{ /* '$execute_7'(Goal) */
|
|
return call_with_args(7 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_8( USES_REGS1 )
|
|
{ /* '$execute_8'(Goal) */
|
|
return call_with_args(8 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_9( USES_REGS1 )
|
|
{ /* '$execute_9'(Goal) */
|
|
return call_with_args(9 PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_execute_10( USES_REGS1 )
|
|
{ /* '$execute_10'(Goal) */
|
|
return call_with_args(10 PASS_REGS);
|
|
}
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
static Int
|
|
p_execute_depth_limit( USES_REGS1 ) {
|
|
Term d = Deref(ARG2);
|
|
if (IsVarTerm(d)) {
|
|
Yap_Error(INSTANTIATION_ERROR,d,"depth_bound_call/2");
|
|
return FALSE;
|
|
} else if (!IsIntegerTerm(d)) {
|
|
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
|
|
DEPTH = RESET_DEPTH();
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
|
|
return FALSE;
|
|
}
|
|
} else {
|
|
DEPTH = MkIntTerm(IntegerOfTerm(d)*2);
|
|
}
|
|
return p_execute( PASS_REGS1 );
|
|
}
|
|
#endif
|
|
|
|
static Int
|
|
p_pred_goal_expansion_on( USES_REGS1 ) {
|
|
/* a goal needs expansion if we have goal_expansion defined or
|
|
if the goal is a meta-call */
|
|
return PRED_GOAL_EXPANSION_ON;
|
|
}
|
|
|
|
|
|
static Int
|
|
exec_absmi(bool top, yap_reset_t reset_mode USES_REGS)
|
|
{
|
|
int lval, out;
|
|
|
|
if (top && (lval = sigsetjmp (LOCAL_RestartEnv, 1)) != 0) {
|
|
switch(lval) {
|
|
case 1:
|
|
{ /* restart */
|
|
/* otherwise, SetDBForThrow will fail entering critical mode */
|
|
LOCAL_PrologMode = UserMode;
|
|
/* find out where to cut to */
|
|
/* siglongjmp resets the TR hardware register */
|
|
/* TR and B are crucial, they might have been changed, or not */
|
|
restore_TR();
|
|
restore_B();
|
|
/* H is not so important, because we're gonna backtrack */
|
|
restore_H();
|
|
/* set stack */
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
|
/* forget any signals active, we're reborne */
|
|
LOCAL_Signals = 0;
|
|
CalculateStackGap( PASS_REGS1 );
|
|
LOCAL_PrologMode = UserMode;
|
|
P = (yamop *)FAILCODE;
|
|
}
|
|
break;
|
|
case 2:
|
|
{
|
|
/* arithmetic exception */
|
|
/* must be done here, otherwise siglongjmp will clobber all the registers */
|
|
Yap_Error(LOCAL_matherror ,TermNil,NULL);
|
|
/* reset the registers so that we don't have trash in abstract machine */
|
|
Yap_set_fpu_exceptions(true);
|
|
P = (yamop *)FAILCODE;
|
|
LOCAL_PrologMode = UserMode;
|
|
}
|
|
break;
|
|
case 3:
|
|
{ /* saved state */
|
|
return FALSE;
|
|
}
|
|
default:
|
|
/* do nothing */
|
|
LOCAL_PrologMode = UserMode;
|
|
}
|
|
} else {
|
|
LOCAL_PrologMode = UserMode;
|
|
}
|
|
YENV = ASP;
|
|
YENV[E_CB] = Unsigned (B);
|
|
out = Yap_absmi(0);
|
|
/* make sure we don't leave a FAIL signal hanging around */
|
|
Yap_get_signal( YAP_FAIL_SIGNAL );
|
|
if (!Yap_has_a_signal())
|
|
CalculateStackGap( PASS_REGS1 );
|
|
return out;
|
|
}
|
|
|
|
|
|
void
|
|
Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS)
|
|
{
|
|
/* create an initial pseudo environment so that when garbage
|
|
collection is going up in the environment chain it doesn't get
|
|
confused */
|
|
EX = NULL;
|
|
// sl = Yap_InitSlot(t);
|
|
YENV = ASP;
|
|
YENV[E_CP] = (CELL)YESCODE;
|
|
YENV[E_CB] = (CELL)B;
|
|
YENV[E_E] = (CELL)ENV;
|
|
#ifdef TABLING
|
|
YENV[E_B] = (CELL)B;
|
|
#endif
|
|
#ifdef DEPTH_LIMIT
|
|
YENV[E_DEPTH] = DEPTH;
|
|
#endif
|
|
ENV = YENV;
|
|
ASP -= EnvSizeInCells;
|
|
/* and now create a pseudo choicepoint for much the same reasons */
|
|
/* CP = YESCODE; */
|
|
/* keep a place where you can inform you had an exception */
|
|
if (pt) {
|
|
int i;
|
|
for (i = 0; i < arity; i++) {
|
|
XREGS[i+1] = *pt++;
|
|
}
|
|
}
|
|
B = (choiceptr)ASP;
|
|
B--;
|
|
B->cp_h = HR;
|
|
B->cp_tr = TR;
|
|
B->cp_cp = CP;
|
|
B->cp_ap = NOCODE;
|
|
B->cp_env = ENV;
|
|
B->cp_b = saved_b;
|
|
#ifdef DEPTH_LIMIT
|
|
B->cp_depth = DEPTH;
|
|
#endif /* DEPTH_LIMIT */
|
|
YENV = ASP = (CELL *)B;
|
|
YENV[E_CB] = (CELL)B;
|
|
HB = HR;
|
|
CP = YESCODE;
|
|
}
|
|
|
|
static Int
|
|
do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS)
|
|
{
|
|
choiceptr saved_b = B;
|
|
Int out;
|
|
|
|
Yap_PrepGoal(arity, pt, saved_b PASS_REGS);
|
|
P = (yamop *) CodeAdr;
|
|
S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
|
|
|
|
out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS);
|
|
Yap_flush();
|
|
// if (out) {
|
|
// out = Yap_GetFromSlot(sl);
|
|
// }
|
|
// Yap_RecoverSlots(1);
|
|
return out;
|
|
}
|
|
|
|
Int
|
|
Yap_exec_absmi(bool top, yap_reset_t has_reset)
|
|
{
|
|
CACHE_REGS
|
|
return exec_absmi(top, has_reset PASS_REGS);
|
|
}
|
|
|
|
|
|
void
|
|
Yap_fail_all( choiceptr bb USES_REGS )
|
|
{
|
|
yamop *saved_p, *saved_cp;
|
|
|
|
saved_p = P;
|
|
saved_cp = CP;
|
|
/* prune away choicepoints */
|
|
while (B && B->cp_b != bb) {
|
|
B = B->cp_b;
|
|
#ifdef YAPOR
|
|
CUT_prune_to(B);
|
|
#endif
|
|
}
|
|
P = FAILCODE;
|
|
Yap_exec_absmi( true, YAP_EXEC_ABSMI);
|
|
/* recover stack space */
|
|
HR = B->cp_h;
|
|
TR = B->cp_tr;
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH = B->cp_depth;
|
|
#endif /* DEPTH_LIMIT */
|
|
YENV = ENV = B->cp_env;
|
|
/* recover local stack */
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH= ENV[E_DEPTH];
|
|
#endif
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(B->cp_b))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
ENV = (CELL *)(ENV[E_E]);
|
|
/* ASP should be set to the top of the local stack when we
|
|
did the call */
|
|
ASP = B->cp_env;
|
|
/* YENV should be set to the current environment */
|
|
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
|
|
B = B->cp_b;
|
|
//SET_BB(B);
|
|
HB = PROTECT_FROZEN_H(B);
|
|
CP = saved_cp;
|
|
P = saved_p;
|
|
}
|
|
|
|
int
|
|
Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS)
|
|
{
|
|
yamop *saved_p, *saved_cp;
|
|
yamop *CodeAdr;
|
|
Int out;
|
|
|
|
saved_p = P;
|
|
saved_cp = CP;
|
|
|
|
PELOCK(81,ppe);
|
|
CodeAdr = ppe->CodeOfPred;
|
|
UNLOCK(ppe->PELock);
|
|
out = do_goal(CodeAdr, ppe->ArityOfPE, pt, false PASS_REGS);
|
|
|
|
if (out == 1) {
|
|
choiceptr cut_B;
|
|
/* we succeeded, let's prune */
|
|
/* restore the old environment */
|
|
/* get to previous environment */
|
|
cut_B = (choiceptr)ENV[E_CB];
|
|
{
|
|
/* Note that
|
|
cut_B == (choiceptr)ENV[E_CB] */
|
|
while (POP_CHOICE_POINT(ENV[E_CB]))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
}
|
|
#ifdef YAPOR
|
|
CUT_prune_to(cut_B);
|
|
#endif /* YAPOR */
|
|
#ifdef TABLING
|
|
if (B != cut_B) {
|
|
while (B->cp_b < cut_B) {
|
|
B = B->cp_b;
|
|
}
|
|
#ifdef TABLING
|
|
abolish_incomplete_subgoals(B);
|
|
#endif
|
|
}
|
|
#endif /* TABLING */
|
|
B = cut_B;
|
|
CP = saved_cp;
|
|
P = saved_p;
|
|
ASP = ENV;
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH= ENV[E_DEPTH];
|
|
#endif
|
|
ENV = (CELL *)(ENV[E_E]);
|
|
/* we have failed, and usually we would backtrack to this B,
|
|
trouble is, we may also have a delayed cut to do */
|
|
if (B != NULL)
|
|
HB = B->cp_h;
|
|
YENV = ENV;
|
|
// should we catch the exception or pass it through?
|
|
// We'll pass it through
|
|
if (EX && pass_ex) {
|
|
Term ball = Yap_PopTermFromDB( EX );
|
|
EX = NULL;
|
|
Yap_JumpToEnv( ball );
|
|
return FALSE;
|
|
}
|
|
return TRUE;
|
|
} else if (out == 0) {
|
|
P = saved_p;
|
|
CP = saved_cp;
|
|
HR = B->cp_h;
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH= B->cp_depth;
|
|
#endif
|
|
/* ASP should be set to the top of the local stack when we
|
|
did the call */
|
|
ASP = B->cp_env;
|
|
/* YENV should be set to the current environment */
|
|
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
|
|
B = B->cp_b;
|
|
SET_BB(B);
|
|
HB = PROTECT_FROZEN_H(B);
|
|
// should we catch the exception or pass it through?
|
|
// We'll pass it through
|
|
if (EX && pass_ex) {
|
|
Term ball = Yap_PopTermFromDB( EX );
|
|
EX = NULL;
|
|
Yap_JumpToEnv( ball );
|
|
return FALSE;
|
|
}
|
|
return(FALSE);
|
|
} else {
|
|
Yap_Error(SYSTEM_ERROR,TermNil,"emulator crashed");
|
|
return(FALSE);
|
|
}
|
|
}
|
|
|
|
Int
|
|
Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex)
|
|
{
|
|
CACHE_REGS
|
|
Prop pe;
|
|
PredEntry *ppe;
|
|
CELL *pt;
|
|
/* preserve the current restart environment */
|
|
/* visualc*/
|
|
/* just keep the difference because of possible garbage collections */
|
|
|
|
|
|
if (IsAtomTerm(t)) {
|
|
Atom a = AtomOfTerm(t);
|
|
pt = NULL;
|
|
pe = PredPropByAtom(a, mod);
|
|
} else if (IsApplTerm(t)) {
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
if (IsBlobFunctor(f)) {
|
|
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
return(FALSE);
|
|
}
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
pt = RepAppl(t)+1;
|
|
pe = PredPropByFunc(f, mod);
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
return(FALSE);
|
|
}
|
|
ppe = RepPredProp(pe);
|
|
if (pe == NIL) {
|
|
return CallMetaCall(t, mod PASS_REGS);
|
|
}
|
|
return Yap_execute_pred(ppe, pt, pass_ex PASS_REGS);
|
|
|
|
}
|
|
|
|
|
|
void
|
|
Yap_trust_last(void)
|
|
{
|
|
CACHE_REGS
|
|
ASP = B->cp_env;
|
|
CP = B->cp_cp;
|
|
HR = B->cp_h;
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH= B->cp_depth;
|
|
#endif
|
|
YENV= ASP = B->cp_env;
|
|
ENV = (CELL *)((B->cp_env)[E_E]);
|
|
B = B->cp_b;
|
|
P = (yamop *)(ENV[E_CP]);
|
|
if (B) {
|
|
SET_BB(B);
|
|
HB = PROTECT_FROZEN_H(B);
|
|
}
|
|
}
|
|
|
|
Term
|
|
Yap_RunTopGoal(Term t)
|
|
{
|
|
CACHE_REGS
|
|
yamop *CodeAdr;
|
|
Prop pe;
|
|
PredEntry *ppe;
|
|
CELL *pt;
|
|
UInt arity;
|
|
Term mod = CurrentModule;
|
|
Term goal_out = 0;
|
|
|
|
restart_runtopgoal:
|
|
if (IsAtomTerm(t)) {
|
|
Atom a = AtomOfTerm(t);
|
|
pt = NULL;
|
|
pe = PredPropByAtom(a, CurrentModule);
|
|
arity = 0;
|
|
} else if (IsApplTerm(t)) {
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
if (IsBlobFunctor(f)) {
|
|
Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
return(FALSE);
|
|
}
|
|
if (f == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1,t);
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
mod = tmod;
|
|
t = ArgOfTerm(2,t);
|
|
goto restart_runtopgoal;
|
|
} else {
|
|
if (IsVarTerm(tmod)) {
|
|
Yap_Error(INSTANTIATION_ERROR,t,"call/1");
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_ATOM,t,"call/1");
|
|
}
|
|
return FALSE;
|
|
}
|
|
}
|
|
/* I cannot use the standard macro here because
|
|
otherwise I would dereference the argument and
|
|
might skip a svar */
|
|
pe = PredPropByFunc(f, mod);
|
|
pt = RepAppl(t)+1;
|
|
arity = ArityOfFunctor(f);
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_CALLABLE,Yap_PredicateIndicator(t, mod),"call/1");
|
|
return(FALSE);
|
|
}
|
|
ppe = RepPredProp(pe);
|
|
if (pe == NIL) {
|
|
/* we must always start the emulator with Prolog code */
|
|
return FALSE;
|
|
}
|
|
PELOCK(82,ppe);
|
|
CodeAdr = ppe->CodeOfPred;
|
|
UNLOCK(ppe->PELock);
|
|
|
|
#if !USE_SYSTEM_MALLOC
|
|
if (LOCAL_TrailTop - HeapTop < 2048) {
|
|
LOCAL_PrologMode = BootMode;
|
|
Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,
|
|
"unable to boot because of too little Trail space");
|
|
}
|
|
#endif
|
|
goal_out = do_goal(CodeAdr, arity, pt, true PASS_REGS);
|
|
return goal_out;
|
|
}
|
|
|
|
static void
|
|
restore_regs(Term t, int restore_all USES_REGS)
|
|
{
|
|
if (IsApplTerm(t)) {
|
|
Int i;
|
|
Int max = ArityOfFunctor(FunctorOfTerm(t))-4;
|
|
CELL *ptr = RepAppl(t)+5;
|
|
|
|
P = (yamop *)IntegerOfTerm(ptr[-4]);
|
|
CP = (yamop *)IntegerOfTerm(ptr[-3]);
|
|
ENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-2]));
|
|
YENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-1]));
|
|
for (i = 0; i < max; i += 2) {
|
|
Int j = IntOfTerm(ptr[0]);
|
|
XREGS[j] = ptr[1];
|
|
ptr+=2;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* low level voodoo to restore temporary registers after a call */
|
|
static Int
|
|
p_restore_regs( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG1);
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining");
|
|
return(FALSE);
|
|
}
|
|
if (IsAtomTerm(t)) return(TRUE);
|
|
restore_regs(t, FALSE PASS_REGS);
|
|
return(TRUE);
|
|
}
|
|
|
|
/* low level voodoo to cut and then restore temporary registers after a call */
|
|
static Int
|
|
p_restore_regs2( USES_REGS1 )
|
|
{
|
|
|
|
Term t = Deref(ARG1), d0;
|
|
choiceptr pt0;
|
|
Int d;
|
|
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining");
|
|
return(FALSE);
|
|
}
|
|
d0 = Deref(ARG2);
|
|
if (!IsAtomTerm(t)) {
|
|
restore_regs(t, TRUE PASS_REGS);
|
|
}
|
|
if (IsVarTerm(d0)) {
|
|
Yap_Error(INSTANTIATION_ERROR,d0,"support for coroutining");
|
|
return(FALSE);
|
|
}
|
|
if (!IsIntegerTerm(d0)) {
|
|
return(FALSE);
|
|
}
|
|
d = IntegerOfTerm(d0);
|
|
if (!d)
|
|
return TRUE;
|
|
#if YAPOR_SBA
|
|
pt0 = (choiceptr)d;
|
|
#else
|
|
pt0 = (choiceptr)(LCL0-d);
|
|
#endif
|
|
/* find where to cut to */
|
|
if ((CELL *)pt0 != LCL0 && pt0 > B) {
|
|
/* Wow, we're gonna cut!!! */
|
|
while (B->cp_b < pt0) {
|
|
while (POP_CHOICE_POINT(B->cp_b))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
HB = B->cp_h;
|
|
Yap_TrimTrail();
|
|
B = B->cp_b;
|
|
}
|
|
#ifdef TABLING
|
|
abolish_incomplete_subgoals(B);
|
|
#endif
|
|
#ifdef YAPOR
|
|
CUT_prune_to(pt0);
|
|
#endif /* YAPOR */
|
|
B = pt0;
|
|
}
|
|
return(TRUE);
|
|
}
|
|
|
|
static Int
|
|
p_clean_ifcp( USES_REGS1 ) {
|
|
Term t = Deref(ARG1);
|
|
choiceptr pt0;
|
|
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR, t, "cut_at/1");
|
|
return FALSE;
|
|
}
|
|
if (!IsIntegerTerm(t)) {
|
|
Yap_Error(TYPE_ERROR_INTEGER, t, "cut_at/1");
|
|
return FALSE;
|
|
}
|
|
#if YAPOR_SBA
|
|
pt0 = (choiceptr)IntegerOfTerm(t);
|
|
#else
|
|
pt0 = cp_from_integer(t PASS_REGS);
|
|
#endif
|
|
if (pt0 < B) {
|
|
/* this should never happen */
|
|
return TRUE;
|
|
} else if (pt0 == B) {
|
|
while (POP_CHOICE_POINT(B->cp_b))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
B = B->cp_b;
|
|
HB = B->cp_h;
|
|
} else {
|
|
pt0->cp_ap = (yamop *)TRUSTFAILCODE;
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
|
|
static int disj_marker(yamop *apc) {
|
|
op_numbers opnum = Yap_op_from_opcode(apc->opc);
|
|
|
|
return opnum == _or_else || opnum == _or_last;
|
|
}
|
|
|
|
|
|
static Int
|
|
p_cut_up_to_next_disjunction( USES_REGS1 ) {
|
|
choiceptr pt0 = B;
|
|
CELL *qenv = (CELL *)ENV[E_E];
|
|
|
|
while (pt0 &&
|
|
!( qenv == pt0->cp_env && disj_marker(pt0->cp_ap))) {
|
|
pt0 = pt0->cp_b;
|
|
}
|
|
if (!pt0)
|
|
return TRUE;
|
|
#ifdef YAPOR
|
|
CUT_prune_to(pt0);
|
|
#endif /* YAPOR */
|
|
/* find where to cut to */
|
|
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
|
B = pt0;
|
|
#ifdef TABLING
|
|
abolish_incomplete_subgoals(B);
|
|
#endif /* TABLING */
|
|
}
|
|
HB = B->cp_h;
|
|
Yap_TrimTrail();
|
|
return TRUE;
|
|
}
|
|
|
|
bool
|
|
Yap_Reset(yap_reset_t mode)
|
|
{
|
|
CACHE_REGS
|
|
int res = TRUE;
|
|
|
|
if (EX) {
|
|
LOCAL_BallTerm = EX;
|
|
}
|
|
EX = NULL;
|
|
Yap_ResetExceptionTerm( 0 );
|
|
LOCAL_UncaughtThrow = FALSE;
|
|
/* first, backtrack to the root */
|
|
while (B->cp_b) {
|
|
B = B->cp_b;
|
|
}
|
|
// B shoul lead to CP with _ystop0,,
|
|
P = FAILCODE;
|
|
res = Yap_exec_absmi( true, mode );
|
|
/* reinitialise the engine */
|
|
// Yap_InitYaamRegs( worker_id );
|
|
GLOBAL_Initialised = true;
|
|
ENV = LCL0;
|
|
ASP = (CELL *)B;
|
|
/* the first real choice-point will also have AP=FAIL */
|
|
/* always have an empty slots for people to use */
|
|
P = CP = YESCODE;
|
|
// ensure that we have slots where we need them
|
|
Yap_RebootSlots( worker_id );
|
|
return res;
|
|
}
|
|
|
|
|
|
static int is_cleanup_cp(choiceptr cp_b)
|
|
{
|
|
PredEntry *pe;
|
|
|
|
if (cp_b->cp_ap->opc != ORLAST_OPCODE)
|
|
return FALSE;
|
|
#ifdef YAPOR
|
|
pe = cp_b->cp_ap->y_u.Osblp.p0;
|
|
#else
|
|
pe = cp_b->cp_ap->y_u.p.p;
|
|
#endif /* YAPOR */
|
|
/*
|
|
it has to be a cleanup and it has to be a completed goal,
|
|
otherwise the throw will be caught anyway.
|
|
*/
|
|
return pe == PredSafeCallCleanup;
|
|
}
|
|
|
|
static Int
|
|
JumpToEnv(Term t USES_REGS) {
|
|
#ifndef YAPOR
|
|
yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,l),
|
|
*catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,l);
|
|
#else
|
|
yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,Otapl),
|
|
*catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,Otapl);
|
|
#endif
|
|
CELL *env, *env1;
|
|
choiceptr handler, previous = NULL;
|
|
|
|
/* throws cannot interrupt throws */
|
|
if (EX)
|
|
return FALSE;
|
|
/* just keep the throwed object away, we don't need to care about it */
|
|
if (!(LOCAL_BallTerm = Yap_StoreTermInDB(t, 0))) {
|
|
Yap_RestartYap( 1 );
|
|
}
|
|
/* careful, previous step may have caused a stack shift,
|
|
so get pointers here */
|
|
handler = B;
|
|
env1 = ENV;
|
|
do {
|
|
/* find the first choicepoint that may be a catch */
|
|
while (handler &&
|
|
handler->cp_ap != pos) {
|
|
/* we are already doing a catch */
|
|
if (handler->cp_ap == catchpos) {
|
|
P = (yamop *)FAILCODE;
|
|
return TRUE;
|
|
|
|
P = (yamop *)FAILCODE;
|
|
/* make sure failure will be seen at next port */
|
|
if (LOCAL_PrologMode & AsyncIntMode) {
|
|
Yap_signal(YAP_FAIL_SIGNAL);
|
|
}
|
|
HB = B->cp_h;
|
|
return TRUE;
|
|
}
|
|
/* make sure we prune C-choicepoints */
|
|
while (POP_CHOICE_POINT(handler->cp_b))
|
|
{
|
|
POP_EXECUTE();
|
|
}
|
|
handler = handler->cp_b;
|
|
}
|
|
/* uncaught throw */
|
|
if (handler == NULL) {
|
|
LOCAL_UncaughtThrow = TRUE;
|
|
Yap_RestartYap( 1 );
|
|
}
|
|
/* is it a continuation? */
|
|
env = handler->cp_env;
|
|
while (env > env1) {
|
|
env1 = ENV_Parent(env1);
|
|
}
|
|
/* yes, we found it ! */
|
|
// while (env < ENV)
|
|
// env = ENV_Paren t(env);
|
|
if (env == env1) {
|
|
break;
|
|
}
|
|
/* oops, try next */
|
|
handler = handler->cp_b;
|
|
} while (TRUE);
|
|
/* step one environment above, otherwise we'll redo the original goal */
|
|
if (previous == NULL) {
|
|
B = handler;
|
|
} else {
|
|
// EX = t;
|
|
previous->cp_b = handler;
|
|
}
|
|
/* make sure we get rid of trash in the trail */
|
|
handler->cp_cp = (yamop *)env[E_CP];
|
|
handler->cp_env = (CELL *)env[E_E];
|
|
handler->cp_ap = catchpos;
|
|
|
|
/* can recover Heap thanks to copy term :-( */
|
|
/* B->cp_h = H; */
|
|
/* I could backtrack here, but it is easier to leave the unwinding
|
|
to the emulator */
|
|
if (LOCAL_PrologMode & AsyncIntMode) {
|
|
Yap_signal(YAP_FAIL_SIGNAL);
|
|
}
|
|
P = (yamop *)FAILCODE;
|
|
HB = B->cp_h;
|
|
/* try to recover space */
|
|
/* can only do that when we recover space */
|
|
/* first, simulate backtracking */
|
|
/* so that I will execute op_fail */
|
|
return TRUE;
|
|
}
|
|
|
|
Int
|
|
Yap_JumpToEnv(Term t) {
|
|
CACHE_REGS
|
|
if (LOCAL_PrologMode & BootMode) {
|
|
return FALSE;
|
|
}
|
|
return JumpToEnv(t PASS_REGS);
|
|
}
|
|
|
|
|
|
/* This does very nasty stuff!!!!! */
|
|
static Int
|
|
p_jump_env( USES_REGS1 ) {
|
|
return(JumpToEnv(Deref(ARG1) PASS_REGS));
|
|
}
|
|
|
|
/* set up a meta-call based on . context info */
|
|
static Int
|
|
p_generate_pred_info( USES_REGS1 ) {
|
|
ARG1 = ARG3 = ENV[-EnvSizeInCells-1];
|
|
ARG4 = ENV[-EnvSizeInCells-3];
|
|
ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS);
|
|
return TRUE;
|
|
}
|
|
|
|
void
|
|
Yap_InitYaamRegs( int myworker_id )
|
|
{
|
|
Term h0var;
|
|
// getchar();
|
|
#if PUSH_REGS
|
|
/* Guarantee that after a longjmp we go back to the original abstract
|
|
machine registers */
|
|
#ifdef THREADS
|
|
CACHE_REGS
|
|
if (myworker_id) {
|
|
REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
|
|
pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
|
|
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
|
|
REFRESH_CACHE_REGS
|
|
}
|
|
/* may be run by worker_id on behalf on myworker_id */
|
|
#else
|
|
Yap_regp = &Yap_standard_regs;
|
|
#endif
|
|
#endif /* PUSH_REGS */
|
|
Yap_ResetExceptionTerm ( myworker_id );
|
|
Yap_PutValue (AtomBreak, MkIntTerm (0));
|
|
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
|
HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id))+1; // +1: hack to ensure the gc does not try to mark mistakenly
|
|
LCL0 = ASP = (CELL *) REMOTE_LocalBase(myworker_id);
|
|
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id)-MinTrailGap);
|
|
/* notice that an initial choice-point and environment
|
|
*must* be created since for the garbage collector to work */
|
|
B = NULL;
|
|
ENV = NULL;
|
|
P = CP = YESCODE;
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH = RESET_DEPTH();
|
|
#endif
|
|
STATIC_PREDICATES_MARKED = FALSE;
|
|
if (REMOTE_GlobalArena(myworker_id) == 0L ||
|
|
REMOTE_GlobalArena(myworker_id) == TermNil) {
|
|
} else {
|
|
HR = RepAppl(REMOTE_GlobalArena(myworker_id));
|
|
}
|
|
REMOTE_GlobalArena(myworker_id) = TermNil;
|
|
Yap_AllocateDefaultArena(128*1024, 2, myworker_id);
|
|
Yap_InitPreAllocCodeSpace( myworker_id );
|
|
#ifdef FROZEN_STACKS
|
|
H_FZ = HR;
|
|
#ifdef YAPOR_SBA
|
|
BSEG =
|
|
#endif /* YAPOR_SBA */
|
|
BBREG = B_FZ = (choiceptr) REMOTE_LocalBase(myworker_id);
|
|
TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(myworker_id);
|
|
#endif /* FROZEN_STACKS */
|
|
CalculateStackGap( PASS_REGS1 );
|
|
/* the first real choice-point will also have AP=FAIL */
|
|
/* always have an empty slots for people to use */
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
LOCAL = REMOTE(myworker_id);
|
|
worker_id = myworker_id;
|
|
#endif /* THREADS */
|
|
#if COROUTINING
|
|
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
|
|
h0var = MkVarTerm();
|
|
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
|
|
#endif
|
|
Yap_RebootSlots( myworker_id );
|
|
h0var = MkVarTerm();
|
|
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
|
|
REMOTE_GcCurrentPhase(myworker_id) = 0L;
|
|
REMOTE_GcPhase(myworker_id) = Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
PP = NULL;
|
|
PREG_ADDR = NULL;
|
|
#endif
|
|
cut_c_initialize( myworker_id );
|
|
Yap_PrepGoal(0, NULL, NULL PASS_REGS);
|
|
#ifdef TABLING
|
|
/* ensure that LOCAL_top_dep_fr is always valid */
|
|
if (REMOTE_top_dep_fr(myworker_id))
|
|
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
|
|
#endif
|
|
}
|
|
|
|
static Int
|
|
p_uncaught_throw( USES_REGS1 )
|
|
{
|
|
Int out = LOCAL_UncaughtThrow;
|
|
LOCAL_UncaughtThrow = FALSE; /* just caught it */
|
|
return out;
|
|
}
|
|
|
|
Term
|
|
Yap_GetException(void)
|
|
{
|
|
CACHE_REGS
|
|
Term t = 0L;
|
|
if (LOCAL_BallTerm) {
|
|
do {
|
|
t = Yap_PopTermFromDB(LOCAL_BallTerm);
|
|
if (t == 0) {
|
|
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
if (!Yap_growglobal(NULL)) {
|
|
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage);
|
|
return FALSE;
|
|
}
|
|
} else {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
if (!Yap_growstack(LOCAL_BallTerm->NOfCells*CellSize)) {
|
|
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
|
|
return FALSE;
|
|
}
|
|
}
|
|
}
|
|
} while (t == 0);
|
|
LOCAL_BallTerm = NULL;
|
|
}
|
|
return t;
|
|
}
|
|
|
|
static Int
|
|
p_reset_exception( USES_REGS1 )
|
|
{
|
|
Term t;
|
|
EX = NULL;
|
|
t = Yap_GetException();
|
|
if (!t)
|
|
return FALSE;
|
|
return Yap_unify(t, ARG1);
|
|
}
|
|
|
|
void
|
|
Yap_ResetExceptionTerm(int wid)
|
|
{
|
|
Yap_ReleaseTermFromDB(REMOTE_BallTerm(wid));
|
|
REMOTE_BallTerm(wid) = NULL;
|
|
}
|
|
|
|
static Int
|
|
p_get_exception( USES_REGS1 )
|
|
{
|
|
Term t = Yap_GetException();
|
|
if (!t)
|
|
return FALSE;
|
|
return Yap_unify(t, ARG1);
|
|
}
|
|
|
|
|
|
int
|
|
Yap_dogc( int extra_args, Term *tp USES_REGS )
|
|
{
|
|
UInt arity;
|
|
yamop *nextpc;
|
|
int i;
|
|
|
|
if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
|
arity = PREVOP(P,Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
|
nextpc = P;
|
|
} else {
|
|
arity = 0;
|
|
nextpc = CP;
|
|
}
|
|
for (i=0; i < extra_args; i++) {
|
|
XREGS[arity+i+1] = tp[i];
|
|
}
|
|
if (!Yap_gc(arity+extra_args, ENV, nextpc)) {
|
|
return FALSE;
|
|
}
|
|
for (i=0; i < extra_args; i++) {
|
|
tp[i] = XREGS[arity+i+1];
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
void
|
|
Yap_InitExecFs(void)
|
|
{
|
|
CACHE_REGS
|
|
Term cm = CurrentModule;
|
|
Yap_InitComma();
|
|
Yap_InitCPred("$execute", 1, p_execute, 0);
|
|
Yap_InitCPred("$execute", 2, p_execute2, 0);
|
|
Yap_InitCPred("$execute", 3, p_execute3, 0);
|
|
Yap_InitCPred("$execute", 4, p_execute4, 0);
|
|
Yap_InitCPred("$execute", 5, p_execute5, 0);
|
|
Yap_InitCPred("$execute", 6, p_execute6, 0);
|
|
Yap_InitCPred("$execute", 7, p_execute7, 0);
|
|
Yap_InitCPred("$execute", 8, p_execute8, 0);
|
|
Yap_InitCPred("$execute", 9, p_execute9, 0);
|
|
Yap_InitCPred("$execute", 10, p_execute10, 0);
|
|
Yap_InitCPred("$execute", 11, p_execute11, 0);
|
|
Yap_InitCPred("$execute", 12, p_execute12, 0);
|
|
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
|
|
Yap_InitCPred("$execute_wo_mod", 2, p_execute_in_mod, 0);
|
|
Yap_InitCPred("call_with_args", 1, p_execute_0, 0);
|
|
Yap_InitCPred("call_with_args", 2, p_execute_1, 0);
|
|
Yap_InitCPred("call_with_args", 3, p_execute_2, 0);
|
|
Yap_InitCPred("call_with_args", 4, p_execute_3, 0);
|
|
Yap_InitCPred("call_with_args", 5, p_execute_4, 0);
|
|
Yap_InitCPred("call_with_args", 6, p_execute_5, 0);
|
|
Yap_InitCPred("call_with_args", 7, p_execute_6, 0);
|
|
Yap_InitCPred("call_with_args", 8, p_execute_7, 0);
|
|
Yap_InitCPred("call_with_args", 9, p_execute_8, 0);
|
|
Yap_InitCPred("call_with_args", 10, p_execute_9, 0);
|
|
Yap_InitCPred("call_with_args", 11, p_execute_10, 0);
|
|
#ifdef DEPTH_LIMIT
|
|
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
|
|
#endif
|
|
Yap_InitCPred("$execute0", 2, p_execute0, NoTracePredFlag);
|
|
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop,NoTracePredFlag );
|
|
Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0);
|
|
Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0);
|
|
Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0);
|
|
CurrentModule = HACKS_MODULE;
|
|
Yap_InitCPred("current_choice_point", 1, p_save_cp, 0);
|
|
Yap_InitCPred("current_choicepoint", 1, p_save_cp, 0);
|
|
Yap_InitCPred("env_choice_point", 1, p_save_env_b, 0);
|
|
Yap_InitCPred("trail_suspension_marker", 1, p_trail_suspension_marker, 0);
|
|
Yap_InitCPred("cut_at", 1, p_clean_ifcp, SafePredFlag);
|
|
CurrentModule = cm;
|
|
Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag);
|
|
Yap_InitCPred("$restore_regs", 1, p_restore_regs, NoTracePredFlag|SafePredFlag);
|
|
Yap_InitCPred("$restore_regs", 2, p_restore_regs2, NoTracePredFlag|SafePredFlag);
|
|
Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
|
|
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, p_cut_up_to_next_disjunction, SafePredFlag);
|
|
Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0);
|
|
Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0);
|
|
Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0);
|
|
Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0);
|
|
Yap_InitCPred("$do_goal_expansion", 3, p_do_goal_expansion, 0);
|
|
Yap_InitCPred("$do_term_expansion", 2, p_do_term_expansion, 0);
|
|
Yap_InitCPred("$get_exception", 1, p_get_exception, 0);
|
|
}
|
|
|
|
|