diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
a87654b0b0
yap-6.3/C/exec.c
Vitor Santos Costa 71fc7238ff exec
2019-04-22 12:18:22 +01:00

2426 lines
68 KiB
C
Executable File
Raw Blame History

/*************************************************************************
* *
* 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
/**
* @file exec.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Mon Apr 30 13:48:35 2018
*
* @brief meta-call
*
* @namespace prolog
*
*
*
*/
#include "absmi.h"
#include "attvar.h"
#include "cut_c.h"
#include "yapio.h"
static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE);
// must hold thread worker comm lock at call.
static bool EnterCreepMode(Term, Term CACHE_TYPE);
static Int current_choice_point(USES_REGS1);
static Int execute(USES_REGS1);
static Int 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));
}
/**
* Represents a choice-point as an offset to the top of local stack. This should
* *be stable acroos gc or stack shifts.
* @param cp pointer to choice-point
* @return Term with offset
*/
Term Yap_cp_as_integer(choiceptr cp) {
CACHE_REGS
return cp_as_integer(cp PASS_REGS);
}
/**
* Sets up the engine to run a different predicate.
* @method CallPredicate
* @param pen the new code
* @param cut_pt cut boundary
* @param USES_REGS thread support
* @return success
*/
static inline bool 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) {
// YENV[E_CP] = CP;
// YENV[E_E] = ENV;
//#ifdef DEPTH_LIMIT
// YENV[E_DEPTH] = DEPTH;
//#endif
// ENV = YENV;
ENV = YENV;
YENV = ASP;
CP = P;
}
/* make sure we have access to the user given cut */
YENV[E_CB] = (CELL)cut_pt;
P = code;
return true;
}
/**
* calls a meta-predicate or anything weird
* @method CallMetaCall
* @param t the called goal
* @param USES_REGS MT
* @return did we fiid it?
*/
inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
// we have a creep requesr waiting
if (IsVarTerm(t))
Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call");
if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call");
ARG1 = t;
ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ARG3 = t;
if (mod) {
ARG4 = mod;
} else {
ARG4 = TermProlog;
}
if (Yap_GetGlobal(AtomDebugMeta) == TermOn) {
return CallPredicate(PredTraceMetaCall, B,
PredTraceMetaCall->CodeOfPred PASS_REGS);
} else {
return CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred PASS_REGS);
}
}
/**
* Transfer control to a meta-call in ARG1, cut up to B.
*
* @param g goal
* @param mod curre1nt module
* @return su
*/
Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
CACHE_REGS
Term ts[4];
if (IsVarTerm(g))
Yap_ThrowError(INSTANTIATION_ERROR, g, "meta-call");
if (IsIntTerm(g) || (IsApplTerm(g) && IsExtensionFunctor(FunctorOfTerm(g))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(g, mod), "meta-call");
ts[0] = g;
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ts[2] = g;
ts[3] = mod;
if (Yap_GetGlobal(AtomDebugMeta) == TermOn) {
return Yap_MkApplTerm(PredTraceMetaCall->FunctorOfPred, 3, ts);
}
return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts);
}
Term Yap_TermToIndicator(Term t, Term mod) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
t = Yap_YapStripModule(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 {
return t;
}
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
}
return t;
}
Term Yap_PredicateToIndicator(PredEntry *pe) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
if (pe->ArityOfPE) {
ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred));
} else {
ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred));
ti[1] = MkIntTerm(0);
}
Term t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Term mod = pe->ModuleOfPred;
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
}
return t;
}
static bool 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_YapStripModule(t, &mod);
}
Yap_ThrowError(err, t, "call/1");
return false;
}
}
/** @pred current_choice_point( -CP )
*
* unify the logic variable _CP_ with a number that identifies the
* last alternative taken, or current choice-point. This number is
* only valid as long as we do not backtrack by or cut _CP_, and is
* safe in the presence of stack shifting and/or garbage collection.
*/
static Int current_choice_point(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;
}
/** @pred parent_choice_point( +CP, -PCP )
*
* given that _CP_ identifies an
* alternative taken, or choice-point, _PCP_ identifies its parent.
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "child choicr-point missing");
}
choiceptr cp = cp_from_integer(t);
if (cp == NULL || cp->cp_b == NULL)
return false;
td = cp_as_integer(cp->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return TRUE;
}
/** @pred parent_choice_point( -PB )
*
* PB is a number identifying the parent of the current choice-point.
* It storing the offset of the current ch
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point1(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (B == NULL || B->cp_b == NULL)
return false;
td = cp_as_integer(B->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return true;
}
static Int 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;
}
/** Look for a predicate with same functor as t,
create a new one of it cannot find it.
*/
static PredEntry *new_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
return RepPredProp(PredPropByFunc(fun, tmod));
} else
return NULL;
}
static bool CommaCall(Term t, Term mod) {
PredEntry *pen;
arity_t i;
if (IsVarTerm(t) || (pen = new_pred(t, mod, "_,_")))
return false;
for (i = 0; i < pen->ArityOfPE; i++) {
YENV[-EnvSizeInCells - i] = XREGS[i + 1];
}
YENV[E_CB] = (CELL)B;
YENV[E_CP] = (CELL)P;
YENV[E_E] = (CELL)ENV;
YENV[E_DEPTH] = DEPTH;
ASP = YENV - (EnvSizeInCells + i);
ENV = YENV;
YENV = ASP;
if ((P = pen->MetaEntryOfPred) == NULL) {
P = Yap_InitCommaContinuation(pen);
}
return P == NULL;
}
inline static bool do_execute(Term t, Term mod USES_REGS) {
Term t0 = t, mod0 = mod;
t = Yap_YapStripModule(t, &mod);
/* first do predicate expansion, even before you process signals.
This way you don't get to spy goal_expansion(). */
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled &&
!(LOCAL_PrologMode & (AbortMode | InterruptMode | SystemMode))) {
return EnterCreepMode(t, mod PASS_REGS);
}
if (IsVarTerm(t) || IsVarTerm(mod)) {
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
}
if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register CELL *pt;
PredEntry *pen;
unsigned int i, arity;
f = FunctorOfTerm(t);
if (f == FunctorComma && false) {
Term t2 = ArgOfTerm(2, t);
if (IsVarTerm(t2))
return CallMetaCall(t0, mod0 PASS_REGS);
if (1 || !CommaCall(t2, mod))
return CallMetaCall(t0, mod0 PASS_REGS);
Term t1 = ArgOfTerm(1, t);
t = t1;
pen = new_pred(t, mod, "_,_");
if (pen == NULL || (arity = pen->ArityOfPE) == 0) {
return do_execute(t, mod);
}
} else if (IsExtensionFunctor(f)) {
return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS);
}
arity = ArityOfFunctor(f);
if (arity > MaxTemps) {
return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS);
}
pen = RepPredProp(PredPropByFunc(f, mod));
/* You thought we would be over by now */
/* but no meta calls require special preprocessing */
/* 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 */
if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) {
return CallMetaCall(t0, mod0 PASS_REGS);
}
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);
}
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));
}
return CallMetaCall(t0, mod0 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 bool 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, mod0 = mod;
restart_exec:
if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
} else if (IsAtomTerm(t)) {
arity = n;
Name = AtomOfTerm(t);
pt = NULL;
} else if (IsIntTerm(t)) {
return CallError(TYPE_ERROR_CALLABLE, t, mod0 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, mod0 PASS_REGS);
} else {
return CallError(TYPE_ERROR_ATOM, t0, mod0 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, t0, mod0 PASS_REGS);
}
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, t0, mod0 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 & (MetaPredFlag | UndefPredFlag)) {
// Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
// return (CallMetaCall(t0, mod0 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 bool 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_ThrowError(RESOURCE_ERROR_HEAP, 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 execute(USES_REGS1) { /* '$execute'(Goal) */
Term t = Deref(ARG1);
return do_execute(t, CurrentModule PASS_REGS);
}
bool Yap_Execute(Term t USES_REGS) { /* '$execute'(Goal) */
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 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 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 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 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 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 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 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 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 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 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 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 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_ThrowError(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 execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */
return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS);
}
/**
* remove choice points created since a call to top-goal.
*
* @method prune_inner_computation
*/
static void prune_inner_computation(choiceptr parent, YAP_dogoalinfo *gi) {
/* code */
choiceptr cut_pt;
cut_pt = B;
while (cut_pt && cut_pt->cp_b
&& cut_pt->cp_ap != NOCODE &&
cut_pt->cp_b <= parent) {
cut_pt = cut_pt->cp_b;
}
if (!cut_pt)
return;
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif
B = cut_pt;
Yap_TrimTrail();
LOCAL_AllowRestart = FALSE;
P = gi->p;
CP = gi->cp;
ENV = LCL0-gi->e;
B = parent;
}
/**
* restore abstract machine state
* after completing a computation.
* @method complete_inner_computation
*/
static void complete_inner_computation(choiceptr old_B, YAP_dogoalinfo *gi) {
choiceptr myB = B;
if (myB == NULL) {
return;
} else if (myB->cp_b == old_B) {
B = old_B;
#ifdef DEPTH_LIMIT
DEPTH = myB->cp_depth;
#endif
} else if (myB->cp_b && myB->cp_b < old_B) {
while (myB->cp_b < old_B) {
// we're recovering from a non-deterministic computation...
myB = myB->cp_b;
}
} else {
return;
}
// restore environment at call...
CP = gi->cp;
P = gi->p;
ENV = LCL0-gi->e;
YENV = LCL0-gi->y;
}
static Int Yap_ignore(Term t, bool fail USES_REGS) {
YAP_dogoalinfo gi;
Yap_push_state(&gi);
yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t));
bool newxp = Yap_pushErrorContext(true, ctx);
bool rc = Yap_RunTopGoal(t, &gi, false);
choiceptr B0 = (choiceptr)(LCL0-gi.b_top);
if (!rc) {
complete_inner_computation(B0, &gi);
// We'll pass it through
} else {
prune_inner_computation(B0, &gi);
}
Yap_popErrorContext(newxp, true);
P = gi.p;
CP = gi.cp;
//YENV?
return true;
}
extern void *Yap_blob_info(Term t);
static bool set_watch(Int Bv, Term task) {
CELL *pt;
Term t = Yap_AllocExternalDataInStack((CELL)setup_call_catcher_cleanup_tag,
sizeof(Int), &pt);
if (t == TermNil)
return false;
*pt = Bv;
*HR++ = t;
*HR++ = task;
TrailTerm(TR) = AbsPair(HR - 2);
TR++;
return true;
}
static bool watch_cut(Term ext USES_REGS) {
// called after backtracking..
//
Term task = TailOfTerm(ext);
Term cleanup = ArgOfTerm(3, task);
Term e = 0;
bool complete = IsNonVarTerm(Deref(ArgOfTerm(4, task)));
bool active = ArgOfTerm(5, task) == TermTrue;
bool ex_mode = false;
if (complete) {
return true;
}
CELL *port_pt = deref_ptr(RepAppl(task) + 2);
CELL *completion_pt = deref_ptr(RepAppl(task) + 4);
if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
e = MkErrorTerm(LOCAL_ActiveError);
Term t;
if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
} else {
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
}
port_pt[0] = t;
completion_pt[0] = TermException;
} else {
completion_pt[0] = port_pt[0] = TermCut;
}
Yap_ignore(cleanup, false);
CELL *complete_pt = deref_ptr(RepAppl(task) + 4);
complete_pt[0] = TermTrue;
if (ex_mode) {
// Yap_PutException(e);
return true;
}
if (Yap_RaiseException())
return false;
return true;
}
/**
* external backtrack to current stack frame: call method
* and control backtracking.
*
* @method protect_stack_from_restore
* @param USES_REGS1 [env for threaded execution]
* @return c
*/
static bool watch_retry(Term d0 USES_REGS) {
// called after backtracking..
//
Term task = TailOfTerm(d0);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
bool complete = !IsVarTerm(ArgOfTerm(4, task));
bool active = ArgOfTerm(5, task) == TermTrue;
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task)));
if (complete)
return true;
CELL *port_pt = deref_ptr(RepAppl(Deref(task)) + 2);
CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
Term t, e = 0;
bool ex_mode = false;
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
// just do the frrpest
if (B >= B0 && !ex_mode && !active)
return true;
if (LOCAL_ActiveError && LOCAL_ActiveError->errorNo != YAP_NO_ERROR) {
e = MkErrorTerm(LOCAL_ActiveError);
if (active) {
t = Yap_MkApplTerm(FunctorException, 1, &e);
} else {
t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
}
complete_pt[0] = TermException;
} else if (B >= B0) {
t = TermFail;
complete_pt[0] = t;
} else if (box) {
t = TermRedo;
} else {
return true;
}
port_pt[0] = t;
Yap_ignore(cleanup, true);
if (ex_mode) {
// Yap_PutException(e);
return true;
}
if (Yap_RaiseException())
return false;
return true;
}
/**
* First call to non deterministic predicate. Just leaves a choice-point
* hanging about for the future.
*
* @method protect_stack
* @param USES_REGS1 [env for threaded execution]
* @return [always succeed]
*/
static Int setup_call_catcher_cleanup(USES_REGS1) {
Term Setup = Deref(ARG1);
YAP_dogoalinfo gi;
gi.p = P;
gi.cp = CP;
gi.b_top = LCL0-CellPtr(B);
gi.CurSlot = Yap_CurrentHandle();
gi.y = LCL0-YENV;
gi.e = LCL0-ENV;
bool rc;
Yap_DisableInterrupts(worker_id);
rc = Yap_RunTopGoal(Setup, &gi, false);
Yap_EnableInterrupts(worker_id);
if (Yap_RaiseException()) {
return false;
}
choiceptr B0=(choiceptr)(LCL0-gi.b_top);
if (!rc) {
complete_inner_computation(B0, &gi);
// We'll pass it throughs
return false;
} else {
prune_inner_computation(B0, &gi);
}
YENV = LCL0-gi.y;
ENV = LCL0-gi.e;
B = (choiceptr)(LCL0-gi.b_top);
SET_ASP(YENV, E_CB * sizeof(CELL));
#ifdef DEPTH_LIMIT
DEPTH = ENV[E_DEPTH];
#endif
P = gi.p;
CP = gi.cp;
return rc;
}
static Int tag_cleanup(USES_REGS1) {
Int iB = LCL0 - (CELL *)B;
set_watch(iB, Deref(ARG2));
return Yap_unify(ARG1, MkIntegerTerm(iB));
}
static Int cleanup_on_exit(USES_REGS1) {
choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
Term complete = IsNonVarTerm(ArgOfTerm(4, task));
while (B->cp_ap->opc == FAIL_OPCODE)
B = B->cp_b;
if (complete) {
return true;
}
CELL *catcher_pt = deref_ptr(RepAppl(Deref(task)) + 2);
CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
if (B < B0) {
// non-deterministic
set_watch(LCL0 - (CELL *)B, task);
if (!box) {
return true;
}
catcher_pt[0] = TermAnswer;
} else {
catcher_pt[0] = TermExit;
complete_pt[0] = TermExit;
}
Yap_ignore(cleanup, false);
if (B0->cp_ap == NOCODE)
B0->cp_ap = TRUSTFAILCODE;
if (Yap_RaiseException()) {
return false;
}
return true;
}
static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) {
CACHE_REGS
if (creeping) {
Yap_signal(YAP_CREEP_SIGNAL);
}
CurrentModule = omod;
Yap_CloseSlots(sl);
if (out) {
}
return out;
}
static Int _user_expand_goal(USES_REGS1) {
yhandle_t sl = Yap_StartSlots();
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
Term cmod = CurrentModule, omod = cmod;
Term mg_args[2];
Term g = Yap_YapStripModule(ARG1, &cmod);
yhandle_t h1 = Yap_InitSlot(g), h2 = Yap_InitSlot(ARG2);
/* CurMod:goal_expansion(A,B) */
ARG1 = g;
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true , omod, sl, creeping);
}
/* system:goal_expansion(A,B) */
mg_args[0] = cmod;
mg_args[1] = Yap_GetFromSlot(h1);
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2);
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
ARG1 = Yap_GetFromSlot(h1);
ARG2 = cmod;
ARG3 = Yap_GetFromSlot(h2);
/* 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, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
mg_args[0] = cmod;
mg_args[1] = Yap_GetFromSlot(h1);
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2);
/* 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, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
return complete_ge(false, omod, sl, creeping);
}
static Int do_term_expansion(USES_REGS1) {
yhandle_t sl = Yap_StartSlots();
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
Term cmod = CurrentModule, omod = cmod;
Term mg_args[2];
Term g = Yap_YapStripModule(ARG1, &cmod);
yhandle_t h1 = Yap_InitSlot(g), h2 = Yap_InitSlot(ARG2);
/* user:term_expansion(A,B) */
ARG1 = g;
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
/* CurMod:term_expansion(A,B) */
ARG1 = g;
if (cmod != USER_MODULE &&
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
/* system:term_expansion(A,B) */
mg_args[0] = cmod;
mg_args[1] = Yap_GetFromSlot(h1);
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
ARG2 = Yap_GetFromSlot(h2);
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
return complete_ge(false, omod, sl, creeping);
}
static Int 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);
}
t = Yap_YapStripModule(t, &mod);
restart_exec:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult, 2, ts);
goto restart_exec;
} 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);ffprintf(stderr, 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_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
//return false;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */
return CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->CodeOfPred PASS_REGS);
}
static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
*/
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
unsigned int arity;
Prop pe;
bool rc;
t = Yap_YapStripModule(t, &mod);
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_ThrowError(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);
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 CallMetaCall(t, mod);
}
/* 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
rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
} else {
rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->CodeOfPred PASS_REGS);
}
if (!LOCAL_InterruptsDisabled &&
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag | CPredFlag)) ||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return rc;
}
/**
* @brief Two argument version of non-interruptible execution: this will
* ignore signals including debugging requests.
*
* @return Int succeeds if it can transfer control.
*/
static Int execute_nonstop(USES_REGS1) {
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
unsigned int arity;
Prop pe;
t = Yap_YapStripModule(t, &mod);
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_ThrowError(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);
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_ThrowError(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);
}
}
/**
* @brief One argument version of non-interruptible execution: this will
* ignore signals including debugging requests.
*
* @return Int succeeds if it can transfer control.
*/
static Int execute_nonstop1(USES_REGS1) {
ARG2 = CurrentModule;
return execute_nonstop(PASS_REGS1);
}
static Int execute_0(USES_REGS1) { /* '$execute_0'(Goal) */
Term mod = CurrentModule;
Term t = Yap_YapStripModule(Deref(ARG1), &mod);
if (t == 0)
return false;
return do_execute(t, mod PASS_REGS);
}
static bool call_with_args(int i USES_REGS) {
Term mod = CurrentModule, t;
int j;
t = Yap_YapStripModule(Deref(ARG1), &mod);
if (t == 0)
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 execute_1(USES_REGS1) { /* '$execute_0'(Goal) */
return call_with_args(1 PASS_REGS);
}
static Int execute_2(USES_REGS1) { /* '$execute_2'(Goal) */
return call_with_args(2 PASS_REGS);
}
static Int execute_3(USES_REGS1) { /* '$execute_3'(Goal) */
return call_with_args(3 PASS_REGS);
}
static Int execute_4(USES_REGS1) { /* '$execute_4'(Goal) */
return call_with_args(4 PASS_REGS);
}
static Int execute_5(USES_REGS1) { /* '$execute_5'(Goal) */
return call_with_args(5 PASS_REGS);
}
static Int execute_6(USES_REGS1) { /* '$execute_6'(Goal) */
return call_with_args(6 PASS_REGS);
}
static Int execute_7(USES_REGS1) { /* '$execute_7'(Goal) */
return call_with_args(7 PASS_REGS);
}
static Int execute_8(USES_REGS1) { /* '$execute_8'(Goal) */
return call_with_args(8 PASS_REGS);
}
static Int execute_9(USES_REGS1) { /* '$execute_9'(Goal) */
return call_with_args(9 PASS_REGS);
}
static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
return call_with_args(10 PASS_REGS);
}
#ifdef DEPTH_LIMIT
static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
Yap_ThrowError(INSTANTIATION_ERROR, d, "depth_bound_call/2");
return false;
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH();
} else {
Yap_ThrowError(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return false;
}
} else {
DEPTH = MkIntTerm(IntegerOfTerm(d) * 2);
}
return execute(PASS_REGS1);
}
#endif
static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
int lval = 0, out;
Int OldBorder = LOCAL_CBorder;
// yap_error_descriptor_t *err_info= LOCAL_ActiveError;
LOCAL_CBorder = LCL0 - ENV;
LOCAL_MallocDepth = AllocLevel();
yhandle_t sls = Yap_CurrentSlot();
sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
LOCAL_RestartEnv = &signew;
volatile int i = AllocLevel();
if /* top &&*/ ((lval = sigsetjmp(signew, 1)) != 0) {
switch (lval) {
case 1: { /* restart */
/* otherwise, SetDBForThrow will fail entering critical mode */
// LOCAL_ActiveError = err_info;
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
/* 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;
Yap_CloseSlots(sls);
P = (yamop *)FAILCODE;
} break;
case 2: {
// LOCAL_ActiveError = err_info;
/* arithmetic exception */
/* must be done here, otherwise siglongjmp will clobber all the
* registers
*/
/* reset the registers so that we don't have trash in abstract
* machine */
pop_text_stack(i + 1);
Yap_set_fpu_exceptions(
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
Yap_CloseSlots(sls);
} break;
case 3: { /* saved state */
// LOCAL_ActiveError = err_info;
pop_text_stack(i + 1);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
Yap_CloseSlots(sls);
return false;
}
case 4:
/* abort */
/* can be called from anywhere, must reset registers,
*/
// LOCAL_ActiveError = err_info;
while (B) {
LOCAL_ActiveError->errorNo = ABORT_EVENT;
pop_text_stack(i + 1);
Yap_CloseSlots(sls);
Yap_JumpToEnv();
}
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
P = (yamop *)FAILCODE;
LOCAL_RestartEnv = sighold;
Yap_CloseSlots(sls);
pop_text_stack(i + 1);
return false;
break;
case 5:
// going up, unless there is no up to go to. or someone
// but we should inform the caller on what happened.
// Yap_regp = old_rs;
// LOCAL_ActiveError = err_info;
restore_TR();
restore_B();
/* H is not so important, because we're gonna backtrack */
restore_H();
/* set stack */
Yap_JumpToEnv();
Yap_CloseTemporaryStreams();
Yap_CloseSlots(sls);
ASP = (CELL *)PROTECT_FROZEN_B(B);
if (B == NULL || B->cp_b == NULL ||
(CELL *)(B->cp_b) >= LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder;
pop_text_stack(i + 1);
return false;
}
P = FAILCODE;
}
}
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);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
pop_text_stack(i + 1);
return out;
}
void Yap_PrepGoal(arity_t arity, CELL *pt, YAP_dogoalinfo *gip USES_REGS) {
/* create an initial pseudo environment so that when garbage
collection is going up in the environment chain it doesn't ge t
confused */
Yap_ResetException(worker_id);
// sl = Yap_InitSlot(t);
YENV = ASP;
YENV[E_CP] = (CELL)CP;
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 < 3; i++) {
XREGS[i + 1] = *pt++;
}
}
choiceptr oB = B;
B = (choiceptr)ASP;
B--;
B->cp_h = HR;
B->cp_tr = TR;
B->cp_cp = YESCODE;
B->cp_ap = NOCODE;
B->cp_env = ENV;
B->cp_b = oB;
#ifdef DEPTH_LIMIT
B->cp_depth = DEPTH;
#endif /* DEPTH_LIMIT */
ASP = (CELL *)B;
ASP[E_CB] = (CELL)B;
HB = HR;
CP = YESCODE;
ASP -= EnvSizeInCells;
gip->b_bottom = LCL0-CellPtr(B);
}
static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, YAP_dogoalinfo *gi, bool top USES_REGS) {
bool out;
Yap_PrepGoal(arity, pt, gi PASS_REGS);
// CACHE_A1();
P = (yamop *)CodeAdr;
// S = CellPtr(RepPredProp(
// PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */
out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS);
// if (out) {
// out = Yap_GetFromSlot(sl);
// }
// Yap_RecoverSlots(1);
LOCAL_PrologMode &= ~TopGoalMode;
return out;
}
bool Yap_exec_absmi(bool top, yap_reset_t has_reset) {
CACHE_REGS
return exec_absmi(top, has_reset PASS_REGS);
}
/**
* Fails computation up to choice-point bb
*
* @param USES_REGS thread support
*/
void Yap_fail_all(choiceptr bb USES_REGS) {
yamop *saved_p, *saved_cp;
saved_p = P;
saved_cp = CP;
/* prune away choicepoints */
if (B == bb)
return;
while (B->cp_b && B->cp_b != bb && B->cp_ap != NOCODE) {
B = B->cp_b;
#ifdef YAPOR
CUT_prune_to(B);
#endif
}
P = FAILCODE;
exec_absmi(true, YAP_EXEC_ABSMI PASS_REGS);
/* 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]);
if (B->cp_b) {
B = B->cp_b;
}
// SET_BB(B);
HB = PROTECT_FROZEN_H(B);
CP = saved_cp;
P = saved_p;
}
bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
yamop *CodeAdr;
bool out;
YAP_dogoalinfo gi;
gi.p = P;
gi.cp = CP;
gi.b_top = LCL0-CellPtr(B);
gi.CurSlot = Yap_CurrentHandle();
gi.y = LCL0-YENV;
gi.e = LCL0-ENV;
LOCAL_PrologMode |= TopGoalMode;
PELOCK(81, ppe);
CodeAdr = ppe->CodeOfPred;
UNLOCK(ppe->PELock);
out = do_goal(CodeAdr, ppe->ArityOfPE, pt, &gi, false PASS_REGS);
if (out) {
choiceptr cut_B;
/* we succeeded, let's prune */
/* restore the old environment */
/* get to previous environment */
cut_B = (choiceptr)ENV[E_CB];
#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 = (choiceptr)(LCL0-gi.b_top);
CP = gi.cp;
P = gi.p;
#ifdef DEPTH_LIMIT
DEPTH = ENV[E_DEPTH];
#endif
ENV = LCL0-gi.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 ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
return false;
}
return true;
} else if (out == 0) {
P = gi.p;
CP = gi.cp;
HR = B->cp_h;
#ifdef DEPTH_LIMIT
DEPTH = B->cp_depth;
#endif
/* YENV should be set to the current environment */
YENV = ENV = LCL0-gi.e;
/* ASP should be set to the top of the local stack when we
did the call */
SET_ASP(YENV, E_CB * sizeof(CELL));
B =(choiceptr)(LCL0-gi.b_top);
SET_BB(B);
HB = PROTECT_FROZEN_H(B);
// should we catch the exception or pass it through?
// We'll pass it through
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
}
return false;
} else {
Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
return false;
}
}
bool 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_ThrowError(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_ThrowError(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, YAP_dogoalinfo *gip, bool handle_errors) {
CACHE_REGS
yamop *CodeAdr;
Prop pe;
PredEntry *ppe;
CELL *pt;
UInt arity;
Term tmod = CurrentModule;
Term goal_out = 0;
LOCAL_PrologMode |= TopGoalMode;
t = Yap_YapStripModule(t, &tmod);
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult, 2, ts);
}
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pt = NULL;
pe = Yap_GetPredPropByAtom(a, tmod);
arity = 0;
} else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pe = Yap_GetPredPropByFunc(f, tmod);
pt = RepAppl(t) + 1;
arity = ArityOfFunctor(f);
} else {
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
ppe = RepPredProp(pe);
if (pe == NIL || ppe->cs.p_code.TrueCodeOfPred->opc == UNDEF_OPCODE) {
pe = AbsPredProp(ppe = UndefCode);
pt = HR;
HR[0] = MkPairTerm(tmod, t);
HR[1] = MkAtomTerm(Yap_LookupAtom("top"));
arity = 2;
HR += 2;
} else if (ppe->PredFlags & (MetaPredFlag | UndefPredFlag)) {
// we're in a meta-call, rake care about modules
//
Term ts[2];
ts[0] = tmod;
ts[1] = t;
Functor f = Yap_MkFunctor(Yap_LookupAtom("call"), 1);
pt = &t;
t = Yap_MkApplTerm(FunctorModule, 2, ts);
pe = Yap_GetPredPropByFunc(f, tmod);
ppe = RepPredProp(pe);
arity = 1;
}
PELOCK(82, ppe);
CodeAdr = ppe->CodeOfPred;
UNLOCK(ppe->PELock);
#if !USE_SYSTEM_MALLOC
if (LOCAL_TrailTop - HeapTop < 2048) {
Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
"unable to boot because of too little Trail space");
}
#endif
goal_out = do_goal(CodeAdr, arity, pt, gip, handle_errors PASS_REGS);
return goal_out;
}
static void do_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 restore_regs(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
if (IsAtomTerm(t))
return (TRUE);
do_restore_regs(t, FALSE PASS_REGS);
return (TRUE);
}
/* low level voodoo to cut and then restore temporary registers after
* a
* call */
static Int restore_regs2(USES_REGS1) {
Term t = Deref(ARG1), d0;
choiceptr pt0;
Int d;
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
d0 = Deref(ARG2);
if (!IsAtomTerm(t)) {
do_restore_regs(t, TRUE PASS_REGS);
}
if (IsVarTerm(d0)) {
Yap_ThrowError(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 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 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;
}
/**
* Reset the Prolog engine . If _Hard_ resèt the global stack_el. If
* p_no_use_'soft_float keei
*
* @param mode
* @param hard
*
* @return
*/
bool Yap_Reset(yap_reset_t mode, bool hard) {
CACHE_REGS
int res = TRUE;
Yap_ResetException(worker_id);
/* first, backtrack to the root */
while (B->cp_b) {
if (B->cp_ap == NOCODE)
break;
B = B->cp_b;
}
P = FAILCODE;
Yap_exec_absmi(true, mode);
/* reinitialize the engine */
Yap_InitYaamRegs(worker_id, false);
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;
}
bool 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(USES_REGS1) {
choiceptr handler = B;
/* just keep the throwm object away, we don't need to care about it
*/
/* careful, previous step may have caused a stack shift,
so get pointers here */
/* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException();
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch &&
LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE &&
handler->cp_b != NULL) {
handler->cp_ap = TRUSTFAILCODE;
handler = handler->cp_b;
}
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
B = handler;
P = FAILCODE;
LOCAL_DoingUndefp = false;
return true;
}
bool Yap_JumpToEnv(void) {
CACHE_REGS
if (LOCAL_PrologMode & TopGoalMode)
return true;
return JumpToEnv(PASS_REGS1);
}
/* This does very nasty stuff!!!!! */
static Int jump_env(USES_REGS1) {
Term t = Deref(ARG1), t0 = t;
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t,
"throw/1 must be called instantiated");
}
// Yap_DebugPlWriteln(t);
// char *buf = Yap_TermToBuffer(t, ENC_ISO_UTF8,
// Quote_illegal_f | Ignore_ops_f |
// Unfold_cyclics_f);
// __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " throw(%s)", buf);
LOCAL_ActiveError = Yap_UserError(t0, LOCAL_ActiveError);
bool out = JumpToEnv(PASS_REGS1);
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
LCL0 - (CELL *)B > LOCAL_CBorder) {
// we're failing up to the top layer
}
pop_text_stack(LOCAL_MallocDepth + 1);
return out;
}
/* set up a meta-call based on . context info */
static Int 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, bool full_reset) {
Term h0var;
YAP_dogoalinfo gi;
// getchar();
#if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract
machine registers */
#ifdef THREADS
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;
}
/* may be run by worker_id on behalf on myworker_id */
#else
Yap_regp = &Yap_standard_regs;
#endif
#endif /* PUSH_REGS */
CACHE_REGS
Yap_ResetException(LOCAL_ActiveError);
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 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 (full_reset) {
HB = HR = H0 + 1;
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 COROUTINING
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
h0var = MkVarTerm();
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
#endif
size_t defsz = 128*1024;
Yap_AllocateDefaultArena(defsz, myworker_id);
} else {
HR = Yap_ArenaLimit(REMOTE_GlobalArena(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 */
Yap_RebootSlots(myworker_id);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
PREG_ADDR = NULL;
#endif
cut_c_initialize(myworker_id);
Yap_PrepGoal(0, NULL, &gi PASS_REGS);
#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);
#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
}
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
YAP_opaque_handler_t catcher_ops;
memset(&catcher_ops, 0, sizeof(catcher_ops));
catcher_ops.cut_handler = watch_cut;
catcher_ops.fail_handler = watch_retry;
setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
Term cm = CurrentModule;
Yap_InitComma();
Yap_InitCPred("$execute", 1, execute, 0);
Yap_InitCPred("$execute", 2, execute2, 0);
Yap_InitCPred("$execute", 3, execute3, 0);
Yap_InitCPred("$execute", 4, execute4, 0);
Yap_InitCPred("$execute", 5, execute5, 0);
Yap_InitCPred("$execute", 6, execute6, 0);
Yap_InitCPred("$execute", 7, execute7, 0);
Yap_InitCPred("$execute", 8, execute8, 0);
Yap_InitCPred("$execute", 9, execute9, 0);
Yap_InitCPred("$execute", 10, execute10, 0);
Yap_InitCPred("$execute", 11, execute11, 0);
Yap_InitCPred("$execute", 12, execute12, 0);
Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0);
Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0);
Yap_InitCPred("call_with_args", 1, execute_0, 0);
Yap_InitCPred("call_with_args", 2, execute_1, 0);
Yap_InitCPred("call_with_args", 3, execute_2, 0);
Yap_InitCPred("call_with_args", 4, execute_3, 0);
Yap_InitCPred("call_with_args", 5, execute_4, 0);
Yap_InitCPred("call_with_args", 6, execute_5, 0);
Yap_InitCPred("call_with_args", 7, execute_6, 0);
Yap_InitCPred("call_with_args", 8, execute_7, 0);
Yap_InitCPred("call_with_args", 9, execute_8, 0);
Yap_InitCPred("call_with_args", 10, execute_9, 0);
Yap_InitCPred("call_with_args", 11, execute_10, 0);
#ifdef DEPTH_LIMIT
Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0);
#endif
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
Yap_InitCPred("$execute_nonstop", 1, execute_nonstop1, NoTracePredFlag);
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
Yap_InitCPred("parent_choice_point", 1, parent_choice_point1, 0);
Yap_InitCPred("parent_choice_point", 2, parent_choice_point, 0);
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,
NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$restore_regs", 2, restore_regs2,
NoTracePredFlag | SafePredFlag);
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
SafePredFlag);
Yap_InitCPred("throw", 1, jump_env, 0);
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
0);
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, NoTracePredFlag);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
}
Reference in New Issue View Git Blame Copy Permalink