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

Merge ssh://192.168.1.79:/Users/vsc/github/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2017-09-17 08:04:57 +01:00
commit 717aeb162a
12 changed files with 330 additions and 367 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/adtdefs.c
View File

@ -178,13 +178,15 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
na = SearchAtom(atom, a);
if (na != NIL) {
WRITE_UNLOCK(HashChain[hash].AERWLock);
return (na);
return na;
}
}
#endif
/* add new atom to start of chain */
size_t asz = strlen((const char *)atom);
ae = (AtomEntry *)Yap_AllocAtomSpace((sizeof *ae) +
strlen((const char *)atom) + 1);
asz+4);
if (ae == NULL) {
WRITE_UNLOCK(HashChain[hash].AERWLock);
return NIL;
@ -192,13 +194,12 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
NOfAtoms++;
na = AbsAtom(ae);
ae->PropsOfAE = NIL;
if (ae->UStrOfAE != atom)
strcpy((char *)ae->StrOfAE, (const char *)atom);
stpncpy((char *)ae->StrOfAE, (const char *)atom, asz+1);
ae->NextOfAE = a;
HashChain[hash].Entry = na;
INIT_RWLOCK(ae->ARWLock);
WRITE_UNLOCK(HashChain[hash].AERWLock);
if (NOfAtoms > 2 * AtomHashTableSize) {
Yap_signal(YAP_CDOVF_SIGNAL);
}

106
C/exec.c
View File

@ -886,7 +886,7 @@ static bool watch_retry(Term d0 USES_REGS) {
complete_pt[0] = t;
} else if (box) {
t = TermRetry;
t = TermRedo;
} else {
return true;
}
@ -952,7 +952,6 @@ static Int cleanup_on_exit(USES_REGS1) {
Term task = Deref(ARG2);
bool box = ArgOfTerm(1, task) == TermTrue;
Term cleanup = ArgOfTerm(3, task);
Term catcher = ArgOfTerm(2, task);
Term complete = IsNonVarTerm(ArgOfTerm(4, task));
while (B->cp_ap->opc == FAIL_OPCODE)
@ -1152,6 +1151,83 @@ restart_exec:
RepPredProp(pe)->CodeOfPred PASS_REGS);
}
static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
*/
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
unsigned int arity;
Prop pe;
bool rc;
t = Yap_YapStripModule(t, &mod);
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
register CELL *pt;
if (IsExtensionFunctor(f))
return (FALSE);
pe = PredPropByFunc(f, mod);
arity = ArityOfFunctor(f);
if (arity > MaxTemps) {
return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS);
}
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pt = RepAppl(t) + 1;
for (i = 1; i <= arity; ++i) {
#if YAPOR_SBA
Term d0 = *pt++;
if (d0 == 0)
XREGS[i] = (CELL)(pt - 1);
else
XREGS[i] = d0;
#else
XREGS[i] = *pt++;
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
}
/* N = arity; */
/* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
if (!LOCAL_InterruptsDisabled && Yap_get_signal(YAP_CREEP_SIGNAL)) {
Yap_signal(YAP_CREEP_SIGNAL);
}
#if defined(YAPOR) || defined(THREADS)
if (RepPredProp(pe)->PredFlags & LogUpdatePredFlag) {
PP = RepPredProp(pe);
PELOCK(80, PP);
}
#endif
rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS);
} else {
rc = CallPredicate(RepPredProp(pe), B,
RepPredProp(pe)->CodeOfPred PASS_REGS);
}
if (!LOCAL_InterruptsDisabled &&
(!(RepPredProp(pe)->PredFlags & (AsmPredFlag | CPredFlag)) ||
RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
Yap_signal(YAP_CREEP_SIGNAL);
}
return rc;
}
static Int execute_nonstop(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
*/
Term t = Deref(ARG1);
@ -1361,8 +1437,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
}
LOCAL_PrologMode &= ~AbortMode;
P = (yamop *)FAILCODE;
if (LOCAL_CBorder)
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
return false;
break;
@ -1927,23 +2001,14 @@ static Int JumpToEnv() {
so get pointers here */
/* find the first choicepoint that may be a catch */
// DBTerm *dbt = Yap_RefToException();
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) {
// printf("--handler=%p, max=%p\n", handler, LCL0-LOCAL_CBorder);
if (handler == (choiceptr)(LCL0 - LOCAL_CBorder)) {
break;
}
/* we are already doing a catch */
/* make sure we prune C-choicepoints */
if ((handler->cp_ap == NOCODE && handler->cp_b == NULL) ||
(handler->cp_b >= (choiceptr)(LCL0 - LOCAL_CBorder))) {
break;
}
while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch &&
LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE &&
handler->cp_b != NULL) {
handler = handler->cp_b;
}
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
POP_FAIL(handler);
B = handler;
P = FAILCODE;
return true;
@ -1979,7 +2044,10 @@ static Int jump_env(USES_REGS1) {
LOCAL_ActiveError->classAsText = NULL;
}
} else {
// LOCAL_Error_TYPE = THROW_EVENT;
Yap_find_prolog_culprit(PASS_REGS1);
LOCAL_ActiveError->errorAsText = NULL;
LOCAL_ActiveError->classAsText = NULL;
//return true;
}
LOCAL_ActiveError->prologPredName = NULL;
Yap_PutException(t);
@ -2197,9 +2265,11 @@ void Yap_InitExecFs(void) {
#endif
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("$current_choicepoint", 1, current_choice_point, 0);
Yap_InitCPred("$ ", 1,
current_choice_point, 0);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);

78
C/stack.c
View File

@ -1,22 +1,22 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: stack.c *
* comments: Stack Introspection *
* *
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Revision 1.230 2008/06/02 17:20:28 vsc *
* *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: stack.c *
* comments: Stack Introspection *
* *
* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Revision 1.230 2008/06/02 17:20:28 vsc *
* *
* *
*************************************************************************/
/**
* @file stack.c
@ -29,8 +29,8 @@
*/
#include "Yap.h"
#include "clause.h"
#include "YapEval.h"
#include "clause.h"
#include "iopreds.h"
#include "tracer.h"
#include "yapio.h"
@ -163,13 +163,7 @@ static PredEntry *PredForChoicePt(yamop *p_code, op_numbers *opn) {
/* compile error --> return ENV_ToP(gc_B->cp_cp); */
#endif /* TABLING */
case _or_else:
if (p_code == p_code->y_u.Osblp.l) {
/* repeat */
Atom at = AtomRepeatSpace;
return RepPredProp(PredPropByAtom(at, PROLOG_MODULE));
} else {
return p_code->y_u.Osblp.p0;
}
return p_code->y_u.Osblp.p0;
break;
case _or_last:
#ifdef YAPOR
@ -779,7 +773,8 @@ static PredEntry *found_expand(yamop *pc, void **startp,
return pp;
}
static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp, void **endp, PredEntry *pp USES_REGS) {
static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp,
void **endp, PredEntry *pp USES_REGS) {
if (pc == YESCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue, CurrentModule));
if (startp)
@ -787,17 +782,17 @@ static PredEntry *found_ystop(yamop *pc, int clause_code, void **startp, void **
if (endp)
*endp = (CODEADDR)YESCODE + (CELL)(NEXTOP((yamop *)NULL, e));
return pp;
}
if (!pp) {
yamop *o = PREVOP(pc,Osbpp);
if (o->opc ==Yap_opcode(_execute_cpred)) {
pp = o->y_u.Osbpp.p0;
} else {
/* must be an index */
PredEntry **pep = (PredEntry **)pc->y_u.l.l;
pp = pep[-1];
}
}
if (!pp) {
yamop *o = PREVOP(pc, Osbpp);
if (o->opc == Yap_opcode(_execute_cpred)) {
pp = o->y_u.Osbpp.p0;
} else {
/* must be an index */
PredEntry **pep = (PredEntry **)pc->y_u.l.l;
pp = pep[-1];
}
}
if (pp->PredFlags & LogUpdatePredFlag) {
if (clause_code) {
LogUpdClause *cl = ClauseCodeToLogUpdClause(pc->y_u.l.l);
@ -1159,7 +1154,7 @@ bool Yap_find_prolog_culprit(USES_REGS1) {
break;
}
pe = EnvPreg(curCP);
if (pe==NULL) {
if (pe == NULL) {
pe = PredMetaCall;
}
if (pe->ModuleOfPred)
@ -1634,7 +1629,7 @@ static Int p_choicepoint_info(USES_REGS1) {
}
static Int /* $parent_pred(Module, Name, Arity) */
parent_pred(USES_REGS1) {
parent_pred(USES_REGS1) {
/* This predicate is called from the debugger.
We assume a sequence of the form a -> b */
Atom at;
@ -2045,7 +2040,7 @@ Term Yap_pc_location(yamop *pc, choiceptr b_ptr, CELL *env) {
if (pe != NULL
// pe->ModuleOfPred != PROLOG_MODULE &&
// &&!(pe->PredFlags & HiddenPredFlag)
) {
) {
return build_bug_location(codeptr, pe);
}
return TermNil;
@ -2058,7 +2053,8 @@ Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) {
PredEntry *pe = EnvPreg(cp);
if (pe == PredTrue)
return TermNil;
if (ignore_first <= 0 && pe
if (ignore_first <= 0 &&
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return build_bug_location(cp, pe);

1
H/ATOMS
View File

@ -323,6 +323,7 @@ A Reconsult N "reconsult"
A RecordedP F "$recordep"
A RecordedWithKey F "$recorded_with_key"
A RedefineWarnings N "redefine_warnings"
A Redo F "redo"
A RedoFreeze F "$redo_freeze"
A RefoundVar F "$I_FOUND_THE_VARIABLE_AGAIN"
A RelativeTo F "relative_to"

1
H/generated/iatoms.h
View File

@ -318,6 +318,7 @@
AtomRecordedP = Yap_FullLookupAtom("$recordep"); TermRecordedP = MkAtomTerm(AtomRecordedP);
AtomRecordedWithKey = Yap_FullLookupAtom("$recorded_with_key"); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey);
AtomRedefineWarnings = Yap_LookupAtom("redefine_warnings"); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings);
AtomRedo = Yap_FullLookupAtom("redo"); TermRedo = MkAtomTerm(AtomRedo);
AtomRedoFreeze = Yap_FullLookupAtom("$redo_freeze"); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze);
AtomRefoundVar = Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"); TermRefoundVar = MkAtomTerm(AtomRefoundVar);
AtomRelativeTo = Yap_FullLookupAtom("relative_to"); TermRelativeTo = MkAtomTerm(AtomRelativeTo);

1
H/generated/ratoms.h
View File

@ -318,6 +318,7 @@
AtomRecordedP = AtomAdjust(AtomRecordedP); TermRecordedP = MkAtomTerm(AtomRecordedP);
AtomRecordedWithKey = AtomAdjust(AtomRecordedWithKey); TermRecordedWithKey = MkAtomTerm(AtomRecordedWithKey);
AtomRedefineWarnings = AtomAdjust(AtomRedefineWarnings); TermRedefineWarnings = MkAtomTerm(AtomRedefineWarnings);
AtomRedo = AtomAdjust(AtomRedo); TermRedo = MkAtomTerm(AtomRedo);
AtomRedoFreeze = AtomAdjust(AtomRedoFreeze); TermRedoFreeze = MkAtomTerm(AtomRedoFreeze);
AtomRefoundVar = AtomAdjust(AtomRefoundVar); TermRefoundVar = MkAtomTerm(AtomRefoundVar);
AtomRelativeTo = AtomAdjust(AtomRelativeTo); TermRelativeTo = MkAtomTerm(AtomRelativeTo);

1
H/generated/tatoms.h
View File

@ -318,6 +318,7 @@ X_API EXTERNAL Atom AtomReconsult; X_API EXTERNAL Term TermReconsult;
X_API EXTERNAL Atom AtomRecordedP; X_API EXTERNAL Term TermRecordedP;
X_API EXTERNAL Atom AtomRecordedWithKey; X_API EXTERNAL Term TermRecordedWithKey;
X_API EXTERNAL Atom AtomRedefineWarnings; X_API EXTERNAL Term TermRedefineWarnings;
X_API EXTERNAL Atom AtomRedo; X_API EXTERNAL Term TermRedo;
X_API EXTERNAL Atom AtomRedoFreeze; X_API EXTERNAL Term TermRedoFreeze;
X_API EXTERNAL Atom AtomRefoundVar; X_API EXTERNAL Term TermRefoundVar;
X_API EXTERNAL Atom AtomRelativeTo; X_API EXTERNAL Term TermRelativeTo;

4
os/format.c
View File

@ -842,20 +842,24 @@ static Int doformat(volatile Term otail, volatile Term oargs,
if (targ > tnum - 1 || has_repeats)
goto do_format_control_sequence_error;
t = targs[targ++];
{
yhandle_t sl0 = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Handle_vars_f | Quote_illegal_f | To_heap_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl0);
}
break;
case 'w':
if (targ > tnum - 1 || has_repeats)
goto do_format_control_sequence_error;
t = targs[targ++];
{
yhandle_t slf = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(slf);
}
break;
case 'W':
if (targ > tnum - 2 || has_repeats)

33
pl/boot.yap
View File

@ -1094,35 +1094,34 @@ incore(G) :- '$execute'(G).
'$call'(G, CP, G, M).
'$user_call'(G, M) :-
'$gated_call'(
('$$save_by'(CP),
'$enable_debugging'),
'$call'(G, CP, M:G, M),
Port,
'$disable_debugging_on_port'(Port)
gated_call(
'$enable_debugging',
M:G,
Port,
'$disable_debugging_on_port'(Port)
).
'$disable_debugging_on_port'(retry) :-
!,
'$enable_debugging'.
'$disable_debugging_on_port'(_Port) :-
'$disable_debugging'.
'$disable_debugging'.
% enable creeping
'$enable_debugging':-
current_prolog_flag(debug, false), !.
current_prolog_flag(debug, false), !.
'$enable_debugging' :-
'$trace_on', !,
'$creep'.
'$trace_on', !,
'$creep'.
'$enable_debugging'.
'$trace_on' :-
'$nb_getval'('$trace', on, fail).
'$nb_getval'('$trace', on, fail).
'$trace_off' :-
'$nb_getval'('$trace', off, fail).
'$nb_getval'('$trace', off, fail).
/** @pred :_P_ , :_Q_ is iso, meta
@ -1300,7 +1299,7 @@ not(G) :- \+ '$execute'(G).
bootstrap(F) :-
% '$open'(F, '$csult', Stream, 0, 0, F),
% '$file_name'(Stream,File),
yap_flag(verbose_load, Old, silent),
yap_flag(verbose_load, Old, silent),
open(F, read, Stream),
stream_property(Stream, [file_name(File)]),
'$start_consult'(consult, File, LC),
@ -1434,14 +1433,14 @@ Command = (H --> B) ->
gated_call(Setup, Goal, Catcher, Cleanup) :-
'$setup_call_catcher_cleanup'(Setup),
'$gated_call'( true , Goal, Catcher, Cleanup) .
'$setup_call_catcher_cleanup'(Setup),
'$gated_call'( true , Goal, Catcher, Cleanup) .
'$gated_call'( All , Goal, Catcher, Cleanup) :-
Task0 = cleanup( All, Catcher, Cleanup, Tag, true, CP0),
Task0 = cleanup( All, Catcher, Cleanup, Tag, true, CP0),
TaskF = cleanup( All, Catcher, Cleanup, Tag, false, CP0),
'$tag_cleanup'(CP0, Task0),
call( Goal ),
'$execute'( Goal ),
'$cleanup_on_exit'(CP0, TaskF).

433
pl/debug.yap
View File

@ -16,7 +16,7 @@
*************************************************************************/
:- system_module( '$_debug', [], ['$do_spy'/4,
:- system_module( '$_debug', [], ['$spycall'/4,
'$init_debugger'/0,
'$skipeol'/1]).
@ -269,43 +269,44 @@ be lost.
%
% $spy may be called from user code, so be careful.
'$spy'([Mod|G]) :-
current_prolog_flag(debug, false), !,
'$execute_nonstop'(G,Mod).
'$stop_creeping'(_),
current_prolog_flag(debug, false),
!,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
'$stop_creeping'(_),
CP is '$last_choice_pt',
'$debugger_input',
'$do_spy'(G, Mod, CP, spy).
CP is '$last_choice_pt',
'$debugger_input',
'$spycall'(G, Mod, CP, not_expanded).
'$spy'([Mod|G], A1) :-
G =.. L,
lists:append( L, [A1], NL),
NG =.. NL,
'$spy'([Mod|NG]).
G =.. L,
lists:append( L, [A1], NL),
NG =.. NL,
'$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2) :-
G =.. L,
lists:append( L, [A1, A2], NL),
NG =.. NL,
'$spy'([Mod|NG]).
G =.. L,
lists:append( L, [A1, A2], NL),
NG =.. NL,
'$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3) :-
G =.. L,
lists:append( L, [A1, A2, A3], NL),
NG =.. NL,
'$spy'([Mod|NG]).
G =.. L,
lists:append( L, [A1, A2, A3], NL),
NG =.. NL,
'$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3, A4) :-
G =.. L,
lists:append( L, [A1,A2,A3,A4], NL),
NG =.. NL,
'$spy'([Mod|NG]).
G =.. L,
lists:append( L, [A1,A2,A3,A4], NL),
NG =.. NL,
'$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3, A4, A5) :-
G =.. L,
lists:append( L, [A1, A2, A3, A4, A5], NL),
NG =.. NL,
'$spy'([Mod|NG]).
G =.. L,
lists:append( L, [A1, A2, A3, A4, A5], NL),
NG =.. NL,
'$spy'([Mod|NG]).
'$spy'([Mod|G], A1, A2, A3, A4, A5, A6) :-
G =.. L,
@ -343,134 +344,167 @@ be lost.
'$trace_meta_call'( G, M, CP ) :-
'$do_spy'(G, M, CP, spy ).
'$spycall'(G, M, CP, not_expanded ).
% 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) :-
% writeln('$do_spy'(V, M, CP, Flag)), fail.
'$do_spy'(V, M, CP, Flag) :-
'$stop_creeping'(_),
%% @pred '$spycall'( +G, +M, +CP, Expanded)
%
%% debug a complex query
'$spycall'(V, M, CP, _) :-
var(V), !,
'$do_spy'(call(V), M, CP, Flag).
'$do_spy'(!, _, CP, _) :-
'$spycall'(call(V), M, CP, _).
'$spycall'(!, _, CP, _) :-
!, '$$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :-
'$spycall'('$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M).
'$do_spy'('$$cut_by'(M), _, _, _) :-
'$spycall'('$$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M).
'$do_spy'(true, _, _, _) :- !.
%'$do_spy'(fail, _, _, _) :- !, fail.
'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !,
'$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !,
'$do_spy'(A, M, CP, debugger),
'$do_spy'(B, M, CP, CalledFromDebugger).
'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger)
'$spycall'(true, _, _, _) :- !.
%'$spycall'(fail, _, _, _) :- !, fail.
'$spycall'(M:G, _, CP, Expanded) :-
!,
'$yap_strip_module'(M:G, G0, M0),
'$spycall'(G0, M0, CP, Expanded ).
'$spycall'((A,B), M, CP, Expanded) :- !,
'$spycall'(A, M, CP, Expanded),
'$spycall'(B, M, CP, Expanded).
'$spycall'((T->A;B), M, CP, Expanded) :- !,
( '$spycall'(T, M, CP, Expanded) -> '$spycall'(A, M, CP, Expanded)
;
'$do_spy'(B, M, CP, CalledFromDebugger)
'$spycall'(B, M, CP, Expanded)
).
'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !,
'$spycall'((T->A|B), M, CP, Expanded) :- !,
(
'$do_spy'(T, M, CP, debugger)
'$spycall'(T, M, CP, Expanded)
->
'$do_spy'(A, M, CP, CalledFromDebugger)
'$spycall'(A, M, CP, Expanded)
;
'stop_creeping'(_),
'$do_spy'(B, M, CP, CalledFromDebugger)
'$spycall'(B, M, CP, Expanded)
).
'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !,
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ).
'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !,
'$spycall'((T->A), M, CP, Expanded) :- !,
( '$spycall'(T, M, CP, Expanded) -> '$spycall'(A, M, CP, Expanded) ).
'$spycall'((A;B), M, CP, Expanded) :- !,
(
'$do_spy'(A, M, CP, CalledFromDebugger)
'$spycall'(A, M, CP, Expanded)
;
'$stop_creeping'(_),
'$do_spy'(B, M, CP, CalledFromDebugger)
'$spycall'(B, M, CP, Expanded)
).
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !,
'$spycall'((A|B), M, CP, Expanded) :- !,
(
'$do_spy'(A, M, CP, CalledFromDebugger )
'$spycall'(A, M, CP, Expanded )
;
'$stop_creeping'(_) ,
'$do_spy'(B, M, CP, CalledFromDebugger )
'$spycall'(B, M, CP, Expanded )
).
'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'((not(G)), M, CP, CalledFromDebugger) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
'$do_spy'(once(G), M, CP, CalledFromDebugger) :- !,
once( '$do_spy'(G, M, CP, CalledFromDebugger) ).
'$do_spy'(ignore(G), M, CP, CalledFromDebugger) :- !,
ignore( '$do_spy'(G, M, CP, CalledFromDebugger) ).
'$do_spy'(G, Module, _, CalledFromDebugger) :-
'$loop_spy'(G, Module, CalledFromDebugger).
'$spycall'((\+G), M, CP, Expanded) :- !,
\+ '$spycall'(G, M, CP, Expanded).
'$spycall'((not(G)), M, CP, Expanded) :- !,
\+ '$spycall'(G, M, CP, Expanded).
'$spycall'(once(G), M, CP, Expanded) :- !,
once( '$spycall'(G, M, CP, Expanded) ).
'$spycall'(ignore(G), M, CP, Expanded) :- !,
ignore( '$spycall'(G, M, CP, Expanded) ).
'$spycall'(G, M, CP, not_expanded) :-
'$is_metapredicate'(G, M),
!,
'$expand_meta_call'(M:G, [], G1),
'$spycall'(G1, M, CP, expanded).
'$spycall'(G, M, CP, _) :-
'$undefined'(G, M), !,
'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
'$spycall'(Goal, NM, CP, expanded).
'$spycall'(G, M, CP, _) :-
/* get goal no. */
'__NB_getval__'('$spy_gn',L,fail),
/* bump it */
L1 is L+1,
/* and save it globaly */
'__NB_setval__'('$spy_gn',L1),
% spy a literal
catch(
'$spygoal'(G, M, L, H),
E,
'$re_spycall'(E, G, M, L, H)
).
% we are skipping, so we can just call the goal,
% while leaving the minimal structure in place.
'$loop_spy'(G, Module, CalledFromDebugger) :-
catch(
gated_call(
'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H),
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger),
Port,
'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)),
E,
'$redo_spy'( E, G, Module, CalledFromDebugger, GoalNumber, H)
).
'$spygoal'(G, M, GoalNumber, H) :-
'$is_source'( G, M ), % use the interpreter
!,
gated_call(
'$enter_spy'(GoalNumber, G, M, true, H),
'$spy_go'(G, M),
Port,
'$spy_port'(Port, GoalNumber, G, M, true, H)
).
'$spygoal'(G, M, _, GoalNumber, H) :-
gated_call(
'$enter_spy'(GoalNumber, G, M, true, H),
'$creep_step'(G,M),
Port,
'$spy_port'(Port, GoalNumber, G, M, true, H)
).
%%% fail just fails.
'$redo_spy'(abort, _G, _Module, _CalledFromDebugger, _GoalNumber, _H) :-
'$spy_go'(G, M) :-
CP is '$last_choice_pt',
clause(M:G, Cl, _),
'$spycall'(Cl, M, CP, expanded).
%% @pred '$re_spycall'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
% - redo resets the goal
% - fail gives up on the goal.
'$re_spycall'(abort, _G, _Module, _GoalNumber, _H) :-
!,
abort.
'$redo_spy'('$forward'('$wrapper'(E),G0), _G, _Module, _CalledFromDebugger, _ '$redo_spy'('$forward'('$fail_spy',G0), __G, __Module, __CalledFromDebugger, GoalNumber, _H) :-
'$re_spycall'(forward(fail,G0), _G, __Module, GoalNumber, _H) :-
GoalNumber =< G0,
!,
fail.
'$redo_spy'('$forward'('$retry_spy',G0), G, Module, CalledFromDebugger, GoalNumber, H) :-
'$re_spycall'(forward(redo,G0), G, M, GoalNumber, H) :-
GoalNumber =< G0,
!,
catch(
gated_call(
'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H),
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger),
Port,
'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)),
E,
throw(E)
).
'$redo_spy'('$forward'(C,G0), G, _Module, _CalledFromDebugger, _GoalNumber, _H) :-
throw(C,G0).
'$spygoal'(G, M, GoalNumber, H),
E,
'$re_spycall'(E, G,M, GoalNumber, H)
).
'$re_spycall'(forward(C,G0), _G, _Module, _GoalNumber, _H) :-
throw(forward(C,G0)).
'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H) :-
'__NB_getval__'('$spy_gn',L,fail), /* get goal no. */
L1 is L+1, /* bump it */
'__NB_setval__'('$spy_gn',L1), /* and save it globaly */
'__NB_getval__'('$spy_glist',History,true), /* get goal list */
H = [info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History],
'__B_setval__'('$spy_glist',H).
/* and update it */
'$enter_spy'(L, G, Module, _CalledFromDebugger, Info) :-
/* get goal list */
'__NB_getval__'('$spy_glist',History,true),
H = [Info|History],
Info = info(L,Module,G,_Retry,_Det,_HasFoundAnswers),
'__B_setval__'('$spy_glist',H),
/* and update it */
% %'$spy_port_'(call, L, G, Module, CalledFromDebugger, Info).
'$enter_goal'(L, G, Module).
'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, Info) :-
'$stop_creeping'(_) ,
'$spy_port_'(Port, GoalNumber, G, Module, CalledFromDebugger, Info).
'$spy_port_'(call, GoalNumber, G, Module, _CalledFromDebugger, _Info) :-
'$show_trace'(call,G,Module,GoalNumber,deterministic).
'$spy_port_'(exit, GoalNumber, G, Module, CalledFromDebugger, Info) :-
nb_setarg(6, Info, true),
'$show_trace'(exit,G,Module,GoalNumber,true),
'$show_trace'(exit,G,Module,GoalNumber,deterministic),
'$continue_debugging'(exit, CalledFromDebugger).
'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, Info) :-
'$show_trace'(exit,G,Module,GoalNumber,false),
'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$show_trace'(exit,G,Module,GoalNumber,nondeterministic),
'$continue_debugging'(exit, CalledFromDebugger).
'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, Info) :-
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$show_trace'(redo,G,Module,GoalNumber,nondeterministic), /* inform user_error v */
'$continue_debugging'(fail, CalledFromDebugger).
'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, Info) :-
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform user_error */
'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$show_trace'(fail,G,Module,GoalNumber,deterministic), /* inform user_error */
'$continue_debugging'(fail, CalledFromDebugger).
'$spy_port_'(! ,G,Module,GoalNumber,_) :- /* inform user_error */
'$spy_port_'(! ,_GoalNumber,_G,_Module,_,deterministic) :- /* inform user_error */
!.
'$spy_port_'(exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :-
'$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger).
@ -480,13 +514,13 @@ be lost.
%%% - retry: forward throw while the call is newer than goal
'$TraceError'( abort, _, _, _, _).
'$TraceError'('$forward'('$retry_spy'(_G0)), _, _, _, _).
'$TraceError'(forward(redo,_G0), _, _, _, _).
%%% - backtrack long distance
'$TraceError'('$forward'('$fail_spy'(_G0)),GoalNumber, _, _, _) :- !,
throw(error('$fail_spy'(GoalNumber))).
'$TraceError'(forward(fail,_G0),GoalNumber, _, _, _) :- !,
throw(error(fail(GoalNumber))).
%%%
%%% - forward through the debugger
'$TraceError'('$forward'('$wrapper'(Event)), _, _, _, _) :-
'$TraceError'(forward('$wrapper',Event), _, _, _, _) :-
!,
throw(Event).
%%% - anything else, leave to the user and restore the catch
@ -515,7 +549,7 @@ be lost.
'$enter_goal'(GoalNumber, G, Module) :-
'$zip'(GoalNumber, G, Module), !.
'$enter_goal'(GoalNumber, G, Module) :-
'$trace'(call, G, Module, GoalNumber, _).
'$trace'(call, G, Module, GoalNumber, deterministic).
'$show_trace'(_, G, Module, GoalNumber,_) :-
'$zip'(GoalNumber, G, Module), !.
@ -545,122 +579,6 @@ be lost.
).
%
'$spycall'(G, M, _, _) :-
current_prolog_flag( debug, false),
!,
'$execute_nonstop'(G,M).
'$spycall'(G, M, _, _) :-
'__NB_getval__'('$debug_jump',true, fail),
!,
( '$is_metapredicate'(G, M)
->
'$expand_meta_call'(M:G, [], G1)
;
G = G1
),
'$execute_nonstop'(G1,M).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$is_metapredicate'(G, M),
'$debugger_expand_meta_call'(M:G, [], G10),
G10 \== M:G,
!,
'$debugger_input',
G10 = NM:NG,
'$spycall_f'(NG, NM, CalledFromDebugger, InRedo).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_f'(G, M, CalledFromDebugger, InRedo).
'$spycall_f'(G, M, _, _) :-
( '$is_opaque_predicate'(G,M) ; '$tabled_predicate'(G,M) ),
!,
'$continue_debugging_goal'(yes, '$execute_nonstop'(G,M)).
'$spycall_f'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo) :-
'$undefined'(G, M), !,
'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
'$spycall'(Goal, NM, CalledFromDebugger, InRedo).
'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
CP is '$last_choice_pt',
(
'$is_source'( G, M ) % use the interpreter
->
(
'$clause'(G, M, Cl, _)
*->
% I may backtrack to here from far away
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true )
)
;
(
'$static_clause'(G,M,_,R)
*->
'$stop_creeping'(_),
(
'$creep'('$execute_clause'(G, M, R, CP), M)
;
InRedo = true
)
)
;
( '$continue_debugging_goal'(yes, '$execute_nonstop'(G,M) ) ; InRedo = true )
).
% I may backtrack to here from far away
%
%
'$creep'('$execute_clause'(G,Mod,Ref,CP),_M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute_clause'(G,Mod,Ref,CP),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'(_)
;
'$stop_creeping'(_) ,
fail
).
'$creep'(G,M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute_nonstop'(G,M),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'(_)
;
fail
).
/**
* call predicate M:G within the ddebugger
*
*
* @return
*/
'$trace'(G,M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute0'( G, M ),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
;
fail
).
'$tabled_predicate'(G,M) :-
'$predicate_flags'(G,M,F,F),
F /\ 0x00000040 =\= 0.
%'$trace'(P,G,Module,L,Deterministic) :-
% '__NB_getval__'('$system_mode',On,fail), writeln(On), fail.
'$trace'(P,G,Module,L,Deterministic) :-
% at this point we are done with leap or skip
'__NB_setval__'('$debug_run',off),
@ -675,7 +593,9 @@ be lost.
'$action'(10,P,L,G,Module,Debug),
put_code(user_error, 10)
;
write(user_error,' ? '), get_code(debugger_input,C),
write(user_error,' ? '),
'$clear_input'(debugger_input),
get_code(debugger_input,C),
'$action'(C,P,L,G,Module,Debug)
),
/* (Debug = on
@ -694,7 +614,7 @@ be lost.
flush_output(user_output),
flush_output(user_error),
functor(P,P0,_),
(P = exit, Deterministic \= true -> Det = '?' ; Det = ' '),
(P = exit, Deterministic \= deterministic -> Det = '?' ; Det = ' '),
('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '),
% vsc: fix this
% ( SL = L -> SLL = '>' ; SLL = ' '),
@ -714,7 +634,7 @@ be lost.
'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %'
'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
% the same as fail.
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'10000 =:= 0. %'
'$debugger_write'(Stream, G) :-
current_prolog_flag( debugger_print_options, OUT ), !,
@ -775,7 +695,7 @@ be lost.
halt.
'$action'(0'f,_,CallId,_,_,_) :- !, % 'f fail
'$scan_number'(0'f, CallId, GoalId), %'f
throw('$forward'('$fail_spy'(GoalId))).
throw(forward(fail,GoalId)).
'$action'(0'h,_,_,_,_,_) :- !, % 'h help
'$action_help',
'$skipeol'(104),
@ -822,14 +742,10 @@ be lost.
'__NB_setval__'('$debug_run', -1),
'__NB_setval__'('$debug_jump',true),
nodebug.
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
'$scan_number'(0'r,CallId,ScanNumber), % '
% set_prolog_flag(debug, true),
throw('$forward'('$retry_spy'(ScanNumber))).
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
'$scan_number'(0'r,CallId,ScanNumber), % '
% set_prolog_flag(debug, true),
throw('$forward'('$wrapper'(ScanNumber))).
throw(forward(redo,ScanNumber)).
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
'$skipeol'(0's), % '
(
@ -861,7 +777,7 @@ be lost.
'$show_ancestors'(HowMany),
fail.
'$action'(0'T,exception(G),_,_,_,_) :- !, % 'T throw
throw( '$forward'('$wrapper'(G))).
throw( forward('$wrapper',G)).
'$action'(C,_,_,_,_,_) :-
'$skipeol'(C),
'$ilgl'(C),
@ -900,18 +816,6 @@ be lost.
'$continue_debugging_goal'(_,G) :-
'$execute_creep_dgoal'(G).
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
'$execute_nonstop'(G,M).
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$execute_clause'(G, M, R, CP).
'$execute_creep_dgoal'('$execute_nonstop'(G,M)) :-
'$creep',
'$execute_nonstop'(G,M).
'$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :-
'$creep',
'$execute_clause'(G, M, R, CP).
'$show_ancestors'(HowMany) :-
'__NB_getval__'('$spy_glist',[_|History], fail),
(
@ -1046,14 +950,11 @@ be lost.
'$delete_if_there'([Q|L], T, TN, [Q|LN]) :-
'$delete_if_there'(L, T, TN, LN).
'$debugger_deterministic_goal'(G) :-
yap_hacks:current_choicepoints(CPs0),
% $cps(CPs0),
'$debugger_skip_traces'(CPs0,CPs1),
'$debugger_skip_loop_spy2'(CPs1,CPs2),
'$debugger_skip_spycall'(CPs2,CPs3),
'$debugger_skip_loop_spy2'(CPs3,[Catch|_]),
yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$TraceError'(_,_,G,_,_),_),_).
'$debugger_deterministic_goal'(exit).
'$debugger_deterministic_goal'(fail).
'$debugger_deterministic_goal'(!).
'$debugger_deterministic_goal'(exception(_)).
'$debugger_deterministic_goal'(external_exception(_)).
'$cps'([CP|CPs]) :-

4
pl/hacks.yap
View File

@ -209,8 +209,8 @@ beautify_hidden_goal('$continue_with_command'(Command,V,P,G,Source),prolog) -->
['TopLevel'(Command,G,V,P,Source)].
beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
['DebuggerCall'(M:G, InControl, Redo)].
beautify_hidden_goal('$do_spy'(Goal, Mod, _CP, InControl),prolog) -->
['DebuggerCall'(Mod:Goal, InControl)].
beautify_hidden_goal('$spycall'(Goal, Mod, _CP, Expanded),prolog) -->
['DebuggerCall'(Mod:Goal, Expanded)].
beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
[catch(Mod:G, Exc, Handler)].
beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->

24
pl/signals.yap
View File

@ -25,7 +25,7 @@
:- use_system_module( '$_boot', ['$meta_call'/2]).
:- use_system_module( '$_debug', ['$do_spy'/4]).
:- use_system_module( '$_debug', ['$spycall'/4]).
:- use_system_module( '$_threads', ['$thread_gfetch'/1]).
@ -160,7 +160,8 @@ order of dispatch.
% never creep on entering system mode!!!
% don't creep on meta-call.
'$do_signal'(sig_creep, MG) :-
'$start_creep'(MG, creep).
'$disable_debugging',
'$start_creep'(MG, creep).
'$do_signal'(sig_iti, [M|G]) :-
'$thread_gfetch'(Goal),
% if more signals alive, set creep flag
@ -215,26 +216,13 @@ order of dispatch.
% we may be creeping outside and coming back to system mode.
'$start_creep'([_M|G], _) :-
nonvar(G),
nonvar(G),
G = '$$cut_by'(CP),
!,
'$$cut_by'(CP).
'$start_creep'([M|G], _) :-
'$is_no_trace'(G, M), !,
(
'$$save_by'(CP),
'$no_creep_call'(G,M),
'$$save_by'(CP2),
'$disable_debugging',
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
'$enable_debugging'
;
'$disable_debugging',
fail
).
'$start_creep'([Mod|G], WhereFrom) :-
'$start_creep'([Mod|G], _WhereFrom) :-
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, WhereFrom).
'$spycall'(G, Mod, CP, not_expanded).
'$no_creep_call'('$execute_clause'(G,Mod,Ref,CP),_) :- !,
'$enable_debugging',