debugging
This commit is contained in:
parent
d18c67aa2a
commit
046cb5f8d6
26
C/absmi.c
26
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) {
|
||||
|
@ -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);
|
||||
}
|
||||
|
@ -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)));
|
||||
|
77
C/exec.c
77
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);
|
||||
|
381
C/signals.c
Normal file
381
C/signals.c
Normal file
@ -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 <stdio.h>
|
||||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
#if HAVE_MALLOC_H
|
||||
#include <malloc.h>
|
||||
#endif
|
||||
#include <wchar.h>
|
||||
|
||||
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
|
||||
}
|
225
C/stdpreds.c
225
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();
|
||||
|
203
C/sysbits.c
203
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);
|
||||
|
@ -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 */
|
||||
|
@ -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) :-
|
||||
|
105
pl/boot.yap
105
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'.
|
||||
|
||||
|
@ -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) :-
|
||||
|
@ -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)
|
||||
|
114
pl/debug.yap
114
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) :-
|
||||
|
@ -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, []), !.
|
||||
|
||||
|
@ -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:' -
|
||||
|
@ -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),
|
||||
|
131
pl/signals.yap
131
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) :-
|
||||
(
|
||||
|
Reference in New Issue
Block a user