diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixes to new signal handling/debugging code

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-12-13 08:42:57 +00:00
parent 44d28aa0c9
commit 2410cd3862
15 changed files with 231 additions and 306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
C/absmi.c
View File

@ -657,6 +657,7 @@ interrupt_handler( USES_REGS1 )
int v;
PredEntry *pe = (PredEntry *)S;
// printf("D %lx %p\n", LOCAL_ActiveSignals, P);
if ((v = check_alarm_fail_int( FALSE PASS_REGS )) != 1)
return v;
/* tell whether we can creep or not, this is hard because we will
@ -833,6 +834,7 @@ interrupt_call( USES_REGS1 )
int v;
check_alarm_fail_int( TRUE PASS_REGS );
// printf("%lx %p %p %lx\n", LOCAL_ActiveSignals, P->u.Osbpp.p, P->u.Osbpp.p0, P->u.Osbpp.p0->ExtraPredFlags);
PP = P->u.Osbpp.p0;
if ((PP->ExtraPredFlags & NoDebugPredFlag) && (LOCAL_ActiveSignals == YAP_CREEP_SIGNAL))
return 2;
@ -850,9 +852,9 @@ interrupt_pexecute( PredEntry *pen USES_REGS )
check_alarm_fail_int( 2 PASS_REGS );
PP = NULL;
if ((PP->ExtraPredFlags & NoDebugPredFlag) && (LOCAL_ActiveSignals == YAP_CREEP_SIGNAL))
return 2;
S = (CELL *) P->u.Osbpp.p;
if (LOCAL_ActiveSignals == YAP_CREEP_SIGNAL)
return 2; /* keep on creeping */
S = (CELL *) pen;
ASP = YENV;
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
@ -3220,6 +3222,14 @@ Yap_absmi(int inp)
PredEntry *pt0;
CACHE_Y_AS_ENV(YREG);
pt0 = PREG->u.pp.p;
#ifndef NO_CHECKING
check_stack(NoStackExecute, H);
goto skip_do_execute;
#endif
do_execute:
FETCH_Y_FROM_ENV(YREG);
pt0 = PREG->u.pp.p;
skip_do_execute:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
@ -3229,15 +3239,6 @@ Yap_absmi(int inp)
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
BEGD(d0);
d0 = (CELL)B;
#ifndef NO_CHECKING
check_stack(NoStackExecute, H);
goto skip_do_execute;
#endif
do_execute:
FETCH_Y_FROM_ENV(YREG);
pt0 = PREG->u.pp.p;
d0 = (CELL)B;
skip_do_execute:
PREG = pt0->CodeOfPred;
/* for profiler */
save_pc();
@ -3258,6 +3259,10 @@ Yap_absmi(int inp)
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
}
NoStackExecute:
PROCESS_INT(interrupt_execute, do_execute);
ENDBOp();
/* dexecute Label */
@ -7387,6 +7392,10 @@ Yap_absmi(int inp)
BEGD(d0);
CACHE_Y_AS_ENV(YREG);
#ifndef NO_CHECKING
check_stack(NoStackExecuteC, H);
do_executec:
#endif
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
@ -7411,9 +7420,6 @@ Yap_absmi(int inp)
CACHE_A1();
BEGD(d0);
d0 = (CELL)B;
#ifndef NO_CHECKING
check_stack(NoStackExecute, H);
#endif
/* for profiler */
save_pc();
ENV_YREG[E_CB] = d0;
@ -7461,8 +7467,8 @@ Yap_absmi(int inp)
ENDD(d0);
}
NoStackExecute:
PROCESS_INT(interrupt_execute, do_execute);
NoStackExecuteC:
PROCESS_INT(interrupt_execute, do_executec);
ENDBOp();
/* Like previous, the only difference is that we do not */
@ -13595,6 +13601,7 @@ Yap_absmi(int inp)
#ifndef NO_CHECKING
check_stack(NoStackPExecute, H);
#endif
execute_stack_checked:
CPREG = NEXTOP(PREG, Osbmp);
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
PREG = pen->CodeOfPred;
@ -13645,8 +13652,8 @@ Yap_absmi(int inp)
d0 = interrupt_pexecute( pen PASS_REGS );
setregs();
if (!d0) FAIL();
if (d0 == 2) goto execute_end;
JMPNext();
if (d0 == 2) goto execute_stack_checked;
goto execute_end;
ENDBOp();
ENDD(d0);

6
C/adtdefs.c
View File

@ -872,7 +872,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
p->PredFlags |= GoalExPredFlag;
}
}
if (LOCAL_PL_local_data_p== NULL || truePrologFlag(PLFLAG_DEBUGINFO)) {
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
p->FunctorOfPred = fe;
@ -927,7 +927,7 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
LOCAL_ThreadHandle.local_preds = p;
p->FunctorOfPred = ap->FunctorOfPred;
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_THREAD);
if (LOCAL_PL_local_data_p== NULL || truePrologFlag(PLFLAG_DEBUGINFO)) {
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
@ -998,7 +998,7 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
AddPropToAtom(ae, (PropEntry *)p);
p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
if (LOCAL_PL_local_data_p== NULL || truePrologFlag(PLFLAG_DEBUGINFO)) {
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoDebugPredFlag;
}
WRITE_UNLOCK(ae->ARWLock);

24
C/exec.c
View File

@ -166,8 +166,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|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
@ -339,8 +339,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|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
CalculateStackGap( PASS_REGS1 );
}
UNLOCK(LOCAL_SignalLock);
@ -641,8 +641,8 @@ p_execute_clause( USES_REGS1 )
} else {
code = Yap_ClauseFromTerm(clt)->ClCode;
}
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL)) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL);
}
return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS);
@ -657,7 +657,7 @@ p_execute_in_mod( USES_REGS1 )
static Int
p_do_goal_expansion( USES_REGS1 )
{
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL);
Int out = FALSE;
PredEntry *pe;
Term cmod = Deref(ARG2);
@ -665,7 +665,7 @@ p_do_goal_expansion( USES_REGS1 )
ARG2 = ARG3;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals)
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
@ -720,14 +720,14 @@ p_do_goal_expansion( USES_REGS1 )
static Int
p_do_term_expansion( USES_REGS1 )
{
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
Int creeping = LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL);
Int out = FALSE;
PredEntry *pe;
Term cmod = CurrentModule;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals)
CalculateStackGap( PASS_REGS1 );
UNLOCK(LOCAL_SignalLock);
@ -903,8 +903,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|YAP_DELAY_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
if (LOCAL_ActiveSignals & (YAP_CREEP_SIGNAL) && !LOCAL_InterruptsDisabled) {
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)

32
C/signals.c
View File

@ -54,7 +54,7 @@ inline static void
undo_signal(yap_signals sig USES_REGS)
{
LOCK(LOCAL_SignalLock);
if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL)) == sig) {
if ((LOCAL_ActiveSignals & ~(YAP_CREEP_SIGNAL)) == sig) {
CalculateStackGap( PASS_REGS1 );
}
LOCAL_ActiveSignals &= ~sig;
@ -91,7 +91,7 @@ static Int
p_stop_creeping( USES_REGS1 )
{
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
LOCAL_ActiveSignals &= ~(YAP_CREEP_SIGNAL);
if (!LOCAL_ActiveSignals) {
CalculateStackGap( PASS_REGS1 );
}
@ -99,21 +99,6 @@ p_stop_creeping( USES_REGS1 )
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 )
{
@ -221,12 +206,6 @@ p_first_signal( USES_REGS1 )
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);
MUTEX_UNLOCK(&(LOCAL_ThreadHandle.tlock));
UNLOCK(LOCAL_SignalLock);
return Yap_unify(ARG1, MkAtomTerm(AtomSigDelayCreep));
}
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
MUTEX_UNLOCK(&(LOCAL_ThreadHandle.tlock));
@ -302,12 +281,6 @@ p_continue_signals( USES_REGS1 )
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);
}
@ -333,7 +306,6 @@ Yap_InitSignalCPreds(void)
/* Basic predicates for the debugger */
Yap_InitCPred("$creep", 0, p_creep, SafePredFlag);
Yap_InitCPred("$creep_fail", 0, p_creep_fail, 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);

1
H/Yap.h
View File

@ -394,7 +394,6 @@ typedef enum
YAP_BREAK_SIGNAL = 0x2000, /* received break signal */
YAP_STACK_DUMP_SIGNAL = 0x4000, /* received stack dump signal */
YAP_STATISTICS_SIGNAL = 0x8000, /* received statistics */
YAP_DELAY_CREEP_SIGNAL = 0x10000, /* received a creep but should not do it */
YAP_AGC_SIGNAL = 0x20000, /* call atom garbage collector asap */
YAP_PIPE_SIGNAL = 0x40000, /* call atom garbage collector asap */
YAP_VTALARM_SIGNAL = 0x80000, /* received SIGVTALARM */

1
os/pl-file.c
View File

@ -5210,6 +5210,7 @@ init_yap(void)
#endif
initCharTypes();
initPrologFlags();
clearPrologFlagMask(PLFLAG_DEBUGINFO);
setPrologFlagMask(PLFLAG_TTY_CONTROL);
initFiles();
PL_register_extensions(PL_predicates_from_ctype);

7
pl/arith.yap
View File

@ -38,8 +38,10 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$do_c_built_in'(G, M, OUT) :- var(G), !,
'$do_c_built_metacall'(G, M, OUT).
'$do_c_built_in'(Mod:G, _, OUT) :- !,
'$do_c_built_metacall'(G, Mod, OUT).
'$do_c_built_in'(Mod:G, _, OUT) :-
strip_module(Mod:G, M, G1),
var(G1), !,
'$do_c_built_metacall'(G1, M, OUT).
'$do_c_built_in'(\+ G, _, OUT) :-
nonvar(G),
G = (A = B),
@ -86,7 +88,6 @@ do_not_compile_expressions :- set_value('$c_arith',[]).
'$clean_cuts'(NG0, NG),
'$do_c_built_in'(A,M,NA).
'$do_c_built_in'('C'(A,B,C), _, (A=[B|C])) :- !.
'$do_c_built_in'(trace, _M, '$do_trace') :- !.
'$do_c_built_in'(X is Y, M, P) :-
primitive(X), !,
'$do_c_built_in'(X =:= Y, M, P).

1
pl/attributes.yap
View File

@ -148,7 +148,6 @@ lcall2([Goal|Goals], Mod) :-
prolog:call_residue_vars(Goal,Residue) :-
attributes:all_attvars(Vs0),
call(Goal),
'$stop_creeping',
attributes:all_attvars(Vs),
% this should not be actually strictly necessary right now.
% but it makes it a safe bet.

53
pl/boot.yap
View File

@ -94,7 +94,6 @@ true :- true.
'$init_consult',
% '$swi_set_prolog_flag'(break_level, 0),
% '$set_read_error_handler'(error), let the user do that
'$system_mode'(true),
nb_setval('$chr_toplevel_show_store',false).
'$init_consult' :-
@ -478,7 +477,7 @@ true :- true.
(
'$current_choice_point'(CP),
'$current_module'(M),
'$execute_outside_system_mode'(G, M),
'$user_call'(G, M),
'$current_choice_point'(NCP),
'$delayed_goals'(G, V, NV, LGs, DCP),
'$write_answer'(NV, LGs, Written),
@ -542,7 +541,7 @@ true :- true.
!,
'$csult'([X|L], M).
'$do_yes_no'(G, M) :-
'$execute_outside_system_mode'(G, M).
'$user_call'(G, M).
'$write_query_answer_true'([]) :- !,
format(user_error,'true',[]).
@ -750,6 +749,28 @@ incore(G) :- '$execute'(G).
'$current_choice_point'(CP),
'$call'(G, CP, G, M).
'$user_call'(G, M) :-
( '$$save_by'(CP1),
'$enable_debugging',
'$call'(G, CP, M:G, M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
'$disable_debugging'
;
'$disable_debugging',
fail
).
'$enable_debugging' :-
'$swi_current_prolog_flag'(debug, false), !.
'$enable_debugging' :-
'$nb_getval'('$trace', on, fail), !,
'$creep'.
'$enable_debugging'.
'$disable_debugging' :-
'$stop_creeping'.
','(X,Y) :-
yap_hacks:env_choice_point(CP),
@ -1197,33 +1218,9 @@ catch_ball(C, C).
( call(user:H1) -> true ; true).
'$run_toplevel_hooks'.
'$enter_system_mode' :-
'$stop_creeping',
'$system_mode'(true).
'$in_system_mode' :-
'$system_mode'(State),
State = true.
'$execute_outside_system_mode'(G,M) :-
( '$$save_by'(CP1),
'$exit_system_mode',
'$call'(G, CP, M:G, M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', fail ) ),
'$enter_system_mode'
;
'$enter_system_mode',
fail
).
'$exit_system_mode' :-
'$system_mode'(false),
( '$nb_getval'('$trace',on,fail) -> '$meta_creep' ; true).
'$run_at_thread_start' :-
recorded('$thread_initialization',M:D,_),
'$execute_outside_sysem_mode'(D, M),
'$meta_call'(D, M),
fail.
'$run_at_thread_start'.

11
pl/consult.yap
View File

@ -336,7 +336,6 @@ use_module(M,F,Is) :-
% export to process
b_setval('$lf_status', TOpts),
'$reset_if'(OldIfLevel),
'$into_system_mode'(OldMode),
% take care with [a:f], a is the ContextModule
'$current_module'(SourceModule, ContextModule),
'$lf_opt'(consult, TOpts, Reconsult),
@ -402,7 +401,6 @@ use_module(M,F,Is) :-
),
( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals',
( OldMode == true -> '$enter_system_mode' ; true ),
% format( 'O=~w~n', [Mod=UserFile] ),
!.
@ -435,10 +433,6 @@ use_module(M,F,Is) :-
Level0 = Level.
'$get_if'(0).
'$into_system_mode'(OldMode) :-
'$system_mode'(OldMode),
'$system_mode'(true).
'$bind_module'(_, load_files).
'$bind_module'(Mod, use_module(Mod)).
@ -539,15 +533,12 @@ initialization(G,OPT) :-
'$fetch_init_goal'(Level, G),
LGs),
lists:member(G,LGs),
'$nb_getval'('$system_mode', OldMode, fail),
( OldMode == on -> '$exit_system_mode' ; true ),
% run initialization under user control (so allow debugging this stuff).
(
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
'$system_catch'(('$user_call'(G,M) -> true), M, Error, user:'$LoopError'(Error, top)),
fail
;
OldMode = on,
'$enter_system_mode',
fail
).
'$exec_initialisation_goals' :-

6
pl/control.yap
View File

@ -119,7 +119,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
yap_hacks:enable_interrupts,
'$current_choice_point'(CP0),
'$execute'(Goal),
'$stop_creeping',
'$current_choice_point'(CPF),
(
CP0 =:= CPF
@ -130,7 +129,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
true
)
;
'$stop_creeping',
Catcher = fail,
fail
).
@ -266,7 +264,6 @@ b_getval(GlobalVariable, Val) :-
break :-
'$init_debugger',
nb_getval('$system_mode',SystemMode),
nb_getval('$trace',Trace),
nb_setval('$trace',off),
nb_getval('$debug_jump',Jump),
@ -291,8 +288,7 @@ break :-
nb_setval('$debug_jump',Jump),
nb_setval('$debug_run',Run),
nb_setval('$trace',Trace),
'$break'( false ),
nb_setval('$system_mode',SystemMode).
'$break'( false ).
at_halt(G) :-

336
pl/debug.yap
View File

@ -34,167 +34,158 @@
nb_setval('$debug_jump',false).
% First part : setting and reseting spy points
% First part : setting and reseting spy points
% $suspy does most of the work
'$suspy'(V,S,M) :- var(V) , !,
'$do_error'(instantiation_error,M:spy(V,S)).
'$suspy'((M:S),P,_) :- !,
'$suspy'(S,P,M).
'$suspy'([],_,_) :- !.
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
'$suspy'(F/N,S,M) :- !,
functor(T,F,N),
'$do_suspy'(S, F, N, T, M).
'$suspy'(A,S,M) :- atom(A), !,
'$suspy_predicates_by_name'(A,S,M).
'$suspy'(P,spy,M) :- !,
'$do_error'(domain_error(predicate_spec,P),spy(M:P)).
'$suspy'(P,nospy,M) :-
'$do_error'(domain_error(predicate_spec,P),nospy(M:P)).
% $suspy does most of the work
'$suspy'(V,S,M) :- var(V) , !,
'$do_error'(instantiation_error,M:spy(V,S)).
'$suspy'((M:S),P,_) :- !,
'$suspy'(S,P,M).
'$suspy'([],_,_) :- !.
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
'$suspy'(F/N,S,M) :- !,
functor(T,F,N),
'$do_suspy'(S, F, N, T, M).
'$suspy'(A,S,M) :- atom(A), !,
'$suspy_predicates_by_name'(A,S,M).
'$suspy'(P,spy,M) :- !,
'$do_error'(domain_error(predicate_spec,P),spy(M:P)).
'$suspy'(P,nospy,M) :-
'$do_error'(domain_error(predicate_spec,P),nospy(M:P)).
'$suspy_predicates_by_name'(A,S,M) :-
% just check one such predicate exists
(
current_predicate(A,M:_)
->
M = EM,
A = NA
;
recorded('$import','$import'(EM,M,GA,_,A,_),_),
functor(GA,NA,_)
),
!,
'$do_suspy_predicates_by_name'(NA,S,EM).
'$suspy_predicates_by_name'(A,spy,M) :- !,
print_message(warning,no_match(spy(M:A))).
'$suspy_predicates_by_name'(A,nospy,M) :-
print_message(warning,no_match(nospy(M:A))).
'$do_suspy_predicates_by_name'(A,S,M) :-
current_predicate(A,M:T),
functor(T,A,N),
'$do_suspy'(S, A, N, T, M).
'$do_suspy_predicates_by_name'(A, S, M) :-
recorded('$import','$import'(EM,M,T0,_,A,N),_),
functor(T0,A0,N0),
'$do_suspy'(S, A0, N0, T, EM).
%
% protect against evil arguments.
%
'$do_suspy'(S, F, N, T, M) :-
recorded('$import','$import'(EM,M,T0,_,F,N),_), !,
functor(T0, F0, N0),
'$do_suspy'(S, F0, N0, T, EM).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
'$suspy_predicates_by_name'(A,S,M) :-
% just check one such predicate exists
(
current_predicate(A,M:_)
->
M = EM,
A = NA
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M),
'$flags'(T,M,F,F),
F /\ 0x118dd080 =\= 0,
( S = spy ->
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
;
'$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M).
recorded('$import','$import'(EM,M,GA,_,A,_),_),
functor(GA,NA,_)
),
!,
'$do_suspy_predicates_by_name'(NA,S,EM).
'$suspy_predicates_by_name'(A,spy,M) :- !,
print_message(warning,no_match(spy(M:A))).
'$suspy_predicates_by_name'(A,nospy,M) :-
print_message(warning,no_match(nospy(M:A))).
'$suspy2'(spy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),_), !,
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
'$suspy2'(spy,F,N,T,M) :- !,
recorda('$spy','$spy'(T,M),_),
'$set_spy'(T,M),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
'$suspy2'(nospy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),R), !,
erase(R),
'$rm_spy'(T,M),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
'$suspy2'(nospy,F,N,_,M) :-
print_message(informational,breakp(no,breakpoint_for,M:F/N)).
'$do_suspy_predicates_by_name'(A,S,M) :-
current_predicate(A,M:T),
functor(T,A,N),
'$do_suspy'(S, A, N, T, M).
'$do_suspy_predicates_by_name'(A, S, M) :-
recorded('$import','$import'(EM,M,T0,_,A,N),_),
functor(T0,A0,N0),
'$do_suspy'(S, A0, N0, T, EM).
'$pred_being_spied'(G, M) :-
recorded('$spy','$spy'(G,M),_), !.
spy Spec :-
'$init_debugger',
prolog:debug_action_hook(spy(Spec)), !.
spy L :-
'$current_module'(M),
'$suspy'(L, spy, M), fail.
spy _ :- debug.
nospy Spec :-
'$init_debugger',
prolog:debug_action_hook(nospy(Spec)), !.
nospy L :-
'$current_module'(M),
'$suspy'(L, nospy, M), fail.
nospy _.
nospyall :-
'$init_debugger',
prolog:debug_action_hook(nospyall), !.
nospyall :-
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
nospyall.
% debug mode -> debug flag = 1
debug :-
'$init_debugger',
( nb_getval('$spy_gn',L) -> true ; nb_setval('$spy_gn',1) ),
'$start_debugging'(on),
print_message(informational,debug(debug)).
'$start_debugging'(Mode) :-
(Mode == on ->
'$swi_set_prolog_flag'(debug, true)
;
'$swi_set_prolog_flag'(debug, false)
),
nb_setval('$debug_run',off),
nb_setval('$debug_jump',false).
nodebug :-
'$init_debugger',
'$swi_set_prolog_flag'(debug, false),
nb_setval('$trace',off),
print_message(informational,debug(off)).
%
% remove any debugging info after an abort.
% protect against evil arguments.
%
trace :-
'$init_debugger',
'$nb_getval'('$trace', on, fail), !.
trace :-
nb_setval('$trace',on),
'$start_debugging'(on),
print_message(informational,debug(trace)),
'$meta_creep'.
'$do_suspy'(S, F, N, T, M) :-
recorded('$import','$import'(EM,M,T0,_,F,N),_), !,
functor(T0, F0, N0),
'$do_suspy'(S, F0, N0, T, EM).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M),
'$flags'(T,M,F,F),
F /\ 0x118dd080 =\= 0,
( S = spy ->
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
;
'$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M).
'$do_trace' :-
'$init_debugger',
'$suspy2'(spy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),_), !,
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
'$suspy2'(spy,F,N,T,M) :- !,
recorda('$spy','$spy'(T,M),_),
'$set_spy'(T,M),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
'$suspy2'(nospy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),R), !,
erase(R),
'$rm_spy'(T,M),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
'$suspy2'(nospy,F,N,_,M) :-
print_message(informational,breakp(no,breakpoint_for,M:F/N)).
'$pred_being_spied'(G, M) :-
recorded('$spy','$spy'(G,M),_), !.
spy Spec :-
'$init_debugger',
prolog:debug_action_hook(spy(Spec)), !.
spy L :-
'$current_module'(M),
'$suspy'(L, spy, M), fail.
spy _ :- debug.
nospy Spec :-
'$init_debugger',
prolog:debug_action_hook(nospy(Spec)), !.
nospy L :-
'$current_module'(M),
'$suspy'(L, nospy, M), fail.
nospy _.
nospyall :-
'$init_debugger',
prolog:debug_action_hook(nospyall), !.
nospyall :-
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
nospyall.
% debug mode -> debug flag = 1
debug :-
'$init_debugger',
( nb_getval('$spy_gn',L) -> true ; nb_setval('$spy_gn',1) ),
'$start_debugging'(on),
print_message(informational,debug(debug)).
'$start_debugging'(Mode) :-
(Mode == on ->
'$swi_set_prolog_flag'(debug, true)
;
'$swi_set_prolog_flag'(debug, false)
),
nb_setval('$debug_run',off),
nb_setval('$debug_jump',false).
nodebug :-
'$init_debugger',
'$swi_set_prolog_flag'(debug, false),
nb_setval('$trace',off),
print_message(informational,debug(off)).
%
% remove any debugging info after an abort.
%
trace :-
'$init_debugger',
'$nb_getval'('$trace', on, fail), !.
'$do_trace' :-
trace :-
nb_setval('$trace',on),
'$start_debugging'(on),
print_message(informational,debug(trace)),
@ -310,13 +301,8 @@ debugging :-
'$spy'([Mod|G]) :-
'$swi_current_prolog_flag'(debug, false), !,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
'$in_system_mode', !,
'$exit_system_mode',
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
CP is '$last_choice_pt',
'$enter_system_mode',
'$do_spy'(G, Mod, CP, spy).
% last argument to do_spy says that we are at the end of a context. It
@ -437,7 +423,6 @@ debugging :-
'$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, CalledFromDebugger, Retry),
% make sure we are in system mode when running the debugger.
'$enter_system_mode',
(
'$debugger_deterministic_goal'(G) ->
Det=true
@ -463,7 +448,6 @@ debugging :-
'$continue_debugging'(exit, CalledFromDebugger)
;
% make sure we are in system mode when running the debugger.
'$enter_system_mode',
/* backtracking from exit */
/* we get here when we want to redo a goal */
/* redo port */
@ -479,7 +463,6 @@ debugging :-
fail /* to backtrack to spycalls */
)
;
'$enter_system_mode',
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
'$continue_debugging'(fail, CalledFromDebugger),
/* fail port */
@ -521,7 +504,6 @@ debugging :-
'$spycall'(G, M, _, _) :-
nb_getval('$debug_jump',true),
!,
'$exit_system_mode',
'$execute_nonstop'(G,M).
'$spycall'(G, M, _, _) :-
(
@ -533,7 +515,7 @@ debugging :-
(
'$is_metapredicate'(G,M)
->
'$meta_creep'(G,M)
'$creep'(G,M)
;
'$execute'(M:G)
).
@ -564,17 +546,18 @@ debugging :-
InRedo = true
).
'$meta_creep'(G,M) :-
%
% execute a built-in in creep mode
%
'$creep'(G,M) :-
(
'$$save_by'(CP1),
'$exit_system_mode',
'$meta_creep',
'$creep',
'$execute_nonstop'(G,M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', '$meta_creep', fail ) ),
'$enter_system_mode'
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
;
'$enter_system_mode',
fail
).
@ -776,22 +759,11 @@ debugging :-
'$continue_debugging'(_, debugger) :- !.
% do not need to debug!
% go back to original sequence.
'$continue_debugging'(exit, meta_creep) :- !,
'$system_mode'(false),
'$meta_creep'.
'$continue_debugging'(zip, _) :- !, '$exit_system_mode'.
'$continue_debugging'(fail, creep) :- !,
'$system_mode'(false),
'$creep_fail'.
'$continue_debugging'(zip, _) :- !.
'$continue_debugging'(_, creep) :- !,
'$creep',
'$system_mode'(false).
'$continue_debugging'(fail, _) :- !.
'$continue_debugging'(_, spy) :- !,
'$system_mode'(false),
'$creep'.
'$continue_debugging'(_, _) :-
'$exit_system_mode'.
'$continue_debugging'(fail, _) :- !.
'$continue_debugging'(_, _).
% if we are in the interpreter, don't need to care about forcing a trace, do we?
'$continue_debugging_goal'(yes,G) :- !,
@ -805,10 +777,8 @@ debugging :-
'$execute_creep_dgoal'(G).
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
'$exit_system_mode',
'$execute_nonstop'(G,M).
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$exit_system_mode',
'$execute_clause'(G, M, R, CP).
'$execute_creep_dgoal'('$execute_nonstop'(G,M)) :-

3
pl/init.yap
View File

@ -153,6 +153,9 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- '$change_type_of_char'(36,7). % Make $ a symbol character
:- '$swi_set_prolog_flag'(generate_debug_info,true).
:- multifile user:library_directory/1.
:- dynamic user:library_directory/1.

4
pl/setof.yap
View File

@ -50,11 +50,9 @@ findall(Template, Generator, Answers, SoFar) :-
nb:nb_queue(Ref),
(
'$execute'(Generator),
'$stop_creeping',
nb:nb_queue_enqueue(Ref, Template),
fail
;
'$stop_creeping',
nb:nb_queue_close(Ref, Answers, SoFar)
).
@ -149,11 +147,9 @@ all(T,G,S) :-
'$init_db_queue'(Ref),
( '$catch'(Error,'$clean_findall'(Ref,Error),_),
'$execute'(G),
'$stop_creeping',
'$db_enqueue'(Ref, T),
fail
;
'$stop_creeping',
'$$set'(S,Ref)
).

7
pl/signals.yap
View File

@ -35,8 +35,6 @@
% don't creep on meta-call.
'$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
@ -92,9 +90,6 @@
'$start_creep'([M|G], _) :-
'$is_no_trace'(G, M), !,
'$execute0'(G, M).
'$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, WhereFrom).
@ -202,8 +197,6 @@ read_sig.
% make thes predicates non-traceable.
:- '$set_no_trace'(true, prolog).
:- '$set_no_trace'('$enter_system_mode', prolog).
:- '$set_no_trace'('$do_trace', prolog).
:- '$set_no_trace'('$call'(_,_,_,_), prolog).
:- '$set_no_trace'('$execute_nonstop'(_,_), prolog).