This commit is contained in:
Vitor Santos Costa 2019-05-20 01:00:41 +01:00
parent 0e47ddc802
commit 69dc2a963c
13 changed files with 2061 additions and 1944 deletions

362
C/exec.c
View File

@ -1,19 +1,19 @@
/*************************************************************************
* *
* 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 *
* *
*************************************************************************/
/*************************************************************************
* *
* 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
@ -37,18 +37,34 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#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 bool should_creep() {
return
!(LOCAL_PrologMode & (AbortMode | InterruptMode | SystemMode|BootMode))
&&
LOCAL_debugger_state[DEBUG_DEBUGGER_MAY_BE_CALLED] == TermTrue
&&
(
(Yap_has_a_signal() && !LOCAL_InterruptsDisabled) ||
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] == TermUserCreep ||
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] == TermLeap);
}
static Term cp_as_integer(choiceptr cp USES_REGS) {
return (MkIntegerTerm(LCL0 - (CELL *)cp));
return (MkIntegerTerm(LCL0 - (CELL *) cp));
}
static choiceptr cp_from_integer(Term cpt USES_REGS) {
return (choiceptr)(LCL0 - IntegerOfTerm(cpt));
return (choiceptr) (LCL0 - IntegerOfTerm(cpt));
}
/**
@ -100,7 +116,7 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
CP = P;
}
/* make sure we have access to the user given cut */
YENV[E_CB] = (CELL)cut_pt;
YENV[E_CB] = (CELL) cut_pt;
P = code;
return true;
}
@ -119,14 +135,14 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
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;
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);
@ -190,7 +206,7 @@ Term Yap_PredicateToIndicator(PredEntry *pe) {
ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred));
} else {
ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred));
ti[0] = MkAtomTerm((Atom) (pe->FunctorOfPred));
ti[1] = MkIntTerm(0);
}
Term t = Yap_MkApplTerm(FunctorSlash, 2, ti);
@ -231,7 +247,7 @@ static Int current_choice_point(USES_REGS1) {
if (!IsVarTerm(t))
return (FALSE);
td = cp_as_integer(B PASS_REGS);
YapBind((CELL *)t, td);
YapBind((CELL *) t, td);
return TRUE;
}
@ -255,7 +271,7 @@ static Int parent_choice_point(USES_REGS1) {
if (cp == NULL || cp->cp_b == NULL)
return false;
td = cp_as_integer(cp->cp_b PASS_REGS);
YapBind((CELL *)t, td);
YapBind((CELL *) t, td);
return TRUE;
}
@ -275,7 +291,7 @@ static Int parent_choice_point1(USES_REGS1) {
if (B == NULL || B->cp_b == NULL)
return false;
td = cp_as_integer(B->cp_b PASS_REGS);
YapBind((CELL *)t, td);
YapBind((CELL *) t, td);
return true;
}
@ -288,8 +304,8 @@ static Int save_env_b(USES_REGS1) {
#endif
if (!IsVarTerm(t))
return (FALSE);
td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS);
YapBind((CELL *)t, td);
td = cp_as_integer((choiceptr) YENV[E_CB] PASS_REGS);
YapBind((CELL *) t, td);
return true;
}
@ -299,7 +315,7 @@ static Int save_env_b(USES_REGS1) {
static PredEntry *new_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
restart:
restart:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
@ -339,9 +355,9 @@ static bool CommaCall(Term t, Term mod) {
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_CB] = (CELL) B;
YENV[E_CP] = (CELL) P;
YENV[E_E] = (CELL) ENV;
YENV[E_DEPTH] = DEPTH;
ASP = YENV - (EnvSizeInCells + i);
@ -358,8 +374,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
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))) {
if ( should_creep() ) {
return EnterCreepMode(t, mod PASS_REGS);
}
if (IsVarTerm(t) || IsVarTerm(mod)) {
@ -375,9 +390,9 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
if (f == FunctorComma && false) {
Term t2 = ArgOfTerm(2, t);
if (IsVarTerm(t2))
return CallMetaCall(t0, mod0 PASS_REGS);
return CallMetaCall(t, mod PASS_REGS);
if (1 || !CommaCall(t2, mod))
return CallMetaCall(t0, mod0 PASS_REGS);
return CallMetaCall(t, mod PASS_REGS);
Term t1 = ArgOfTerm(1, t);
t = t1;
@ -400,7 +415,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
otherwise I would dereference the argument and
might skip a svar */
if (pen->PredFlags & (MetaPredFlag | UndefPredFlag | SpiedPredFlag)) {
return CallMetaCall(t0, mod0 PASS_REGS);
return CallMetaCall(t, mod PASS_REGS);
}
pt = RepAppl(t) + 1;
for (i = 1; i <= arity; i++) {
@ -431,7 +446,7 @@ inline static bool do_execute(Term t, Term mod USES_REGS) {
pe = RepPredProp(PredPropByAtom(a, mod));
return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS));
}
return CallMetaCall(t0, mod0 PASS_REGS);
return CallMetaCall(t, mod PASS_REGS);
}
static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n,
@ -445,22 +460,22 @@ static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n,
*HR++ = pt[i];
}
for (i = 0; i < n; i++) {
*HR++ = h0[(int)(i - n)];
*HR++ = h0[(int) (i - n)];
}
tf = AbsPair(h0);
} else {
*HR++ = (CELL)f;
*HR++ = (CELL) f;
for (i = 0; i < arity - n; i++) {
*HR++ = pt[i];
}
for (i = 0; i < n; i++) {
*HR++ = h0[(int)(i - n)];
*HR++ = h0[(int) (i - n)];
}
tf = AbsAppl(h0);
}
if (mod != CurrentModule) {
CELL *h0 = HR;
*HR++ = (CELL)FunctorModule;
*HR++ = (CELL) FunctorModule;
*HR++ = mod;
*HR++ = tf;
tf = AbsAppl(h0);
@ -476,8 +491,8 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
unsigned int i, arity;
int j = -n;
Term t0 = t, mod0 = mod;
restart_exec:
t = Yap_YapStripModule(t, &mod);
restart_exec:
if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
} else if (IsAtomTerm(t)) {
@ -555,8 +570,7 @@ 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)) {
if (!Yap_locked_growheap(false, 0, NULL)) {
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"YAP failed to grow heap at meta-call");
}
@ -564,17 +578,13 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
return do_execute(ARG1, mod PASS_REGS);
}
}
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep, 1));
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep, 4));
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);
}
}
if (IsVarTerm(t)) { return false; }
ARG2 = mod;
ARG1 = t;
ARG3 = MkVarTerm();
ARG4 = MkVarTerm();
CalculateStackGap(PASS_REGS1);
P_before_spy = P;
return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS);
@ -595,7 +605,7 @@ static void heap_store(Term t USES_REGS) {
*HR++ = t;
} else {
RESET_VARIABLE(HR);
Bind_Local(VarOfTerm(t), (CELL)HR);
Bind_Local(VarOfTerm(t), (CELL) HR);
HR++;
}
} else {
@ -734,7 +744,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
yamop *code;
Term clt = Deref(ARG3);
restart_exec:
restart_exec:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE;
@ -793,7 +803,7 @@ restart_exec:
}
static Int creep_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
Int rc = execute_clause( PASS_REGS1 );
Int rc = execute_clause(PASS_REGS1);
if (!LOCAL_InterruptsDisabled) {
Yap_signal(YAP_CREEP_SIGNAL);
}
@ -861,22 +871,22 @@ static Int Yap_ignore(Term t, bool fail USES_REGS) {
yamop *oP = P, *oCP = CP;
Int oENV = LCL0 - ENV;
Int oYENV = LCL0 - YENV;
Int oB = LCL0 - (CELL *)B;
Int oB = LCL0 - (CELL *) B;
yap_error_descriptor_t *ctx = malloc(sizeof(yap_error_descriptor_t));
bool newxp = Yap_pushErrorContext(true, ctx);
bool rc = Yap_RunTopGoal(t, false);
if (!rc) {
complete_inner_computation((choiceptr)(LCL0 - oB));
complete_inner_computation((choiceptr) (LCL0 - oB));
// We'll pass it through
} else {
prune_inner_computation((choiceptr)(LCL0 - oB));
prune_inner_computation((choiceptr) (LCL0 - oB));
}
Yap_popErrorContext(newxp, true);
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
YENV = LCL0 - oYENV;
B = (choiceptr)(LCL0 - oB);
B = (choiceptr) (LCL0 - oB);
return true;
}
@ -884,7 +894,7 @@ 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,
Term t = Yap_AllocExternalDataInStack((CELL) setup_call_catcher_cleanup_tag,
sizeof(Int), &pt);
if (t == TermNil)
return false;
@ -956,7 +966,7 @@ static bool watch_retry(Term d0 USES_REGS) {
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)));
choiceptr B0 = (choiceptr) (LCL0 - IntegerOfTerm(ArgOfTerm(6, task)));
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode = UserMode;
@ -1044,14 +1054,14 @@ static Int setup_call_catcher_cleanup(USES_REGS1) {
}
static Int tag_cleanup(USES_REGS1) {
Int iB = LCL0 - (CELL *)B;
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)));
choiceptr B0 = (choiceptr) (LCL0 - IntegerOfTerm(Deref(ARG1)));
Term task = Deref(ARG2);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
@ -1070,7 +1080,7 @@ static Int cleanup_on_exit(USES_REGS1) {
CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
if (B < B0) {
// non-deterministic
set_watch(LCL0 - (CELL *)B, task);
set_watch(LCL0 - (CELL *) B, task);
if (!box) {
return true;
}
@ -1112,7 +1122,7 @@ static Int _user_expand_goal(USES_REGS1) {
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);
return complete_ge(true, omod, sl, creeping);
}
/* system:goal_expansion(A,B) */
mg_args[0] = cmod;
@ -1199,11 +1209,11 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
unsigned int arity;
Prop pe;
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) {
if (should_creep()) {
return EnterCreepMode(t, mod PASS_REGS);
}
t = Yap_YapStripModule(t, &mod);
restart_exec:
restart_exec:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false;
@ -1322,7 +1332,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
/* N = arity; */
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL)) {
if (should_creep()) {
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
@ -1337,9 +1347,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
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))) {
if (should_creep()) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return rc;
@ -1405,7 +1413,7 @@ static Int execute_nonstop(USES_REGS1) {
/* N = arity; */
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL)) {
if (should_creep()) {
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
@ -1417,9 +1425,7 @@ static Int execute_nonstop(USES_REGS1) {
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))) {
if (should_creep()) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return CallPredicate(RepPredProp(pe), B,
@ -1499,6 +1505,7 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
}
#ifdef DEPTH_LIMIT
static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
@ -1516,6 +1523,7 @@ static Int execute_depth_limit(USES_REGS1) {
}
return execute(PASS_REGS1);
}
#endif
static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
@ -1544,14 +1552,15 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
/* H is not so important, because we're gonna backtrack */
restore_H();
/* set stack */
ASP = (CELL *)PROTECT_FROZEN_B(B);
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;
P = (yamop *) FAILCODE;
}
break;
case 2: {
// LOCAL_ActiveError = err_info;
/* arithmetic exception */
@ -1563,11 +1572,12 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
pop_text_stack(i + 1);
Yap_set_fpu_exceptions(
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE;
P = (yamop *) FAILCODE;
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
Yap_CloseSlots(sls);
} break;
}
break;
case 3: { /* saved state */
// LOCAL_ActiveError = err_info;
pop_text_stack(i + 1);
@ -1591,7 +1601,7 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
}
LOCAL_PrologMode = UserMode;
LOCAL_DoingUndefp = false;
P = (yamop *)FAILCODE;
P = (yamop *) FAILCODE;
LOCAL_RestartEnv = sighold;
Yap_CloseSlots(sls);
pop_text_stack(i + 1);
@ -1611,10 +1621,10 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
Yap_JumpToEnv();
Yap_CloseTemporaryStreams();
Yap_CloseSlots(sls);
ASP = (CELL *)PROTECT_FROZEN_B(B);
ASP = (CELL *) PROTECT_FROZEN_B(B);
if (B == NULL || B->cp_b == NULL ||
(CELL *)(B->cp_b) > LCL0 - LOCAL_CBorder) {
(CELL *) (B->cp_b) > LCL0 - LOCAL_CBorder) {
LOCAL_RestartEnv = sighold;
LOCAL_CBorder = OldBorder;
pop_text_stack(i + 1);
@ -1643,11 +1653,11 @@ void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
Yap_ResetException(worker_id);
// sl = Yap_InitSlot(t);
YENV = ASP;
YENV[E_CP] = (CELL)YESCODE;
YENV[E_CB] = (CELL)B;
YENV[E_E] = (CELL)ENV;
YENV[E_CP] = (CELL) YESCODE;
YENV[E_CB] = (CELL) B;
YENV[E_E] = (CELL) ENV;
#ifdef TABLING
YENV[E_B] = (CELL)B;
YENV[E_B] = (CELL) B;
#endif
#ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH;
@ -1663,7 +1673,7 @@ void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
XREGS[i + 1] = *pt++;
}
}
B = (choiceptr)ASP;
B = (choiceptr) ASP;
B--;
B->cp_h = HR;
B->cp_tr = TR;
@ -1674,8 +1684,8 @@ void Yap_PrepGoal(arity_t arity, CELL *pt, choiceptr saved_b USES_REGS) {
#ifdef DEPTH_LIMIT
B->cp_depth = DEPTH;
#endif /* DEPTH_LIMIT */
YENV = ASP = (CELL *)B;
YENV[E_CB] = (CELL)B;
YENV = ASP = (CELL *) B;
YENV[E_CB] = (CELL) B;
HB = HR;
CP = YESCODE;
}
@ -1685,7 +1695,7 @@ static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) {
bool out;
Yap_PrepGoal(arity, pt, saved_b PASS_REGS);
// CACHE_A1();
P = (yamop *)CodeAdr;
P = (yamop *) CodeAdr;
// S = CellPtr(RepPredProp(
// PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */
@ -1739,12 +1749,12 @@ void Yap_fail_all(choiceptr bb USES_REGS) {
if (POP_CHOICE_POINT(B->cp_b)) {
POP_EXECUTE();
}
ENV = (CELL *)(ENV[E_E]);
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]);
YENV = ENV = (CELL *) ((B->cp_env)[E_E]);
if (B->cp_b) {
B = B->cp_b;
}
@ -1773,7 +1783,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* we succeeded, let's prune */
/* restore the old environment */
/* get to previous environment */
cut_B = (choiceptr)ENV[E_CB];
cut_B = (choiceptr) ENV[E_CB];
#ifdef YAPOR
CUT_prune_to(cut_B);
#endif /* YAPOR */
@ -1794,7 +1804,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
#ifdef DEPTH_LIMIT
DEPTH = ENV[E_DEPTH];
#endif
ENV = (CELL *)(ENV[E_E]);
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)
@ -1802,9 +1812,9 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
YENV = ENV;
// should we catch the exception or pass it through?
// We'll pass it through
if ( Yap_HasException()) {
if (Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
((LOCAL_PrologMode & BootMode) || !CurrentModule)) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
@ -1823,15 +1833,15 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
did the call */
ASP = B->cp_env;
/* YENV should be set to the current environment */
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
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 ( Yap_HasException()) {
if (Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
((LOCAL_PrologMode & BootMode) || !CurrentModule)) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
@ -1890,9 +1900,9 @@ void Yap_trust_last(void) {
DEPTH = B->cp_depth;
#endif
YENV = ASP = B->cp_env;
ENV = (CELL *)((B->cp_env)[E_E]);
ENV = (CELL *) ((B->cp_env)[E_E]);
B = B->cp_b;
P = (yamop *)(ENV[E_CP]);
P = (yamop *) (ENV[E_CP]);
if (B) {
SET_BB(B);
HB = PROTECT_FROZEN_H(B);
@ -1988,10 +1998,10 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) {
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]));
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];
@ -2043,10 +2053,10 @@ static Int restore_regs2(USES_REGS1) {
#if YAPOR_SBA
pt0 = (choiceptr)d;
#else
pt0 = (choiceptr)(LCL0 - d);
pt0 = (choiceptr) (LCL0 - d);
#endif
/* find where to cut to */
if ((CELL *)pt0 != LCL0 && pt0 > B) {
if ((CELL *) pt0 != LCL0 && pt0 > B) {
/* Wow, we're gonna cut!!! */
while (B->cp_b < pt0) {
while (POP_CHOICE_POINT(B->cp_b)) {
@ -2094,7 +2104,7 @@ static Int clean_ifcp(USES_REGS1) {
B = B->cp_b;
HB = B->cp_h;
} else {
pt0->cp_ap = (yamop *)TRUSTFAILCODE;
pt0->cp_ap = (yamop *) TRUSTFAILCODE;
}
return TRUE;
}
@ -2107,7 +2117,7 @@ static int disj_marker(yamop *apc) {
static Int cut_up_to_next_disjunction(USES_REGS1) {
choiceptr pt0 = B;
CELL *qenv = (CELL *)ENV[E_E];
CELL *qenv = (CELL *) ENV[E_E];
while (pt0 && !(qenv == pt0->cp_env && disj_marker(pt0->cp_ap))) {
pt0 = pt0->cp_b;
@ -2153,7 +2163,7 @@ bool Yap_Reset(yap_reset_t mode, bool hard) {
Yap_InitYaamRegs(worker_id, false);
GLOBAL_Initialised = true;
ENV = LCL0;
ASP = (CELL *)B;
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;
@ -2188,7 +2198,7 @@ static Int JumpToEnv(USES_REGS1) {
/* 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 &&
LOCAL_CBorder < LCL0 - (CELL *) handler && handler->cp_ap != NOCODE &&
handler->cp_b != NULL) {
handler->cp_ap = TRUSTFAILCODE;
handler = handler->cp_b;
@ -2225,7 +2235,7 @@ static Int jump_env(USES_REGS1) {
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) {
LCL0 - (CELL *) B > LOCAL_CBorder) {
// we're failing up to the top layer
}
pop_text_stack(LOCAL_MallocDepth + 1);
@ -2236,10 +2246,11 @@ static Int jump_env(USES_REGS1) {
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);
ARG2 = cp_as_integer((choiceptr) ENV[E_CB] PASS_REGS);
return TRUE;
}
void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
Term h0var;
// getchar();
@ -2260,11 +2271,11 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
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)) +
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);
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;
@ -2286,7 +2297,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
h0var = MkVarTerm();
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
#endif
size_t defsz = 128*1024;
size_t defsz = 128 * 1024;
Yap_AllocateDefaultArena(defsz, myworker_id, NULL);
} else {
HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
@ -2297,8 +2308,8 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#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);
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 */
@ -2319,8 +2330,8 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
#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);
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
@ -2354,6 +2365,98 @@ int Yap_dogc(int extra_args, Term *tp USES_REGS) {
return TRUE;
}
static Int get_debugger_state(USES_REGS1) {
const char *s = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
if (!strcmp(s, "creep")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP]);
}
if (!strcmp(s, "goal_number")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_GOAL_NUMBER]);
}
if (!strcmp(s, "spy")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_SPY]);
}
if (!strcmp(s, "trace")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_TRACE_MODE]);
}
if (!strcmp(s, "debug")) {
return Yap_unify(ARG2, LOCAL_debugger_state[DEBUG_TRACE_MODE]);
}
return false;
}
static Int set_debugger_state(USES_REGS1) {
const char *s = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
if (!strcmp(s, "creep")) {
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] = Deref(ARG2);
return true;
}
if (!strcmp(s, "goal_number")) {
LOCAL_debugger_state[DEBUG_GOAL_NUMBER] = Deref(ARG2);
return true;
}
if (!strcmp(s, "spy")) {
LOCAL_debugger_state[DEBUG_SPY] = Deref(ARG2);
return true;
}
if (!strcmp(s, "trace")) {
LOCAL_debugger_state[DEBUG_TRACE_MODE] = Deref(ARG2);
return true;
}
if (!strcmp(s, "debug")) {
LOCAL_debugger_state[DEBUG_DEBUGGER_MAY_BE_CALLED] = Deref(ARG2);
return true;
}
return false;
}
static Int set_debugger_state4(USES_REGS1) {
Term t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP] = t1;
}
t1 = Deref(ARG2);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_GOAL_NUMBER] = t1;
}
t1 = Deref(ARG3);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_SPY] = t1;
}
t1 = Deref(ARG4);
if (!IsVarTerm(t1)) {
LOCAL_debugger_state[DEBUG_TRACE_MODE] = t1;
}
return true;
}
static Int get_debugger_state4(USES_REGS1) {
Term t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_CREEP_LEAP_OR_ZIP], t1))
return false;
}
t1 = Deref(ARG2);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_GOAL_NUMBER], t1))
return false;
}
t1 = Deref(ARG3);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_SPY], t1))
return false;
}
t1 = Deref(ARG4);
if (!IsVarTerm(t1)) {
if (!Yap_unify(LOCAL_debugger_state[DEBUG_TRACE_MODE], t1))
return false;
}
return true;
}
void Yap_InitExecFs(void) {
CACHE_REGS
YAP_opaque_handler_t catcher_ops;
@ -2397,7 +2500,7 @@ void Yap_InitExecFs(void) {
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("$creep_clause", 4,creep_clause, NoTracePredFlag);
Yap_InitCPred("$creep_clause", 4, creep_clause, NoTracePredFlag);
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0);
CurrentModule = HACKS_MODULE;
@ -2423,4 +2526,9 @@ void Yap_InitExecFs(void) {
0);
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, NoTracePredFlag);
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
Yap_InitCPred("$get_debugger_state", 2, get_debugger_state, 0);
Yap_InitCPred("$get_debugger_state", 4, get_debugger_state4, 0);
Yap_InitCPred("$set_debugger_state", 2, set_debugger_state, 0);
Yap_InitCPred("$set_debugger_state", 4, set_debugger_state4, 0);
}

View File

@ -91,6 +91,7 @@ A Context N "context"
A Cputime N "cputime"
A Create N "create"
A Creep F "$creep"
A UserCreep N "creep"
A CryptAtoms N "crypt_atoms"
A Curly N "{}"
A Csult F "$csult"
@ -222,6 +223,7 @@ A LOOP N "_LOOP_"
A LoopStream N "loop_stream"
A LT N "<"
A LastExecuteWithin F "$last_execute_within"
A Leap N "leap"
A Leash F "$leash"
A Least N "least"
A Length F "length"
@ -454,6 +456,7 @@ A WriteTerm N "write_term"
A Xml N "xml"
A YapHacks N "yap_hacks"
A ZeroDivisor N "zero_divisor"
A Zip N "zip"
F AfInet AfInet 2
F AfLocal AfLocal 1
F AfUnix AfUnix 1
@ -486,7 +489,7 @@ F Comma Comma 2
F CommentHook CommentHook 3
F Context2 Context 2
F ConsistencyError ConsistencyError 1
F Creep Creep 1
F Creep Creep 4
F Csult Csult 2
F CurrentModule CurrentModule 1
F CutBy CutBy 1

View File

@ -1043,4 +1043,16 @@ extern void **Yap_ABSMI_OPCODES;
#endif
/// Debugging Support
typedef enum {
DEBUG_CREEP_LEAP_OR_ZIP = 0,
DEBUG_GOAL_NUMBER = 1,
DEBUG_SPY = 2,
DEBUG_TRACE_MODE = 3,
DEBUG_GOAL_QUEUE = 4,
DEBUG_DEBUGGER_MAY_BE_CALLED = 5,
DEBUG_NUMBER_OF_OPTS =6
} debug_key_t ;
#endif

View File

@ -86,6 +86,7 @@
AtomCputime = Yap_LookupAtom("cputime"); TermCputime = MkAtomTerm(AtomCputime);
AtomCreate = Yap_LookupAtom("create"); TermCreate = MkAtomTerm(AtomCreate);
AtomCreep = Yap_FullLookupAtom("$creep"); TermCreep = MkAtomTerm(AtomCreep);
AtomUserCreep = Yap_LookupAtom("creep"); TermUserCreep = MkAtomTerm(AtomUserCreep);
AtomCryptAtoms = Yap_LookupAtom("crypt_atoms"); TermCryptAtoms = MkAtomTerm(AtomCryptAtoms);
AtomCurly = Yap_LookupAtom("{}"); TermCurly = MkAtomTerm(AtomCurly);
AtomCsult = Yap_FullLookupAtom("$csult"); TermCsult = MkAtomTerm(AtomCsult);
@ -216,6 +217,7 @@
AtomLoopStream = Yap_LookupAtom("loop_stream"); TermLoopStream = MkAtomTerm(AtomLoopStream);
AtomLT = Yap_LookupAtom("<"); TermLT = MkAtomTerm(AtomLT);
AtomLastExecuteWithin = Yap_FullLookupAtom("$last_execute_within"); TermLastExecuteWithin = MkAtomTerm(AtomLastExecuteWithin);
AtomLeap = Yap_LookupAtom("leap"); TermLeap = MkAtomTerm(AtomLeap);
AtomLeash = Yap_FullLookupAtom("$leash"); TermLeash = MkAtomTerm(AtomLeash);
AtomLeast = Yap_LookupAtom("least"); TermLeast = MkAtomTerm(AtomLeast);
AtomLength = Yap_FullLookupAtom("length"); TermLength = MkAtomTerm(AtomLength);
@ -448,6 +450,7 @@
AtomXml = Yap_LookupAtom("xml"); TermXml = MkAtomTerm(AtomXml);
AtomYapHacks = Yap_LookupAtom("yap_hacks"); TermYapHacks = MkAtomTerm(AtomYapHacks);
AtomZeroDivisor = Yap_LookupAtom("zero_divisor"); TermZeroDivisor = MkAtomTerm(AtomZeroDivisor);
AtomZip = Yap_LookupAtom("zip"); TermZip = MkAtomTerm(AtomZip);
FunctorAfInet = Yap_MkFunctor(AtomAfInet,2);
FunctorAfLocal = Yap_MkFunctor(AtomAfLocal,1);
FunctorAfUnix = Yap_MkFunctor(AtomAfUnix,1);
@ -480,7 +483,7 @@
FunctorCommentHook = Yap_MkFunctor(AtomCommentHook,3);
FunctorContext2 = Yap_MkFunctor(AtomContext,2);
FunctorConsistencyError = Yap_MkFunctor(AtomConsistencyError,1);
FunctorCreep = Yap_MkFunctor(AtomCreep,1);
FunctorCreep = Yap_MkFunctor(AtomCreep,4);
FunctorCsult = Yap_MkFunctor(AtomCsult,2);
FunctorCurrentModule = Yap_MkFunctor(AtomCurrentModule,1);
FunctorCutBy = Yap_MkFunctor(AtomCutBy,1);

View File

@ -86,6 +86,7 @@
AtomCputime = AtomAdjust(AtomCputime); TermCputime = MkAtomTerm(AtomCputime);
AtomCreate = AtomAdjust(AtomCreate); TermCreate = MkAtomTerm(AtomCreate);
AtomCreep = AtomAdjust(AtomCreep); TermCreep = MkAtomTerm(AtomCreep);
AtomUserCreep = AtomAdjust(AtomUserCreep); TermUserCreep = MkAtomTerm(AtomUserCreep);
AtomCryptAtoms = AtomAdjust(AtomCryptAtoms); TermCryptAtoms = MkAtomTerm(AtomCryptAtoms);
AtomCurly = AtomAdjust(AtomCurly); TermCurly = MkAtomTerm(AtomCurly);
AtomCsult = AtomAdjust(AtomCsult); TermCsult = MkAtomTerm(AtomCsult);
@ -216,6 +217,7 @@
AtomLoopStream = AtomAdjust(AtomLoopStream); TermLoopStream = MkAtomTerm(AtomLoopStream);
AtomLT = AtomAdjust(AtomLT); TermLT = MkAtomTerm(AtomLT);
AtomLastExecuteWithin = AtomAdjust(AtomLastExecuteWithin); TermLastExecuteWithin = MkAtomTerm(AtomLastExecuteWithin);
AtomLeap = AtomAdjust(AtomLeap); TermLeap = MkAtomTerm(AtomLeap);
AtomLeash = AtomAdjust(AtomLeash); TermLeash = MkAtomTerm(AtomLeash);
AtomLeast = AtomAdjust(AtomLeast); TermLeast = MkAtomTerm(AtomLeast);
AtomLength = AtomAdjust(AtomLength); TermLength = MkAtomTerm(AtomLength);
@ -447,6 +449,7 @@
AtomWriteTerm = AtomAdjust(AtomWriteTerm); TermWriteTerm = MkAtomTerm(AtomWriteTerm);
AtomXml = AtomAdjust(AtomXml); TermXml = MkAtomTerm(AtomXml);
AtomYapHacks = AtomAdjust(AtomYapHacks); TermYapHacks = MkAtomTerm(AtomYapHacks);
AtomZip = AtomAdjust(AtomZip); TermZip = MkAtomTerm(AtomZip);
AtomZeroDivisor = AtomAdjust(AtomZeroDivisor); TermZeroDivisor = MkAtomTerm(AtomZeroDivisor);
FunctorAfInet = FuncAdjust(FunctorAfInet);
FunctorAfLocal = FuncAdjust(FunctorAfLocal);

View File

@ -85,7 +85,8 @@ X_API EXTERNAL Atom AtomConsultOnBoot; X_API EXTERNAL Term TermConsultOnBoot;
X_API EXTERNAL Atom AtomContext; X_API EXTERNAL Term TermContext;
X_API EXTERNAL Atom AtomCputime; X_API EXTERNAL Term TermCputime;
X_API EXTERNAL Atom AtomCreate; X_API EXTERNAL Term TermCreate;
X_API EXTERNAL Atom AtomCreep; X_API EXTERNAL Term TermCreep;
X_API EXTERNAL Atom AtomCreep; X_API EXTERNAL Term TermCreep;
X_API EXTERNAL Atom AtomUserCreep; X_API EXTERNAL Term TermUserCreep;
X_API EXTERNAL Atom AtomCryptAtoms; X_API EXTERNAL Term TermCryptAtoms;
X_API EXTERNAL Atom AtomCurly; X_API EXTERNAL Term TermCurly;
X_API EXTERNAL Atom AtomCsult; X_API EXTERNAL Term TermCsult;
@ -216,7 +217,8 @@ X_API EXTERNAL Atom AtomLOOP; X_API EXTERNAL Term TermLOOP;
X_API EXTERNAL Atom AtomLoopStream; X_API EXTERNAL Term TermLoopStream;
X_API EXTERNAL Atom AtomLT; X_API EXTERNAL Term TermLT;
X_API EXTERNAL Atom AtomLastExecuteWithin; X_API EXTERNAL Term TermLastExecuteWithin;
X_API EXTERNAL Atom AtomLeash; X_API EXTERNAL Term TermLeash;
X_API EXTERNAL Atom AtomLeash; X_API EXTERNAL Term TermLeash;
X_API EXTERNAL Atom AtomLeap; X_API EXTERNAL Term TermLeap;
X_API EXTERNAL Atom AtomLeast; X_API EXTERNAL Term TermLeast;
X_API EXTERNAL Atom AtomLength; X_API EXTERNAL Term TermLength;
X_API EXTERNAL Atom AtomList; X_API EXTERNAL Term TermList;
@ -448,6 +450,8 @@ X_API EXTERNAL Atom AtomWriteTerm; X_API EXTERNAL Term TermWriteTerm;
X_API EXTERNAL Atom AtomXml; X_API EXTERNAL Term TermXml;
X_API EXTERNAL Atom AtomYapHacks; X_API EXTERNAL Term TermYapHacks;
X_API EXTERNAL Atom AtomZeroDivisor; X_API EXTERNAL Term TermZeroDivisor;
X_API EXTERNAL Atom AtomZip; X_API EXTERNAL Term TermZip;
X_API EXTERNAL Functor FunctorAfInet;
X_API EXTERNAL Functor FunctorAfLocal;

View File

@ -33,6 +33,8 @@ LOCAL_INIT(bool, newline, true);
LOCAL_INIT(Atom, AtPrompt, AtomNil);
LOCAL_ARRAY(char, Prompt, MAX_PROMPT + 1);
LOCAL_ARRAY(Term, debugger_state, DEBUG_NUMBER_OF_OPTS);
LOCAL_INITF(encoding_t, encoding, Yap_DefaultEncoding());
LOCAL_INIT(bool, quasi_quotations, false);
LOCAL_INIT(UInt, default_priority, 1200);

View File

@ -473,7 +473,7 @@ b_getval(GlobalVariable, Val) :-
'$debug_stop' :-
nb_setval('$debug_state', state(creep,0,stop)),
'$set_debugger_state'( zip,0,stop,off ),
b_setval('$trace',off),
set_prolog_flag(debug, false),
b_setval('$spy_glist',[]),

View File

@ -16,7 +16,7 @@
*************************************************************************/
:- system_module('$_debug',
[],
['$trace_query'/4, '$init_debugger'/0, '$skipeol'/1]).
['$trace_goal'/4, '$init_debugger'/0, '$skipeol'/1]).
@ -252,7 +252,7 @@ be lost.
*
* The debugger is an interpreter. with main predicates:
* - $trace: this is the API
* - $trace_query: reduce a query to a goal
* - $trace_goal: reduce a query to a goal
* - $trace_goal: execute:
* + using the source, Luke
* + hooking into the WAM procedure call mechanism
@ -299,7 +299,7 @@ be lost.
%%! The first case matches system_predicates or zip
'$trace'(Mod:G) :-
'$$save_by'(CP),
'$trace_query'(G, Mod, CP, _G).
'$trace_goal'(G, Mod, CP, _G).
'$trace'(Mod:G, A1) :-
@ -394,64 +394,57 @@ be lost.
'$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, _G ).
'$trace_goal'(G, M, CP, _G ).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded)
'$creep'([M|Q]) :-
'$yap_strip_module'(G,M,Q),
'$current_choicepoint'(CP),
'$trace_goal'(Q, M, CP, _G ).
'$creep'(G0, M0, _CP, H) :-
'$yap_strip_module'(M0:G0, M, G), % spy a literal
'$id_goal'(L),
'$current_choicepoint'(CP),
'$trace_goal'(G, M, CP,L).
%% @pred '$trace_goal'( +G, +M, +CP, +Expanded)
%
% debug a complex query
%
'$trace_query'(V, M, _CP, _) :-
'$trace_goal'(V, M, _,_) :-
var(V),
!,
call(M:V).
'$trace_query'(!, _, CP, _) :-
'$trace_goal'(!, _, _,CP) :-
!,
'$$cut_by'(CP).
'$trace_query'('$cut_by'(M), _, _, _) :-
'$trace_goal'('$cut_by'(M), _, _, _) :-
!,
'$$cut_by'(M).
'$trace_query'('$$cut_by'(M), _, _, _) :-
'$trace_goal'('$$cut_by'(M), _, _, _) :-
!,
'$$cut_by'(M).
'$trace_query'(M:G, _, CP,S) :-
'$trace_goal'(M:G, _, S, CP) :-
!,
'$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S ).
'$trace_query'((A,B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S),
'$trace_query'(B, M, CP, S).
'$trace_query'((A->B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S) ->
'$trace_query'(B, M, CP, S).
'$trace_query'((A;B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S);
'$trace_query'(B, M, CP, S).
'$trace_query'((A|B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S);
'$trace_query'(B, M, CP, S).
'$trace_query'((\+ A), M, CP, S) :- !,
'$trace_query'(A, M, CP, S).
'$trace_query'(G, M,_CP,S) :-
'$is_metapredicate'(G, prolog),
!,
'$debugger_expand_meta_call'(M:G, [], G1),
strip_module(M:G1, MF, NG),
% spy a literal
'$id_goal'(L),
catch(
'$trace_goal'(NG, MF, L, S),
E,
'$TraceError'(E, G, M, L, S)
).
'$trace_query'(G, M, _CP, H) :-
% spy a literal
'$id_goal'(L),
catch(
'$trace_goal'(G, M, L, H),
E,
'$TraceError'(E, G, M, L, H)
).
'$trace_goal'(G0, M0, S, CP ).
'$trace_goal'((A,B), M, S, CP) :- !,
'$trace_goal'(A, M, S, CP),
'$trace_goal'(B, M, S, CP).
'$trace_goal'((A->B), M, S, CP) :- !,
'$trace_goal'(A, M, S, CP) ->
'$trace_goal'(B, M, S, CP).
'$trace_goal'((A;B), M, S, CP) :- !,
'$trace_goal'(A, M, S, CP);
'$trace_goal'(B, M, S, CP).
'$trace_goal'((A|B), M, S, CP) :- !,
'$trace_goal'(A, M, S, CP);
'$trace_goal'(B, M, S, CP).
'$trace_goal'((\+ A), M, S, CP) :- !,
'$trace_goal'(A, M, S, CP).
%% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo)
%%
@ -465,8 +458,8 @@ be lost.
),
!,
gated_call(
'$start_user_code',
'$execute'(G,M),
'$set_debugger_state'(debug, false),
'$execute_nonstop'(G,M),
Port,
'$reenter_debugger'(Port)
).
@ -475,8 +468,7 @@ be lost.
'$creep_is_off'(M:G, GoalNumber),
!,
gated_call(
'$start_user_code',
% try creeping
'$set_debugger_state'(debug, false),
'$execute_nonstop'(G,M),
Port,
'$trace_port_'( Port, GoalNumber, G, M, H)
@ -617,7 +609,7 @@ be lost.
%%% - abort: forward throw while the call is newer than goal
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID )
%% @pred '$re_trace_goal'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
@ -678,7 +670,7 @@ be lost.
Goal.
'$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap
'__NB_getval__'('$debug_state',state(leap,Border,_,_), fail),
'$get_debugger_state'( leap,Border,_,_), fail ,
GoalNumber < Border,
!.
'$port'(P,G,Module,L,Deterministic, Info) :-
@ -720,7 +712,7 @@ be lost.
'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %'
'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
% the same as fail.
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'10000 =:= 0. %'
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'10000 =:= 0. %
'$debugger_write'(Stream, G) :-
current_prolog_flag( debugger_print_options, OUT ), !,
@ -733,7 +725,7 @@ be lost.
'$action'(C,P,CallNumber,G,Module,H).
'$action'('\n',_,_,_,_,_) :- !, % newline creep
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(creep, 0, stop, Trace)).
'$set_debugger_state'( creep, 0, stop, Trace ).
'$action'(!,_,_,_,_,_) :- !, % ! 'g execute
read(debugger_input, G),
% don't allow yourself to be caught by creep.
@ -750,7 +742,7 @@ be lost.
!, % <'Depth
skip( debugger_input, 10),
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(creep, 0, stop,Trace)).
'$set_debugger_state'( creep, 0, stop,Trace).
'$action'(^,_,_,G,_,_) :- !, % '
'$print_deb_sterm'(G),
skip( debugger_input, 10),
@ -771,7 +763,7 @@ be lost.
'$action'(c,_,_,_,_,_) :- !, % 'c creep
skip( debugger_input, 10),
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state',status(creep,0,stop,Trace)).
'$set_debugger_state'( creep,0,stop,Trace ).
'$action'(e,_,_,_,_,_) :- !, % 'e exit
halt.
'$action'(f,_,CallNumber,_,_,_) :- !, % 'f fail
@ -806,22 +798,22 @@ be lost.
'$scan_number'(ScanNumber),
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(leap, Goal, stop,Trace)).
'$set_debugger_state'( leap, Goal, stop,Trace ).
'$action'(z,_,_allNumber,_,_,_H) :- !, % 'z zip, fast leap
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, 0, stop, Trace)).
'$set_debugger_state'( zip, 0, stop, Trace).
% skip first call (for current goal),
% stop next time.
'$action'(k,_,_CallNumber,_,_,_) :- !, % 'k zip, fast leap
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, 0, stop, Trace)).
'$set_debugger_state'( zip, 0, stop, Trace).
% skip first call (for current goal),
% stop next time.
'$action'(n,_,_,_,_,_) :- !, % 'n nodebug
skip( debugger_input, 10), % '
% tell debugger never to stop.
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, 0, ignore, Trace)),
'$set_debugger_state'( zip, 0, ignore, Trace),
nodebug.
'$action'(r,_,CallNumber,_,_,_) :- !, % r retry
'$scan_number'(ScanNumber),
@ -832,7 +824,7 @@ be lost.
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P==call; P==redo) ->
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(leap, Goal, ignore,Trace) ) ;
'$set_debugger_state'( leap, Goal, ignore,Trace),
'$ilgl'(s) % '
).
'$action'(t,P,CallNumber,_,_,_) :- !, % 't fast skip
@ -840,7 +832,7 @@ be lost.
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P=call; P=redo) ->
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(zip, Goal, ignore,Trace)) ;
'$set_debugger_state'( zip, Goal, ignore,Trace),
'$ilgl'(t) % '
).
'$action'(q,P,CallNumber,_,_,_) :- !, % 'qst skip
@ -848,7 +840,7 @@ be lost.
( ScanNumber == 0 -> Goal = CallNumber ; Goal = ScanNumber ),
( (P=call; P=redo) ->
'__NB_getval__'('$trace',Trace,fail),
'__NB_setval__'('$debug_state', state(leap, Goal, stop, Trace)) ;
'$set_debugger_state'( leap, Goal, stop, Trace),
'$ilgl'(t) % '
).
'$action'(+,_,_,G,M,_) :- !, %% spy this
@ -1019,11 +1011,11 @@ be lost.
'$cps'([]).
'$debugger_skip_trace_query'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_),
'$debugger_skip_trace_goal'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_goal',4,(_;_),_),
!,
'$debugger_skip_trace_query'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs).
'$debugger_skip_trace_goal'(CPs,CPs1).
'$debugger_skip_trace_goal'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_),
@ -1069,10 +1061,5 @@ be lost.
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$creep'(creep) :- '$creep'.
'$creep'(leap) :- '$creep'.
'$creep'(zip).
%% @}
%% @}

View File

@ -248,7 +248,7 @@ top_query(G) :-
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
'__NB_setval__'('$trace',off),
nb_setval('$debug_state', state(zip, 0, stop,off)),
'$set_debugger_state'( zip, 0, stop,off),
set_prolog_flag(break_level, 0),
catch(user:G, Error, '$Error'(Error)).

View File

@ -46,11 +46,15 @@ prolog:'$protect' :-
'$is_system_module'(M),
functor(P,Name,Arity),
'$new_system_predicate'(Name,Arity,M),
sub_atom(Name,0,1,_, '$'),
functor(P,Name,Arity),
'$stash_predicate'(P,M),
% '$hide_predicate'(P,M),
fail.
prolog:'$protect' :-
'$current_predicate'(Name,M,P,_),
'$is_system_module'(M),
functor(P,Name,Arity),
\+ '$visible'(Name),
'$set_private'(P,M),
fail.
prolog:'$protect' :-
current_atom(Name),
sub_atom(Name,0,1,_, '$'),

View File

@ -206,11 +206,10 @@ debug :-
'$start_user_code' :-
yap_flag(debug, Can),
'__NB_setval__'(debug, Can),
'$set_debugger_state'(debug, Can),
'__NB_getval__'('$trace',Trace, fail),
( Trace == on -> Creep = creep; Creep = zip ),
'__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ).
'$set_debugger_state'( Creep, 0, stop, Trace ).
nodebug :-
set_prolog_flag(debug, false),
'$init_debugger',
@ -378,13 +377,13 @@ notrace(G) :-
).
'$creep_at_port'(retry) :-
'__NB_getval__'(debug, true, fail),
'$get_debugger_state'(debug, true),
'__NB_getval__'('$trace',Trace,fail),
Trace = on,
!,
'$enable_debugging'.
'$creep_at_port'(fail) :-
'__NB_getval__'(debug, true, fail),
'$get_debugger_state'(debug, true),
'__NB_getval__'('$trace',Trace,fail),
Trace = on,
!,
@ -400,10 +399,10 @@ notrace(G) :-
'$init_debugger_trace' :-
'__NB_getval__'('$trace',on,fail),
!,
nb_setval('$debug_state', state(creep, 0, stop, on)).
'$set_debugger_state'( creep, 0, stop, on ).
'$init_debugger_trace' :-
'__NB_setval__'('$trace',off),
nb_setval('$debug_state', state(zip, 0, stop, off)).
'$set_debugger_state'( zip, 0, stop, off ).
%% @pred $enter_debugging(G,Mod,CP,G0,NG)
%%
@ -448,7 +447,7 @@ notrace(G) :-
'$reenter_debugger'(fail) :-
'$re_enter_creep_mode'.
'$reenter_debugger'(_) :-
'__NB_setval__'(debug, false).
'$set_debugger_state'(debug, false).
% what to do when you exit the debugger.
'$continue_debugging'(exit) :-
@ -486,29 +485,29 @@ notrace(G) :-
current_prolog_flag( debug, false )
-> true
;
'$is_opaque_zpredicate'(G,Module)
'$is_opaque_predicate'(G,Module)
-> true
;
'$is_private'(G,Module)
-> true
;
'__NB_getval__'('$debug_state',state(zip, GN, Spy,_), fail)
->
'$get_debugger_state'( creep, zip ) ->
true
;
'$pred_being_spied'(G,Module)
->
Spy == ignore
'$get_debugger_state'( spy, ignore )
;
var(GN)
->
false
;
GN > GoalNo
'$get_debugger_state'( goal_number, GoalNo ) ,
GN < GoalNo
).
'$creep_is_on_at_entry'(G,M,_GoalNo) :-
\+ '$is_system_predicate'(G,M),
'__NB_getval__'('$debug_state',state(Step, _GN, Spy,_), fail),
'$get_debugger_state'(Step, _GN, Spy,_),
(
Step \= zip
;
@ -518,13 +517,14 @@ notrace(G) :-
'$trace_on' :-
'__NB_getval__'('$debug_state', state(_Creep, GN, Spy,Trace), fail),
'$get_debugger_state'(_Creep, GN, Spy,Trace),
nb_setval('$trace',on),
nb_setval('$debug_state', state(creep, GN, Spy, Trace)).
'$set_debugger_state'( creep, GN, Spy, Trace).
'$trace_off' :-
'__NB_getval__'('$debug_state', state(_Creep, GN, Spy, Trace),fail),
nb_setval('$debug_state', state(zip, GN, Spy,Trace)).
'$get_debugger_state'( _Creep, GN, Spy, Trace),
nb_setval('$trace',off),
'$set_debugger_state'( creep, GN, Spy, Trace).
/*

View File

@ -44,7 +44,7 @@ live :-
/* main execution loop */
'$read_toplevel'(Goal, Bindings, Pos) :-
'$prompt',
'$prompt',
catch(read_term(user_input,
Goal,
@ -577,18 +577,9 @@ write_query_answer( Bindings ) :-
'$current_choice_point'(CP),
'$call'(G, CP, G, M).
'$user_call'(G, CP, G0, M) :-
catch('$trace_query'(G, M, CP, G0), E, '$Error'(E)).
'$user_call'(G, M) :-
(
'$creep_is_off'(Module:G, GoalNo)
->
gated_call('$start_user_code',call(M:G),Port,'$reenter_debugger'(Port))
;
'$trace'(M:G)
).
'$current_choice_point'(CP),
gated_call('$start_user_code',M:G,Port,'$reenter_debugger'(Port)).
'$cut_by'(CP) :- '$$cut_by'(CP).
@ -1017,7 +1008,7 @@ log_event( String, Args ) :-
DBON = true
->
(
'__NB_getval__'('$debug_state',state( _, _, _,on), fail),
'$get_debugger_state'( trace,on),
(
var(LF)
->