From 046cb5f8d6b079dddeed535ec8244e780dc1321b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 8 Feb 2013 10:36:45 -0600 Subject: [PATCH] debugging --- C/absmi.c | 26 ---- C/c_interface.c | 23 +-- C/cdmgr.c | 1 + C/exec.c | 77 +++------- C/signals.c | 381 ++++++++++++++++++++++++++++++++++++++++++++++ C/stdpreds.c | 225 +-------------------------- C/sysbits.c | 203 ------------------------ H/Yapproto.h | 7 +- pl/attributes.yap | 8 +- pl/boot.yap | 105 +++++++------ pl/consult.yap | 8 +- pl/control.yap | 31 ---- pl/debug.yap | 114 ++++++++------ pl/errors.yap | 8 +- pl/hacks.yap | 1 + pl/modules.yap | 2 +- pl/signals.yap | 131 ++-------------- 17 files changed, 573 insertions(+), 778 deletions(-) create mode 100644 C/signals.c diff --git a/C/absmi.c b/C/absmi.c index f64ef6ae6..8a95d799c 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -512,26 +512,6 @@ Term Yap_XREGS[MaxTemps]; /* 29 */ #include "arith2.h" -/* - I can creep if I am not a prolog builtin that has been called - by a prolog builtin, - exception: meta-calls -*/ -static PredEntry * -creep_allowed(PredEntry *p, PredEntry *p0) -{ - if (!p0) - return NULL; - if (p0 == PredMetaCall) - return p0; - if (!p0->ModuleOfPred && - (!p || - !p->ModuleOfPred || - p->PredFlags & StandardPredFlag)) - return NULL; - return p; -} - #ifdef COROUTINING /* Imagine we are interrupting the execution, say, because we have a spy @@ -2868,11 +2848,6 @@ Yap_absmi(int inp) CreepFlag = CalculateStackGap(); goto fail; } - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { - PredEntry *ap = PREG->u.Osbpp.p; - SREG = (CELL *) ap; - goto creepc; - } SREG = (CELL *) PREG->u.Osbpp.p; if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) { SET_ASP(YREG, PREG->u.Osbpp.s); @@ -3331,7 +3306,6 @@ Yap_absmi(int inp) /* tell whether we can creep or not, this is hard because we will lose the info RSN */ - PP = creep_allowed((PredEntry*)SREG,PP); BEGD(d0); d0 = ((PredEntry *)(SREG))->ArityOfPE; if (d0 == 0) { diff --git a/C/c_interface.c b/C/c_interface.c index e5952e877..27b85ceac 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -3240,28 +3240,29 @@ X_API int YAP_Reset(void) { CACHE_REGS + int res = TRUE; #ifndef THREADS int worker_id = 0; #endif BACKUP_MACHINE_REGS(); + YAP_ClearExceptions(); /* first, backtrack to the root */ - if (B != NULL) { - while (B->cp_b != NULL) - B = B->cp_b; + while (B->cp_b) { + B = B->cp_b; P = FAILCODE; - if (Yap_exec_absmi(0) != 0) { - GLOBAL_Initialised = TRUE; - - Yap_InitYaamRegs( worker_id ); - RECOVER_MACHINE_REGS(); - return FALSE; - } + res = Yap_exec_absmi(0); } /* reinitialise the engine */ // Yap_InitYaamRegs( worker_id ); GLOBAL_Initialised = TRUE; - + ENV = LCL0; + ASP = B; + /* the first real choice-point will also have AP=FAIL */ + /* always have an empty slots for people to use */ + CurSlot = 0; + Yap_StartSlots( PASS_REGS1 ); + P = CP = YESCODE; RECOVER_MACHINE_REGS(); return(TRUE); } diff --git a/C/cdmgr.c b/C/cdmgr.c index 4e0ab65ba..9dd938664 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -5667,6 +5667,7 @@ p_cpc_info( USES_REGS1 ) PredEntry *pe; yamop *ipc = (yamop *)IntegerOfTerm(Deref(ARG1)); + printf("ipc = %p %p\n", ipc, PREVOP(ipc,Osbpp)); pe = PREVOP(ipc,Osbpp)->u.Osbpp.p0; return UnifyPredInfo(pe, 2 PASS_REGS) && Yap_unify(ARG5,MkIntegerTerm(ClauseId(ipc,pe))); diff --git a/C/exec.c b/C/exec.c index 9c2a16a7f..c8b0458ff 100644 --- a/C/exec.c +++ b/C/exec.c @@ -165,8 +165,8 @@ do_execute(Term t, Term mod USES_REGS) if (PRED_GOAL_EXPANSION_ALL) { LOCK(LOCAL_SignalLock); /* disable creeping when we do goal expansion */ - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) { - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) { + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); CreepFlag = CalculateStackGap(); } UNLOCK(LOCAL_SignalLock); @@ -337,8 +337,8 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS) if (PRED_GOAL_EXPANSION_ALL) { LOCK(LOCAL_SignalLock); /* disable creeping when we do goal expansion */ - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) { - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) { + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); CreepFlag = CalculateStackGap(); } UNLOCK(LOCAL_SignalLock); @@ -391,12 +391,16 @@ EnterCreepMode(Term t, Term mod USES_REGS) { return do_execute(ARG1, mod PASS_REGS); } } - PP = PredMetaCall; PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1)); - if (mod) { - ARG1 = MkPairTerm(mod,t); + PP = PredCreep; + if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) { + ARG1 = MkPairTerm(ArgOfTerm(1,t),ArgOfTerm(2,t)); } else { - ARG1 = MkPairTerm(TermProlog,t); + if (mod) { + ARG1 = MkPairTerm(mod,t); + } else { + ARG1 = MkPairTerm(TermProlog,t); + } } LOCK(LOCAL_SignalLock); CreepFlag = CalculateStackGap(); @@ -635,7 +639,8 @@ p_execute_clause( USES_REGS1 ) } else { code = Yap_ClauseFromTerm(clt)->ClCode; } - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { + if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) { + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL); } return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS); @@ -650,7 +655,7 @@ p_execute_in_mod( USES_REGS1 ) static Int p_do_goal_expansion( USES_REGS1 ) { - Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL; + Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); Int out = FALSE; PredEntry *pe; Term cmod = Deref(ARG2); @@ -658,7 +663,7 @@ p_do_goal_expansion( USES_REGS1 ) ARG2 = ARG3; /* disable creeping */ LOCK(LOCAL_SignalLock); - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); if (!LOCAL_ActiveSignals) CreepFlag = CalculateStackGap(); UNLOCK(LOCAL_SignalLock); @@ -713,14 +718,14 @@ p_do_goal_expansion( USES_REGS1 ) static Int p_do_term_expansion( USES_REGS1 ) { - Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL; + Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); Int out = FALSE; PredEntry *pe; Term cmod = CurrentModule; /* disable creeping */ LOCK(LOCAL_SignalLock); - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); if (!LOCAL_ActiveSignals) CreepFlag = CalculateStackGap(); UNLOCK(LOCAL_SignalLock); @@ -896,7 +901,8 @@ p_execute_nonstop( USES_REGS1 ) /* N = arity; */ /* call may not define new system predicates!! */ if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) { + if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) { + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); Yap_signal(YAP_CREEP_SIGNAL); } #if defined(YAPOR) || defined(THREADS) @@ -1771,12 +1777,9 @@ Yap_InitYaamRegs( int myworker_id ) #endif /* FROZEN_STACKS */ LOCK(REMOTE_SignalLock(myworker_id)); CreepFlag = CalculateStackGap(); - UNLOCK(REMOTE_SignalLock(myworker_id)); - Yap_PrepGoal(0, NULL, NULL PASS_REGS); /* the first real choice-point will also have AP=FAIL */ /* always have an empty slots for people to use */ CurSlot = 0; - Yap_StartSlots( PASS_REGS1 ); REMOTE_GlobalArena(myworker_id) = TermNil; h0var = MkVarTerm(); #if defined(YAPOR) || defined(THREADS) @@ -1802,11 +1805,14 @@ Yap_InitYaamRegs( int myworker_id ) #if defined MYDDAS_MYSQL || defined MYDDAS_ODBC Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL; #endif + Yap_PrepGoal(0, NULL, NULL PASS_REGS); + Yap_StartSlots( 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 + UNLOCK(REMOTE_SignalLock(myworker_id)); } static Int @@ -1817,41 +1823,6 @@ p_uncaught_throw( USES_REGS1 ) return out; } -static Int -p_creep_allowed( USES_REGS1 ) -{ - if (PP != NULL) { - LOCK(LOCAL_SignalLock); - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) { - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; - if (!LOCAL_ActiveSignals) - CreepFlag = CalculateStackGap(); - UNLOCK(LOCAL_SignalLock); - } else { - UNLOCK(LOCAL_SignalLock); - } - return TRUE; - } - return FALSE; -} - -static Int -p_debug_on( USES_REGS1 ) -{ - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - if (LOCAL_DebugOn) - return Yap_unify(MkAtomTerm(AtomTrue),ARG1); - else - return Yap_unify(MkAtomTerm(AtomFalse),ARG1); - } - if (t == MkAtomTerm(AtomTrue)) - LOCAL_DebugOn = TRUE; - else - LOCAL_DebugOn = FALSE; - return TRUE; -} - Term Yap_GetException(void) { @@ -1939,7 +1910,6 @@ Yap_InitExecFs(void) Yap_InitCPred("call_with_args", 9, p_execute_8, 0); Yap_InitCPred("call_with_args", 10, p_execute_9, 0); Yap_InitCPred("call_with_args", 11, p_execute_10, 0); - Yap_InitCPred("$debug_on", 1, p_debug_on, 0); #ifdef DEPTH_LIMIT Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0); #endif @@ -1959,7 +1929,6 @@ Yap_InitExecFs(void) Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag); Yap_InitCPred("qpack_clean_up_to_disjunction", 0, p_cut_up_to_next_disjunction, SafePredFlag); Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0); - Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0); Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0); Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0); Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0); diff --git a/C/signals.c b/C/signals.c new file mode 100644 index 000000000..0a6aea138 --- /dev/null +++ b/C/signals.c @@ -0,0 +1,381 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- * +* * +************************************************************************** +* * +* File: signal.c * +* comments: Signal Handling & Debugger Support * +* * +* * +* * +*************************************************************************/ +#ifdef SCCS +static char SccsId[] = "%W% %G%"; +#endif + +#define HAS_CACHE_REGS 1 + +#include "Yap.h" +#include "Yatom.h" +#include "YapHeap.h" +#include "eval.h" +#include "yapio.h" +#ifdef TABLING +#include "tab.macros.h" +#endif /* TABLING */ +#include +#if HAVE_STRING_H +#include +#endif +#if HAVE_MALLOC_H +#include +#endif +#include + +inline static void +do_signal(yap_signals sig USES_REGS) +{ + LOCK(LOCAL_SignalLock); + if (!LOCAL_InterruptsDisabled) + CreepFlag = Unsigned(LCL0); + LOCAL_ActiveSignals |= sig; + UNLOCK(LOCAL_SignalLock); +} + +inline static void +undo_signal(yap_signals sig USES_REGS) +{ + LOCK(LOCAL_SignalLock); + if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) == sig) { + CreepFlag = CalculateStackGap(); + } + LOCAL_ActiveSignals &= ~sig; + UNLOCK(LOCAL_SignalLock); +} + +static Int +p_creep( USES_REGS1 ) +{ + Atom at; + PredEntry *pred; + + at = AtomCreep; + pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); + CreepCode = pred; + do_signal(YAP_CREEP_SIGNAL PASS_REGS); + return TRUE; +} + +static Int +p_stop_creeping( USES_REGS1 ) +{ + Atom at; + PredEntry *pred; + + LOCK(LOCAL_SignalLock); + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); + if (!LOCAL_ActiveSignals) { + CreepFlag = CalculateStackGap(); + } + UNLOCK(LOCAL_SignalLock); + return TRUE; +} + +static Int +p_meta_creep( USES_REGS1 ) +{ + Atom at; + PredEntry *pred; + + at = AtomCreep; + pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); + CreepCode = pred; + LOCK(LOCAL_SignalLock); + LOCAL_ActiveSignals |= YAP_DELAY_CREEP_SIGNAL; + UNLOCK(LOCAL_SignalLock); + return TRUE; +} + +static Int +p_creep_allowed( USES_REGS1 ) +{ + if (PP != NULL) { + LOCK(LOCAL_SignalLock); + if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL && !LOCAL_InterruptsDisabled) { + LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; + if (!LOCAL_ActiveSignals) + CreepFlag = CalculateStackGap(); + UNLOCK(LOCAL_SignalLock); + } else { + UNLOCK(LOCAL_SignalLock); + } + return TRUE; + } + return FALSE; +} + +static Int +p_debug_on( USES_REGS1 ) +{ + Term t = Deref(ARG1); + if (IsVarTerm(t)) { + if (LOCAL_DebugOn) + return Yap_unify(MkAtomTerm(AtomTrue),ARG1); + else + return Yap_unify(MkAtomTerm(AtomFalse),ARG1); + } + if (t == MkAtomTerm(AtomTrue)) + LOCAL_DebugOn = TRUE; + else + LOCAL_DebugOn = FALSE; + return TRUE; +} + + +void +Yap_signal(yap_signals sig) +{ + CACHE_REGS + do_signal(sig PASS_REGS); +} + +void +Yap_undo_signal(yap_signals sig) +{ + CACHE_REGS + undo_signal(sig PASS_REGS); +} + +#ifdef DEBUG +static Int +p_debug( USES_REGS1 ) +{ /* $debug(+Flag) */ + int i = IntOfTerm(Deref(ARG1)); + + if (i >= 'a' && i <= 'z') + GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96]; + return (1); +} +#endif + +static Int +p_first_signal( USES_REGS1 ) +{ + LOCK(LOCAL_SignalLock); +#ifdef THREADS + pthread_mutex_lock(&(LOCAL_ThreadHandle.tlock)); +#endif + /* always do wakeups first, because you don't want to keep the + non-backtrackable variable bad */ + if (LOCAL_ActiveSignals & YAP_WAKEUP_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_WAKEUP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigWakeUp)); + } + if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_ITI_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigIti)); + } + if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_INT_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigInt)); + } + if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_USR2_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr2)); + } + if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_USR1_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr1)); + } + if (LOCAL_ActiveSignals & YAP_PIPE_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_PIPE_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigPipe)); + } + if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_HUP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigHup)); + } + if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL; + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigAlarm)); + } + if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_VTALARM_SIGNAL; + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm)); + } + if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) { + LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigDelayCreep)); + } + if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigCreep)); + } + if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_TRACE_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigTrace)); + } + if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_DEBUG_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigDebug)); + } + if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_BREAK_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigBreak)); + } + if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_STACK_DUMP_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigStackDump)); + } + if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_STATISTICS_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigStatistics)); + } + if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) { + LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL; +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomFail)); + } +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + UNLOCK(LOCAL_SignalLock); + return FALSE; +} + +static Int +p_continue_signals( USES_REGS1 ) +{ + /* hack to force the signal anew */ + if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) { + Yap_signal(YAP_ITI_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) { + Yap_signal(YAP_INT_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) { + Yap_signal(YAP_USR2_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) { + Yap_signal(YAP_USR1_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) { + Yap_signal(YAP_HUP_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) { + Yap_signal(YAP_ALARM_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) { + Yap_signal(YAP_VTALARM_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { + Yap_signal(YAP_CREEP_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) { + Yap_signal(YAP_DELAY_CREEP_SIGNAL|YAP_CREEP_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) { + Yap_signal(YAP_TRACE_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) { + Yap_signal(YAP_DEBUG_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) { + Yap_signal(YAP_BREAK_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) { + Yap_signal(YAP_STACK_DUMP_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) { + Yap_signal(YAP_STATISTICS_SIGNAL); + } + if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) { + Yap_signal(YAP_FAIL_SIGNAL); + } +#ifdef THREADS + pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); +#endif + return TRUE; +} + +void +Yap_InitSignalCPreds(void) +{ + /* Basic predicates for the debugger */ + Yap_InitCPred("$creep", 0, p_creep, SafePredFlag); + Yap_InitCPred("$meta_creep", 0, p_meta_creep, SafePredFlag); + Yap_InitCPred("$stop_creeping", 0, p_stop_creeping, SafePredFlag); + Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$debug_on", 1, p_debug_on, 0); + Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, 0); +#ifdef DEBUG + Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag); +#endif +} diff --git a/C/stdpreds.c b/C/stdpreds.c index 8345ab901..eaeb66e2d 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -474,207 +474,6 @@ p_values( USES_REGS1 ) return (TRUE); } -inline static void -do_signal(yap_signals sig USES_REGS) -{ - LOCK(LOCAL_SignalLock); - if (!LOCAL_InterruptsDisabled) - CreepFlag = Unsigned(LCL0); - LOCAL_ActiveSignals |= sig; - UNLOCK(LOCAL_SignalLock); -} - -inline static void -undo_signal(yap_signals sig USES_REGS) -{ - LOCK(LOCAL_SignalLock); - if (LOCAL_ActiveSignals == sig) { - CreepFlag = CalculateStackGap(); - } - LOCAL_ActiveSignals &= ~sig; - UNLOCK(LOCAL_SignalLock); -} - - -static Int -p_creep( USES_REGS1 ) -{ - Atom at; - PredEntry *pred; - - at = AtomCreep; - pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); - CreepCode = pred; - do_signal(YAP_CREEP_SIGNAL PASS_REGS); - return TRUE; -} - -static Int -p_signal_creep( USES_REGS1 ) -{ - Atom at; - PredEntry *pred; - - at = AtomCreep; - pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); - CreepCode = pred; - LOCK(LOCAL_SignalLock); - LOCAL_ActiveSignals |= YAP_CREEP_SIGNAL; - UNLOCK(LOCAL_SignalLock); - return TRUE; -} - -static Int -p_disable_creep( USES_REGS1 ) -{ - LOCK(LOCAL_SignalLock); - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; - if (!LOCAL_ActiveSignals) - CreepFlag = CalculateStackGap(); - UNLOCK(LOCAL_SignalLock); - return TRUE; - } - UNLOCK(LOCAL_SignalLock); - return FALSE; -} - -/* never fails */ -static Int -p_disable_docreep( USES_REGS1 ) -{ - LOCK(LOCAL_SignalLock); - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; - if (!LOCAL_ActiveSignals) - CreepFlag = CalculateStackGap(); - UNLOCK(LOCAL_SignalLock); - } else { - UNLOCK(LOCAL_SignalLock); - } - return TRUE; -} - -static Int -p_stop_creep( USES_REGS1 ) -{ - LOCK(LOCAL_SignalLock); - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; - if (!LOCAL_ActiveSignals) { - CreepFlag = CalculateStackGap(); - } - UNLOCK(LOCAL_SignalLock); - return TRUE; -} - -void -Yap_signal(yap_signals sig) -{ - CACHE_REGS - do_signal(sig PASS_REGS); -} - -void -Yap_undo_signal(yap_signals sig) -{ - CACHE_REGS - undo_signal(sig PASS_REGS); -} - -#ifdef undefined - -/* - * Returns where some particular piece of code is, it may take its time but - * then you only need it while creeping, so why bother ? - */ -static CODEADDR * -FindAtom(codeToFind, arity) - CODEADDR codeToFind; - unsigned int *arityp; -{ - Atom a; - int i; - - for (i = 0; i < AtomHashTableSize; ++i) { - READ_LOCK(HashChain[i].AeRWLock); - a = HashChain[i].Entry; - READ_UNLOCK(HashChain[i].AeRWLock); - while (a != NIL) { - register PredEntry *pp; - AtomEntry *ae = RepAtom(a); - READ_LOCK(ae->ARWLock); - pp = RepPredProp(RepAtom(a)->PropsOfAE); - while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000) - || (pp->CodeOfPred != codeToFind))) - pp = RepPredProp(pp->NextOfPE); - if (pp != NIL) { - CODEADDR *out; - PELOCK(90,pp); - out = &(pp->CodeOfPred) - *arityp = pp->ArityOfPE; - UNLOCK(pp->PELock); - READ_UNLOCK(ae->ARWLock); - return (out); - } - a = RepAtom(a)->NextOfAE; - READ_UNLOCK(ae->ARWLock); - } - } - for (i = 0; i < WideAtomHashTableSize; ++i) { - READ_LOCK(HashChain[i].AeRWLock); - a = HashChain[i].Entry; - READ_UNLOCK(HashChain[i].AeRWLock); - while (a != NIL) { - register PredEntry *pp; - AtomEntry *ae = RepAtom(a); - READ_LOCK(ae->ARWLock); - pp = RepPredProp(RepAtom(a)->PropsOfAE); - while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000) - || (pp->CodeOfPred != codeToFind))) - pp = RepPredProp(pp->NextOfPE); - if (pp != NIL) { - CODEADDR *out; - PELOCK(91,pp); - out = &(pp->CodeOfPred) - *arityp = pp->ArityOfPE; - UNLOCK(pp->PELock); - READ_UNLOCK(ae->ARWLock); - return (out); - } - a = RepAtom(a)->NextOfAE; - READ_UNLOCK(ae->ARWLock); - } - } - *arityp = 0; - return (0); -} - -/* - * This is called when you want to creep a C-predicate or a predicate written - * in assembly - */ -CELL -FindWhatCreep(toCreep) - CELL toCreep; -{ - unsigned int arity; - Atom at; - CODEADDR *place; - - if (toCreep > 64) { /* written in C */ - int i; - place = FindAtom((CODEADDR) toCreep, &arity); - *--ASP = Unsigned(P); - *--ASP = N = arity; - for (i = 1; i <= arity; ++i) - *--ASP = X[i]; - /* P = CellPtr(CCREEPCODE); */ - return (Unsigned(place)); - } -} - -#endif /* undefined */ - static Int p_opdec( USES_REGS1 ) { /* '$opdec'(p,type,atom) */ @@ -3466,18 +3265,6 @@ init_current_atom_op( USES_REGS1 ) return cont_current_atom_op( PASS_REGS1 ); } -#ifdef DEBUG -static Int -p_debug( USES_REGS1 ) -{ /* $debug(+Flag) */ - int i = IntOfTerm(Deref(ARG1)); - - if (i >= 'a' && i <= 'z') - GLOBAL_Option[i - 96] = !GLOBAL_Option[i - 96]; - return (1); -} -#endif - static Int p_flags( USES_REGS1 ) { /* $flags(+Functor,+Mod,?OldFlags,?NewFlags) */ @@ -4441,17 +4228,6 @@ Yap_InitCPreds(void) Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag); Yap_InitCPred("$enter_undefp", 0, p_enterundefp, SafePredFlag); Yap_InitCPred("$exit_undefp", 0, p_exitundefp, SafePredFlag); - /* basic predicates for the prolog machine tracer */ - /* they are defined in analyst.c */ - /* Basic predicates for the debugger */ - Yap_InitCPred("$creep", 0, p_creep, SafePredFlag); - Yap_InitCPred("$signal_creep", 0, p_signal_creep, SafePredFlag); - Yap_InitCPred("$disable_creep", 0, p_disable_creep, SafePredFlag); - Yap_InitCPred("$disable_docreep", 0, p_disable_docreep, SafePredFlag); - Yap_InitCPred("$do_not_creep", 0, p_stop_creep, SafePredFlag|SyncPredFlag); -#ifdef DEBUG - Yap_InitCPred("$debug", 1, p_debug, SafePredFlag|SyncPredFlag); -#endif /* Accessing and changing the flags for a predicate */ Yap_InitCPred("$flags", 4, p_flags, SyncPredFlag); /* hiding and unhiding some predicates */ @@ -4510,6 +4286,7 @@ Yap_InitCPreds(void) #endif Yap_udi_init(); + Yap_InitSignalCPreds(); Yap_InitUserCPreds(); Yap_InitUtilCPreds(); Yap_InitSortPreds(); diff --git a/C/sysbits.c b/C/sysbits.c index 4725607c6..9e26c9add 100755 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -2804,207 +2804,6 @@ Yap_ReInitWallTime (void) InitLastWtime(); } -static Int -p_first_signal( USES_REGS1 ) -{ - LOCK(LOCAL_SignalLock); -#ifdef THREADS - pthread_mutex_lock(&(LOCAL_ThreadHandle.tlock)); -#endif - /* always do wakeups first, because you don't want to keep the - non-backtrackable variable bad */ - if (LOCAL_ActiveSignals & YAP_WAKEUP_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_WAKEUP_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigWakeUp)); - } - if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_ITI_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigIti)); - } - if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_INT_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigInt)); - } - if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_USR2_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr2)); - } - if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_USR1_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigUsr1)); - } - if (LOCAL_ActiveSignals & YAP_PIPE_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_PIPE_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigPipe)); - } - if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_HUP_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigHup)); - } - if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_ALARM_SIGNAL; - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigAlarm)); - } - if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_VTALARM_SIGNAL; - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm)); - } - if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) { - LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigDelayCreep)); - } - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigCreep)); - } - if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_TRACE_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigTrace)); - } - if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_DEBUG_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigDebug)); - } - if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_BREAK_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigBreak)); - } - if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_STACK_DUMP_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigStackDump)); - } - if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_STATISTICS_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomSigStatistics)); - } - if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) { - LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL; -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return Yap_unify(ARG1, MkAtomTerm(AtomFail)); - } -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - UNLOCK(LOCAL_SignalLock); - return FALSE; -} - -static Int -p_continue_signals( USES_REGS1 ) -{ - /* hack to force the signal anew */ - if (LOCAL_ActiveSignals & YAP_ITI_SIGNAL) { - Yap_signal(YAP_ITI_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) { - Yap_signal(YAP_INT_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_USR2_SIGNAL) { - Yap_signal(YAP_USR2_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_USR1_SIGNAL) { - Yap_signal(YAP_USR1_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_HUP_SIGNAL) { - Yap_signal(YAP_HUP_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_ALARM_SIGNAL) { - Yap_signal(YAP_ALARM_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_VTALARM_SIGNAL) { - Yap_signal(YAP_VTALARM_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) { - Yap_signal(YAP_CREEP_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_DELAY_CREEP_SIGNAL) { - Yap_signal(YAP_DELAY_CREEP_SIGNAL|YAP_CREEP_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_TRACE_SIGNAL) { - Yap_signal(YAP_TRACE_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_DEBUG_SIGNAL) { - Yap_signal(YAP_DEBUG_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_BREAK_SIGNAL) { - Yap_signal(YAP_BREAK_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_STACK_DUMP_SIGNAL) { - Yap_signal(YAP_STACK_DUMP_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_STATISTICS_SIGNAL) { - Yap_signal(YAP_STATISTICS_SIGNAL); - } - if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) { - Yap_signal(YAP_FAIL_SIGNAL); - } -#ifdef THREADS - pthread_mutex_unlock(&(LOCAL_ThreadHandle.tlock)); -#endif - return TRUE; -} - static Int p_unix( USES_REGS1 ) { @@ -3295,9 +3094,7 @@ Yap_InitSysPreds(void) Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag); Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$set_fpu_exceptions", 0, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$first_signal", 1, p_first_signal, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$continue_signals", 0, p_continue_signals, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag); Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag); diff --git a/H/Yapproto.h b/H/Yapproto.h index a132d015a..3e273c7f7 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -338,6 +338,11 @@ void STD_PROTO(Yap_InitSavePreds,(void)); /* scanner.c */ +/* signals.c */ +void STD_PROTO(Yap_signal,(yap_signals)); +void STD_PROTO(Yap_undo_signal,(yap_signals)); +void STD_PROTO(Yap_InitSignalPreds,(void)); + /* sort.c */ void STD_PROTO(Yap_InitSortPreds,(void)); @@ -345,8 +350,6 @@ void STD_PROTO(Yap_InitSortPreds,(void)); void STD_PROTO(Yap_InitBackCPreds,(void)); void STD_PROTO(Yap_InitCPreds,(void)); void STD_PROTO(Yap_show_statistics,(void)); -void STD_PROTO(Yap_signal,(yap_signals)); -void STD_PROTO(Yap_undo_signal,(yap_signals)); int STD_PROTO(Yap_IsOpMaxPrio,(Atom)); /* sysbits.c */ diff --git a/pl/attributes.yap b/pl/attributes.yap index 89ad495b3..84078cac4 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -216,14 +216,14 @@ attvar_residuals(att(Module,Value,As), V) --> -> [] ; - { '$notrace'(Module:attribute_goal(V, Goal)) }, + { call(Module:attribute_goal(V, Goal)) }, dot_list(Goal) ) ; ( { current_predicate(Module:attribute_goals/3) } - -> { '$notrace'(Module:attribute_goals(V, Goals, [])) }, + -> { call(Module:attribute_goals(V, Goals, [])) }, list(Goals) ; { current_predicate(Module:attribute_goal/2) } - -> { '$notrace'(Module:attribute_goal(V, Goal)) }, + -> { call(Module:attribute_goal(V, Goal)) }, dot_list(Goal) ; [put_attr(V, Module, Value)] ), @@ -312,7 +312,7 @@ pick_att_vars([_|L],NL) :- project_module([], _, _). project_module([Mod|LMods], LIV, LAV) :- '$pred_exists'(project_attributes(LIV, LAV),Mod), - '$notrace'(Mod:project_attributes(LIV, LAV)), !, + call(Mod:project_attributes(LIV, LAV)), !, attributes:all_attvars(NLAV), project_module(LMods,LIV,NLAV). project_module([_|LMods], LIV, LAV) :- diff --git a/pl/boot.yap b/pl/boot.yap index 3c1ddd51a..410069815 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -220,7 +220,6 @@ true :- true. '$run_atom_goal'(GA), ( '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ). '$enter_top_level' :- - '$disable_docreep', '$run_toplevel_hooks', prompt1(' ?- '), '$read_toplevel'(Command,Varnames), @@ -378,9 +377,7 @@ true :- true. % but YAP and SICStus does. % '$process_directive'(G, _, M, VL, Pos) :- - '$exit_system_mode', - ( '$notrace'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ), - '$enter_system_mode'. + ( '$execute'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ). '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !, '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). @@ -489,10 +486,9 @@ true :- true. '$query'(G,V) :- ( yap_hacks:current_choice_point(CP), - '$exit_system_mode', - '$execute'(G), + '$current_module'(M), + '$execute_outside_system_mode'(G, M), yap_hacks:current_choice_point(NCP), - ( '$enter_system_mode' ; '$exit_system_mode', fail), '$delayed_goals'(G, V, NV, LGs, DCP), '$write_answer'(NV, LGs, Written), '$write_query_answer_true'(Written), @@ -507,7 +503,6 @@ true :- true. ), fail ; - '$enter_system_mode', '$out_neg_answer' ). @@ -516,13 +511,16 @@ true :- true. '$do_yes_no'(G,M), '$delayed_goals'(G, [], NV, LGs, _), '$write_answer'(NV, LGs, Written), - ( Written = [] -> - !,'$present_answer'(C, yes); - '$another', ! + ( + Written = [] + -> + !, + '$present_answer'(C, yes) + ; + '$another', ! ), fail. '$yes_no'(_,_) :- - '$enter_system_mode', '$out_neg_answer'. '$add_env_and_fail' :- fail. @@ -552,11 +550,11 @@ true :- true. ), fail. -'$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M). +'$do_yes_no'([X|L], M) :- + !, + '$csult'([X|L], M). '$do_yes_no'(G, M) :- - '$exit_system_mode', - '$execute'(M:G), - ( '$enter_system_mode' ; '$exit_system_mode', fail). + '$execute_outside_system_mode'(G, M). '$write_query_answer_true'([]) :- !, format(user_error,'~ntrue',[]). @@ -1090,7 +1088,7 @@ bootstrap(F) :- % support SWI hook in a separate predicate, to avoid slow down standard consult. '$enter_command_with_hook'(Stream,Status) :- '$read_vars'(Stream,Command,_,Pos,Vars, '|: ', Comments), - ('$notrace'(prolog:comment_hook(Comments,Pos,Command)) -> true ; true ), + ('$exit_system_mode'(comment_hook(Comments,Pos,Command), prolog) -> true ; true ), '$command'(Command,Vars,Pos,Status). '$abort_loop'(Stream) :- @@ -1236,47 +1234,58 @@ catch_ball(C, C). '$nb_getval'('$break', 0, fail), recorded('$toplevel_hooks',H,_), H \= fail, !, - ( '$oncenotrace'(H) -> true ; true). + ( '$exit_system_mode'(H) -> true ; true). '$run_toplevel_hooks'. '$enter_system_mode' :- + '$stop_creeping', nb_setval('$system_mode',on). +'$in_system_mode' :- + '$nb_getval'('$system_mode',on,fail). + +'$execute_outside_system_mode'(G,M) :- + CP is '$last_choice_pt', + '$execute_outside_system_mode'(G,M,CP). + +'$execute_outside_system_mode'(V,M,_) :- + var(V), !, + call(M:G). +'$execute_outside_system_mode'(M:G, _M, CP) :- !, + '$execute_outside_system_mode'(G, M, CP). +'$execute_outside_system_mode'((G1,G2), M, CP) :- !, + '$execute_outside_system_mode'(G1, M, CP), + '$execute_outside_system_mode'(G2, M, CP). +'$execute_outside_system_mode'((G1;G2), M, CP) :- !, + ( + '$execute_outside_system_mode'(G1, M, CP) + ; + '$execute_outside_system_mode'(G2, M, CP) + ). +'$execute_outside_system_mode'(G, M, CP) :- + nb_getval('$trace', on), !, + '$do_spy'(G, M, CP, no). +'$execute_outside_system_mode'(G, M, CP) :- + ( + yap_hacks:current_choice_point(CP1), + '$exit_system_mode', + '$execute_nonstop'(G,M), + yap_hacks:current_choice_point(CP2), + (CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', fail ) ), + '$enter_system_mode' + ; + '$enter_system_mode', + fail + ). + + '$exit_system_mode' :- nb_setval('$system_mode',off), - ( '$nb_getval'('$trace',on,fail) -> '$creep' ; true). - -% -% just prevent creeping from going on... -% -'$notrace'(G) :- - '$disable_creep', !, - ( - % creep was going on... - yap_hacks:current_choice_point(CP0), - '$execute'(G), - yap_hacks:current_choice_point(CP1), - ( CP0 == CP1 -> - !, - '$creep' - ; - ( - '$creep' - ; - '$disable_docreep', - fail - ) - ) - ; - '$creep', - fail - ). -'$notrace'(G) :- - '$execute'(G). + ( '$nb_getval'('$trace',on,fail) -> '$meta_creep' ; true). '$run_at_thread_start' :- recorded('$thread_initialization',M:D,_), - '$notrace'(M:D), + '$exit_system_mode'(D, M), fail. '$run_at_thread_start'. diff --git a/pl/consult.yap b/pl/consult.yap index e0364f46a..dcf78a9ae 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -394,7 +394,7 @@ initialization(G,OPT) :- '$do_error'(type_error(OPT),initialization(G,OPT)) ). '$initialization'(G,now) :- - ( '$notrace'(G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ). + ( '$exit_system_mode'(G,prolog) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ). '$initialization'(G,after_load) :- '$initialization'(G). % ignore for now. @@ -412,7 +412,7 @@ initialization(G,OPT) :- recorded('$system_initialisation',G,R), erase(R), G \= '$', - '$notrace'(G), + '$exit_system_mode'(G, prolog), fail. '$exec_initialisation_goals' :- '$show_consult_level'(Level), @@ -426,7 +426,7 @@ initialization(G,OPT) :- ( OldMode == on -> '$exit_system_mode' ; true ), % run initialization under user control (so allow debugging this stuff). ( - '$system_catch'('$oncenotrace'(M:G), M, Error, user:'$LoopError'(Error, top)), + '$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)), fail ; OldMode = on, @@ -895,7 +895,7 @@ absolute_file_name(File,Opts,TrueFileName) :- '$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :- - '$notrace'(user:file_search_path(Name, Dir)), + user:file_search_path(Name, Dir), '$extend_pathd'(Dir, D, File, Opts, NewFile, Call). '$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :- diff --git a/pl/control.yap b/pl/control.yap index 52c1a081d..de7665ba1 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -289,37 +289,6 @@ version(T) :- fail. '$set_toplevel_hook'(_). -'$oncenotrace'(G) :- - '$disable_creep', !, - ( - '$execute'(G) - -> - '$creep' - ; - '$creep', - fail - ). -'$oncenotrace'(G) :- - '$execute'(G), !. - - -'$once0'(G, M) :- - '$pred_exists'(G, M), - ( - '$disable_creep' - -> - ( - '$execute_nonstop'(G, M) - -> - '$creep' - ; - '$creep', - fail - ) - ; - '$execute_nonstop'(G,M) - ). - nb_getval(GlobalVariable, Val) :- '$nb_getval'(GlobalVariable, Val, Error), (var(Error) diff --git a/pl/debug.yap b/pl/debug.yap index ffe3d36fe..3dfb6ebf4 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -123,21 +123,21 @@ recorded('$spy','$spy'(G,M),_), !. spy Spec :- - '$notrace'(prolog:debug_action_hook(spy(Spec))), !. + prolog:debug_action_hook(spy(Spec)), !. spy L :- '$current_module'(M), '$suspy'(L, spy, M), fail. spy _ :- debug. nospy Spec :- - '$notrace'(prolog:debug_action_hook(nospy(Spec))), !. + prolog:debug_action_hook(nospy(Spec)), !. nospy L :- '$current_module'(M), '$suspy'(L, nospy, M), fail. nospy _. nospyall :- - '$notrace'(prolog:debug_action_hook(nospyall)), !. + prolog:debug_action_hook(nospyall), !. nospyall :- recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail. nospyall. @@ -173,7 +173,7 @@ trace :- nb_setval('$trace',on), '$start_debugging'(on), print_message(informational,debug(trace)), - '$creep'. + '$meta_creep'. notrace :- nodebug. @@ -283,17 +283,21 @@ debugging :- '$debug_on'(F), F = false, !, '$execute_nonstop'(G,Mod). '$spy'([Mod|G]) :- - nb_getval('$system_mode',on), !, + '$in_system_mode', !, '$execute_nonstop'(G,Mod). '$spy'([Mod|G]) :- CP is '$last_choice_pt', - '$do_spy'(G, Mod, CP, no). + '$do_spy'(G, Mod, CP, spy). % last argument to do_spy says that we are at the end of a context. It % is required to know whether we are controlled by the debugger. -'$do_spy'(V, M, CP, Flag) :- var(V), !, '$do_spy'(call(V), M, CP, Flag). -'$do_spy'(!, _, CP, _) :- !, '$$cut_by'(CP). -'$do_spy'('$cut_by'(M), _, _, _) :- !, '$$cut_by'(M). +'$do_spy'(V, M, CP, Flag) :- + var(V), !, + '$do_spy'(call(V), M, CP, Flag). +'$do_spy'(!, _, CP, _) :- + !, '$$cut_by'(CP). +'$do_spy'('$cut_by'(M), _, _, _) :- + !, '$$cut_by'(M). '$do_spy'(true, _, _, _) :- !. %'$do_spy'(fail, _, _, _) :- !, fail. '$do_spy'(M:G, _, CP, CalledFromDebugger) :- !, @@ -307,7 +311,7 @@ debugging :- '$do_spy'(B, M, CP, CalledFromDebugger) ). '$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !, - ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) + ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, yes) ; '$do_spy'(B, M, CP, CalledFromDebugger) ). @@ -315,13 +319,13 @@ debugging :- ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) ). '$do_spy'((A;B), M, CP, CalledFromDebugger) :- !, ( - '$do_spy'(A, M, CP, yes) + '$do_spy'(A, M, CP, CalledFromDebugger) ; '$do_spy'(B, M, CP, CalledFromDebugger) ). '$do_spy'((A|B), M, CP, CalledFromDebugger) :- !, ( - '$do_spy'(A, M, CP, yes) + '$do_spy'(A, M, CP, CalledFromDebugger) ; '$do_spy'(B, M, CP, CalledFromDebugger) ). @@ -335,7 +339,7 @@ debugging :- nb_setval('$spy_gn',L1), /* and save it globaly */ b_getval('$spy_glist',History), /* get goal list */ b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), /* and update it */ - '$loop_spy'(L, G, Module, CalledFromDebugger). /* set creep on */ + '$loop_spy'(L, G, Module, CalledFromDebugger). % we are skipping, so we can just call the goal, % while leaving the minimal structure in place. @@ -360,7 +364,7 @@ debugging :- throw(error('$fail_spy'(GoalNumber),[])). '$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, G, _, CalledFromDebugger) :- G0 >= GoalNumber, !, - '$continue_debugging'(CalledFromDebugger). + '$continue_debugging'(zip, CalledFromDebugger). '$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !, throw(error('$done_spy'(GoalNumber),[])). '$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger) :- @@ -380,8 +384,8 @@ debugging :- % just fail here, don't really need to call debugger, the user knows what he % wants to do -'$loop_fail'(_GoalNumber, _G, _Module, _CalledFromDebugger) :- - '$continue_debugging'(CalledFromDebugger), +'$loop_fail'(_GoalNumber, _G, _Module, CalledFromDebugger) :- + '$continue_debugging'(fail, CalledFromDebugger), fail. % if we are in @@ -400,16 +404,16 @@ debugging :- /* call port */ '$enter_goal'(GoalNumber, G, Module), '$spycall'(G, Module, CalledFromDebugger, Retry), - '$disable_docreep', ( '$debugger_deterministic_goal'(G) -> Det=true ; Det=false ), - /* go execute the predicate */ + /* go execute the continuation */ ( - Retry = false -> + /* exit port */ + Retry = false, /* found an answer, so it can redo */ nb_setarg(6, Info, true), '$show_trace'(exit,G,Module,GoalNumber,Det), /* output message at exit */ @@ -422,26 +426,25 @@ debugging :- ; true ), - '$continue_debugging'(CalledFromDebugger) - ; + '$continue_debugging'(exit, CalledFromDebugger) + ; /* backtracking from exit */ /* we get here when we want to redo a goal */ /* redo port */ - '$disable_docreep', ( - arg(6, Info, true) + arg(6, Info, true) -> '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ nb_setarg(6, Info, false) ; true ), - '$continue_debugging'(CalledFromDebugger), + '$continue_debugging'(fail, CalledFromDebugger), fail /* to backtrack to spycalls */ ) ; '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */ - '$continue_debugging'(CalledFromDebugger), + '$continue_debugging'(fail, CalledFromDebugger), /* fail port */ fail ). @@ -483,16 +486,23 @@ debugging :- !, '$execute_nonstop'(G,M). '$spycall'(G, M, _, _) :- - '$system_predicate'(G,M), - \+ '$is_metapredicate'(G,M), !, - '$execute'(M:G). -'$spycall'(G, M, _, _) :- - '$system_module'(M), !, - '$execute'(M:G). + ( + '$system_predicate'(G,M) + ; + '$system_module'(M) + ), + !, + ( + '$is_metapredicate'(G,M) + -> + '$meta_creep'(G,M) + ; + '$execute'(M:G) + ). '$spycall'(G, M, _, _) :- '$tabled_predicate'(G,M), !, - '$continue_debugging'(no, '$execute_nonstop'(G,M)). + '$continue_debugging_goal'(no, '$execute_nonstop'(G,M)). '$spycall'(G, M, CalledFromDebugger, InRedo) :- '$flags'(G,M,F,F), F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source @@ -500,7 +510,6 @@ debugging :- CP is '$last_choice_pt', '$clause'(G, M, Cl, _), % I may backtrack to here from far away - '$disable_docreep', ( '$do_spy'(Cl, M, CP, CalledFromDebugger) ; InRedo = true ). '$spycall'(G, M, CalledFromDebugger, InRedo) :- '$undefined'(G, M), !, @@ -511,13 +520,26 @@ debugging :- CP is '$last_choice_pt', '$static_clause'(G,M,_,R), % I may backtrack to here from far away - '$disable_docreep', ( - '$continue_debugging'(no, '$execute_clause'(G, M, R, CP)) + '$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP)) ; InRedo = true ). +'$meta_creep'(G,M) :- + ( + yap_hacks:current_choice_point(CP1), + '$exit_system_mode', + '$meta_creep', + '$execute_nonstop'(G,M), + yap_hacks:current_choice_point(CP2), + (CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', '$meta_creep', fail ) ), + '$enter_system_mode' + ; + '$enter_system_mode', + fail + ). + '$tabled_predicate'(G,M) :- '$flags'(G,M,F,F), F /\ 0x00000040 =\= 0. @@ -584,8 +606,6 @@ debugging :- '$action'(13,P,CallNumber,G,Module,Zip) :- !, % newline creep get0(user_input,C), '$action'(C,P,CallNumber,G,Module,Zip). -%'$action'(10,_,_,_,_,on) :- % newline creep -% nb_setval('$debug_jump',false). '$action'(10,_,_,_,_,on) :- !, % newline creep nb_setval('$debug_jump',false). '$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute @@ -708,20 +728,26 @@ debugging :- '$ilgl'(C), fail. -'$continue_debugging'(yes). +% first argument is exit, zip or fail +% second is creep, meta_creep, spy, or debugger +'$continue_debugging'(exit, debugger) :- !. +'$continue_debugging'(zip, debugger) :- !. +'$continue_debugging'(fail, debugger) :- !. % do not need to debug! -'$continue_debugging'(no) :- +'$continue_debugging'(exit, meta_creep) :- !, + '$meta_creep'. +'$continue_debugging'(_, no) :- '$creep'. % if we are in the interpreter, don't need to care about forcing a trace, do we? -'$continue_debugging'(yes,G) :- !, +'$continue_debugging_goal'(_, yes,G) :- !, '$execute_dgoal'(G). % do not need to debug! -'$continue_debugging'(_,G) :- +'$continue_debugging_goal'(_, _,G) :- 'nb_getval'('$debug_run',Zip), (Zip == nodebug ; number(Zip) ; Zip == spy ), !, '$execute_dgoal'(G). -'$continue_debugging'(_,G) :- +'$continue_debugging_goal'(_, _,G) :- '$execute_creep_dgoal'(G). '$execute_dgoal'('$execute_nonstop'(G,M)) :- @@ -730,10 +756,10 @@ debugging :- '$execute_clause'(G, M, R, CP). '$execute_creep_dgoal'('$execute_nonstop'(G,M)) :- - '$signal_creep', + '$creep', '$execute_nonstop'(G,M). '$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :- - '$signal_creep', + '$creep', '$execute_clause'(G, M, R, CP). '$show_ancestors'(HowMany) :- diff --git a/pl/errors.yap b/pl/errors.yap index 478fd425e..2a5e7c11e 100644 --- a/pl/errors.yap +++ b/pl/errors.yap @@ -242,13 +242,13 @@ print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !, erase(R). print_message(Severity, Msg) :- nonvar(Severity), nonvar(Msg), - '$notrace'(user:portray_message(Severity, Msg)), !. + user:portray_message(Severity, Msg), !. % This predicate has more hooks than a pirate ship! print_message(Severity, Term) :- % first step at hook processing '$message_to_lines'(Term, Lines), ( nonvar(Term), - '$once0'(message_hook(Term, Severity, Lines), user) + user:message_hook(Term, Severity, Lines) -> true ; @@ -263,9 +263,9 @@ print_message(_, Term) :- format(user_error,'~q~n',[Term]). '$message_to_lines'(Term, Lines) :- - '$once0'(generate_message_hook(Term, [], Lines), user), !. + user:generate_message_hook(Term, [], Lines), !. '$message_to_lines'(Term, Lines) :- - '$once0'(message(Term, Lines, []), prolog), !. + prolog:message(Term, Lines, []), !. '$message_to_lines'(Term, Lines) :- '$messages':generate_message(Term, Lines, []), !. diff --git a/pl/hacks.yap b/pl/hacks.yap index c185ce79c..4ae8aef43 100644 --- a/pl/hacks.yap +++ b/pl/hacks.yap @@ -126,6 +126,7 @@ show_cp(CP, Continuation) --> show_env(Env,Cont,NCont) --> { yap_hacks:continuation(Env, Addr, NCont, _), + format('0x~16r 0x~16r~n',[Env,NCont]), yap_hacks:cp_to_predicate(Cont, Mod, Name, Arity, ClId) }, [ '0x~16r~t ~16+ ~d~16+ ~q:' - diff --git a/pl/modules.yap b/pl/modules.yap index 2f8ec6066..9cd2531dc 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -535,7 +535,7 @@ expand_goal(G, G). % expand argument '$meta_expansion_loop'(0,_,_,_,_,_,_,_) :- !. '$meta_expansion_loop'(I,D,G,NG,HVars,CurMod,M,HM) :- - arg(I,D,X), (X==':' ; integer(X)), + arg(I,D,X), (X==':' -> true ; integer(X)), arg(I,G,A), '$do_expand'(A,HVars), !, arg(I,NG,M:A), diff --git a/pl/signals.yap b/pl/signals.yap index 5a7e08912..ae553a988 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -33,39 +33,10 @@ '$wake_up_goal'(G, LG). % never creep on entering system mode!!! % don't creep on meta-call. -'$do_signal'(sig_creep, [M|G]) :- - '$creep_allowed', !, - ( - ( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ) - -> - ( - '$execute_nonstop'(G0,M), - '$signal_creep' - ; - '$signal_creep', - fail - ) - ; - '$start_creep'([M|G]) - ). -% -'$do_signal'(sig_creep, [M|G]) :- - ( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ), - !, - ( - '$execute_nonstop'(G0,M), - '$signal_creep' - ; - '$signal_creep', - fail - ). -% -'$do_signal'(sig_creep, [M|G]) :- - '$signal_creep', - '$execute_nonstop'(G,M). -'$do_signal'(sig_delay_creep, [M|G]) :- - '$execute'(M:G), - '$creep'. +'$do_signal'(sig_creep, MG) :- + '$start_creep'(MG, creep). +'$do_signal'(sig_delay_creep, MG) :- + '$start_creep'(MG, meta_creep). '$do_signal'(sig_iti, [M|G]) :- '$thread_gfetch'(Goal), % if more signals alive, set creep flag @@ -117,96 +88,12 @@ '$current_module'(M0), '$execute0'((Goal,M:G),M0). -% '$execute0' should be ignored. -'$start_creep'([_|'$execute0'(G,M)]) :- - !, - '$start_creep'([M|G]). -% '$call'() is a complicated thing -'$start_creep'([M0|'$call'(G, CP, G0, M)]) :- - !, - '$creep', - '$execute_nonstop'('$call'(G, CP, G0, M),M0). -% donotrace: means do not trace! So, -% ignore and then put creep back for the continuation. -'$start_creep'([M0|'$notrace'(G)]) :- - !, - ( - CP0 is '$last_choice_pt', - '$execute_nonstop'(G,M0), - CP1 is '$last_choice_pt', - % exit port: creep - '$creep', - ( - % if deterministic just creep all you want. - CP0 = CP1 -> - ! - ; - % extra disjunction protects reentry into usergoal - ( - % cannot cut here - true - ; - % be sure to disable creep on redo port - '$disable_creep', - fail - ) - ) - ; - % put it back again on fail - '$creep', - fail - ). -'$start_creep'([M0|'$oncenotrace'(G)]) :- - !, - ('$execute_nonstop'(G,M0), - CP1 is '$last_choice_pt', - % exit port: creep - '$creep', - ! - ; - % put it back again on fail - '$creep', - fail - ). -'$start_creep'([M0|'$once0'(G)]) :- - !, - ('$execute_nonstop'(G,M0), - CP1 is '$last_choice_pt', - % exit port: creep - '$creep', - ! - ; - % put it back again on fail - '$creep', - fail - ). -% do not debug if we are not in debug mode. -'$start_creep'([Mod|G]) :- - '$debug_on'(DBON), DBON = false, !, - '$execute_nonstop'(G,Mod). -'$start_creep'([Mod|G]) :- - nb_getval('$system_mode',on), !, - '$execute_nonstop'(G,Mod). -% notice that the last signal to be processed must always be creep -'$start_creep'([_|'$cut_by'(CP)]) :- !, - '$$cut_by'(CP), - '$creep'. -'$start_creep'([_|true]) :- !, - '$creep'. -'$start_creep'([Mod|G]) :- - '$hidden_predicate'(G,Mod), !, - '$execute_nonstop'(G,Mod), - '$creep'. -% do not debug if we are zipping through. -'$start_creep'([Mod|G]) :- - nb_getval('$debug_run',Run), - Run \= off, - '$zip'(-1, G, Mod), !, - '$signal_creep', - '$execute_goal'(G, Mod). -'$start_creep'([Mod|G]) :- +'$start_creep'([Mod|G], _) :- + '$in_system_mode', !, + '$execute0'(G, Mod). +'$start_creep'([Mod|G], WhereFrom) :- CP is '$last_choice_pt', - '$do_spy'(G, Mod, CP, no). + '$do_spy'(G, Mod, CP, WhereFrom). '$execute_goal'(G, Mod) :- (