fix indexing and tabling bugs
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1567 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
cbc94bbaf7
commit
1edb3a8115
116
C/cdmgr.c
116
C/cdmgr.c
@ -11,8 +11,12 @@
|
||||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2006-03-06 14:04:56 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-03-20 19:51:43 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.177 2006/03/06 14:04:56 vsc
|
||||
* fixes to garbage collector
|
||||
* fixes to debugger
|
||||
*
|
||||
* Revision 1.176 2006/02/01 13:28:56 vsc
|
||||
* bignum support fixes
|
||||
*
|
||||
@ -287,6 +291,12 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
|
||||
#ifdef YAPOR
|
||||
#include "or.macros.h"
|
||||
#endif /* YAPOR */
|
||||
#ifdef TABLING
|
||||
#include "tab.macros.h"
|
||||
#endif /* TABLING */
|
||||
#ifdef YAPOR
|
||||
#include "or.macros.h"
|
||||
#endif /* YAPOR */
|
||||
#if HAVE_STRING_H
|
||||
#include <string.h>
|
||||
#endif
|
||||
@ -604,7 +614,6 @@ split_megaclause(PredEntry *ap)
|
||||
start = cl->ClNext;
|
||||
Yap_InformOfRemoval((CODEADDR)cl);
|
||||
Yap_FreeCodeSpace((char *)cl);
|
||||
start = NULL;
|
||||
}
|
||||
if (ap->ArityOfPE) {
|
||||
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"while breaking up mega clause for %s/%d\n",RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,ap->ArityOfPE);
|
||||
@ -962,9 +971,31 @@ kill_static_child_indxs(StaticIndex *indx)
|
||||
Yap_FreeCodeSpace((char *)indx);
|
||||
}
|
||||
|
||||
static void
|
||||
kill_children(LogUpdIndex *c, PredEntry *ap)
|
||||
{
|
||||
LogUpdIndex *ncl;
|
||||
|
||||
LOCK(c->ClLock);
|
||||
c->ClRefCount++;
|
||||
ncl = c->ChildIndex;
|
||||
/* kill children */
|
||||
while (ncl) {
|
||||
UNLOCK(c->ClLock);
|
||||
kill_first_log_iblock(ncl, c, ap);
|
||||
LOCK(c->ClLock);
|
||||
ncl = c->ChildIndex;
|
||||
}
|
||||
c->ClRefCount--;
|
||||
UNLOCK(c->ClLock);
|
||||
}
|
||||
|
||||
static void
|
||||
kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
{
|
||||
/* first, make sure that I killed off all my children, some children may
|
||||
remain in case I have tables as children */
|
||||
kill_children(c, ap);
|
||||
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
|
||||
if (parent != NULL) {
|
||||
/* sat bye bye */
|
||||
@ -1006,8 +1037,6 @@ kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
static void
|
||||
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
{
|
||||
|
||||
LogUpdIndex *ncl;
|
||||
/* parent is always locked, now I lock myself */
|
||||
LOCK(c->ClLock);
|
||||
if (parent != NULL) {
|
||||
@ -1027,25 +1056,16 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
}
|
||||
}
|
||||
UNLOCK(parent->ClLock);
|
||||
} else {
|
||||
/* I am top node */
|
||||
if (ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
|
||||
RemoveMainIndex(ap);
|
||||
}
|
||||
}
|
||||
/* make sure that a child cannot remove us */
|
||||
c->ClRefCount++;
|
||||
ncl = c->ChildIndex;
|
||||
/* kill children */
|
||||
while (ncl) {
|
||||
UNLOCK(c->ClLock);
|
||||
kill_first_log_iblock(ncl, c, ap);
|
||||
LOCK(c->ClLock);
|
||||
ncl = c->ChildIndex;
|
||||
}
|
||||
UNLOCK(c->ClLock);
|
||||
kill_children(c, ap);
|
||||
/* check if we are still the main index */
|
||||
if (parent == NULL &&
|
||||
ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
|
||||
RemoveMainIndex(ap);
|
||||
}
|
||||
LOCK(c->ClLock);
|
||||
c->ClRefCount--;
|
||||
if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
|
||||
kill_off_lu_block(c, parent, ap);
|
||||
} else {
|
||||
@ -1064,7 +1084,6 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
parent->ClRefCount--;
|
||||
UNLOCK(parent->ClLock);
|
||||
}
|
||||
c->ChildIndex = (LogUpdIndex *)ap;
|
||||
c->SiblingIndex = DBErasedIList;
|
||||
DBErasedIList = c;
|
||||
UNLOCK(c->ClLock);
|
||||
@ -1222,7 +1241,6 @@ Yap_RemoveIndexation(PredEntry *ap)
|
||||
static void
|
||||
retract_all(PredEntry *p, int in_use)
|
||||
{
|
||||
yamop *fclause = NULL, *lclause = NULL;
|
||||
yamop *q;
|
||||
|
||||
q = p->cs.p_code.FirstClause;
|
||||
@ -1248,6 +1266,8 @@ retract_all(PredEntry *p, int in_use)
|
||||
Yap_InformOfRemoval((CODEADDR)cl);
|
||||
Yap_FreeCodeSpace((char *)cl);
|
||||
}
|
||||
/* make sure this is not a MegaClause */
|
||||
p->PredFlags &= ~MegaClausePredFlag;
|
||||
p->cs.p_code.NOfClauses = 0;
|
||||
} else {
|
||||
StaticClause *cl = ClauseCodeToStaticClause(q);
|
||||
@ -1270,27 +1290,17 @@ retract_all(PredEntry *p, int in_use)
|
||||
} while (TRUE);
|
||||
}
|
||||
}
|
||||
p->cs.p_code.FirstClause = fclause;
|
||||
p->cs.p_code.LastClause = lclause;
|
||||
if (fclause == NIL) {
|
||||
if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
|
||||
p->OpcodeOfPred = FAIL_OPCODE;
|
||||
} else {
|
||||
p->OpcodeOfPred = UNDEF_OPCODE;
|
||||
}
|
||||
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||
p->StatisticsForPred.NOfEntries = 0;
|
||||
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
||||
p->StatisticsForPred.NOfRetries = 0;
|
||||
p->cs.p_code.FirstClause = NULL;
|
||||
p->cs.p_code.LastClause = NULL;
|
||||
if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
|
||||
p->OpcodeOfPred = FAIL_OPCODE;
|
||||
} else {
|
||||
if (p->PredFlags & SpiedPredFlag) {
|
||||
p->OpcodeOfPred = Yap_opcode(_spy_pred);
|
||||
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||
} else if (p->PredFlags & IndexedPredFlag) {
|
||||
p->OpcodeOfPred = INDEX_OPCODE;
|
||||
p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||
}
|
||||
p->OpcodeOfPred = UNDEF_OPCODE;
|
||||
}
|
||||
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||
p->StatisticsForPred.NOfEntries = 0;
|
||||
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
||||
p->StatisticsForPred.NOfRetries = 0;
|
||||
if (PROFILING) {
|
||||
p->PredFlags |= ProfiledPredFlag;
|
||||
} else
|
||||
@ -1537,6 +1547,10 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
|
||||
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||
}
|
||||
return;
|
||||
} else {
|
||||
StaticClause *cl = ClauseCodeToStaticClause(pt);
|
||||
|
||||
cl->ClNext = ClauseCodeToStaticClause(cp);
|
||||
}
|
||||
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) {
|
||||
if (!(p->PredFlags & SpiedPredFlag)) {
|
||||
@ -1544,23 +1558,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
|
||||
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||
}
|
||||
}
|
||||
{
|
||||
StaticClause *cl = ClauseCodeToStaticClause(pt);
|
||||
cl->ClNext = ClauseCodeToStaticClause(cp);
|
||||
}
|
||||
p->cs.p_code.LastClause = cp;
|
||||
#ifdef YAPOR
|
||||
{
|
||||
StaticClause *cl = ClauseCodeToStaticClause(p->cs.p_code.FirstClause);
|
||||
|
||||
while (TRUE) {
|
||||
PUT_YAMOP_LTT((yamop *)code, YAMOP_LTT(cl->ClCode) + 1);
|
||||
if (cl->ClCode == p->cs.p_code.LastClause)
|
||||
break;
|
||||
cl = cl->NextCl;
|
||||
}
|
||||
}
|
||||
#endif /* YAPOR */
|
||||
}
|
||||
|
||||
/* p is already locked */
|
||||
@ -1933,6 +1931,9 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) {
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
WPP = NULL;
|
||||
#endif
|
||||
if (ap->PredFlags & MegaClausePredFlag) {
|
||||
split_megaclause(ap);
|
||||
}
|
||||
if (ap->PredFlags & IndexedPredFlag)
|
||||
RemoveIndexation(ap);
|
||||
ap->cs.p_code.NOfClauses--;
|
||||
@ -1959,7 +1960,6 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) {
|
||||
ocl = pcl;
|
||||
pcl = pcl->ClNext;
|
||||
}
|
||||
ocl->ClCode->u.ld.d = cl->ClCode->u.ld.d;
|
||||
ocl->ClNext = cl->ClNext;
|
||||
if (cl->ClCode == ap->cs.p_code.LastClause) {
|
||||
ap->cs.p_code.LastClause = ocl->ClCode;
|
||||
@ -2937,7 +2937,7 @@ p_kill_dynamic(void)
|
||||
WRITE_UNLOCK(pe->PRWLock);
|
||||
return (FALSE);
|
||||
}
|
||||
pe->cs.p_code.LastClause = pe->cs.p_code.FirstClause = NIL;
|
||||
pe->cs.p_code.LastClause = pe->cs.p_code.FirstClause = NULL;
|
||||
pe->OpcodeOfPred = UNDEF_OPCODE;
|
||||
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
|
||||
pe->PredFlags = pe->PredFlags & GoalExPredFlag;
|
||||
|
||||
39
C/heapgc.c
39
C/heapgc.c
@ -23,7 +23,6 @@ static char SccsId[] = "%W% %G%";
|
||||
#include "alloc.h"
|
||||
#include "attvar.h"
|
||||
|
||||
#define EARLY_RESET 1
|
||||
#if !defined(TABLING)
|
||||
#define EASY_SHUNTING 1
|
||||
#endif /* !TABLING */
|
||||
@ -1560,6 +1559,10 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
while (trail_base < trail_ptr) {
|
||||
register CELL trail_cell;
|
||||
|
||||
if (trail_base == ((CELL *)0x204bc000)+0x320d) {
|
||||
extern int jmp_deb();
|
||||
jmp_deb(1);
|
||||
}
|
||||
trail_cell = TrailTerm(trail_base);
|
||||
|
||||
if (IsVarTerm(trail_cell)) {
|
||||
@ -1569,19 +1572,14 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
we must use gc_H to avoid trouble with dangling variables
|
||||
in the heap */
|
||||
if (((hp < gc_H && hp >= H0) || (hp > (CELL *)gc_B && hp < LCL0) ) && !MARKED_PTR(hp)) {
|
||||
#ifdef EARLY_RESET
|
||||
/* reset to be a variable */
|
||||
/* perform early reset */
|
||||
/* reset term to be a variable */
|
||||
RESET_VARIABLE(hp);
|
||||
discard_trail_entries++;
|
||||
RESET_VARIABLE(&TrailTerm(trail_base));
|
||||
#ifdef FROZEN_STACKS
|
||||
RESET_VARIABLE(&TrailVal(trail_base));
|
||||
#endif
|
||||
#else
|
||||
/* if I have no early reset I have to follow the trail chain */
|
||||
mark_external_reference(&TrailTerm(trail_base));
|
||||
UNMARK(&TrailTerm(trail_base));
|
||||
#endif /* EARLY_RESET */
|
||||
} else if (hp < (CELL *)Yap_GlobalBase || hp > (CELL *)Yap_TrailTop) {
|
||||
/* pointers from the Heap back into the trail are process in mark_regs. */
|
||||
/* do nothing !!! */
|
||||
@ -1596,8 +1594,9 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
||||
if (trail_cell == (CELL)trail_base)
|
||||
discard_trail_entries++;
|
||||
#ifdef FROZEN_STACKS
|
||||
else
|
||||
else {
|
||||
mark_external_reference(&TrailVal(trail_base));
|
||||
}
|
||||
#endif
|
||||
#ifdef EASY_SHUNTING
|
||||
if (hp < gc_H && hp >= H0) {
|
||||
@ -2183,17 +2182,16 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
||||
if (HEAP_PTR(trail_cell)) {
|
||||
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
/* it is complex to recover cells with frozen segments */
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED_PTR(&TrailVal(dest))) {
|
||||
UNMARK(&TrailVal(dest));
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
#ifdef FROZEN_STACKS
|
||||
/* it is complex to recover cells with frozen segments */
|
||||
TrailVal(dest) = TrailVal(trail_ptr);
|
||||
if (MARKED_PTR(&TrailVal(dest))) {
|
||||
if (HEAP_PTR(TrailVal(dest))) {
|
||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||
}
|
||||
}
|
||||
#endif
|
||||
} else if (IsPairTerm(trail_cell)) {
|
||||
CELL *pt0 = RepPair(trail_cell);
|
||||
CELL flags;
|
||||
@ -3556,9 +3554,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
||||
fprintf(Yap_stderr, "%% gc\n");
|
||||
} else if (gc_verbose) {
|
||||
fprintf(Yap_stderr, "%% Start of garbage collection %d:\n", GcCalls);
|
||||
#ifndef EARLY_RESET
|
||||
fprintf(Yap_stderr, "%% no early reset in trail\n");
|
||||
#endif
|
||||
fprintf(Yap_stderr, "%% Global: %8ld cells (%p-%p)\n", (long int)heap_cells,H0,H);
|
||||
fprintf(Yap_stderr, "%% Local:%8ld cells (%p-%p)\n", (unsigned long int)(LCL0-ASP),LCL0,ASP);
|
||||
fprintf(Yap_stderr, "%% Trail:%8ld cells (%p-%p)\n",
|
||||
|
||||
26
C/index.c
26
C/index.c
@ -11,8 +11,11 @@
|
||||
* File: index.c *
|
||||
* comments: Indexing a Prolog predicate *
|
||||
* *
|
||||
* Last rev: $Date: 2006-02-22 11:55:36 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2006-03-20 19:51:43 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.153 2006/02/22 11:55:36 vsc
|
||||
* indexing code would get confused about size of float/1, db_reference1.
|
||||
*
|
||||
* Revision 1.152 2006/02/19 02:55:46 vsc
|
||||
* disable indexing on bigints
|
||||
*
|
||||
@ -3948,6 +3951,7 @@ do_nonvar_group(GroupDef *grp, Term t, UInt compound_term, CELL *sreg, UInt arit
|
||||
TypeSwitch *type_sw;
|
||||
PredEntry *ap = cint->CurrentPred;
|
||||
|
||||
|
||||
/* move cl pointer */
|
||||
if (grp->AtomClauses + grp->PairClauses + grp->StructClauses > 1) {
|
||||
Yap_emit(label_op, labl, Zero, cint);
|
||||
@ -4116,13 +4120,19 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
|
||||
}
|
||||
} else {
|
||||
UInt special_options;
|
||||
|
||||
if ((ap->PredFlags & LogUpdatePredFlag) && ngroups > 1) {
|
||||
/* make sure we only expand at a single point */
|
||||
if (group[0].VarClauses && ngroups > 3) {
|
||||
int ncls = group[ngroups-1].LastClause-group[2].FirstClause;
|
||||
group[2].VarClauses += ncls;
|
||||
group[2].LastClause = group[ngroups-1].LastClause;
|
||||
ngroups = 3;
|
||||
if (group[0].VarClauses) {
|
||||
/* the problem here is that I really cannot safely handle the
|
||||
case where the index is in use and the first case is
|
||||
discarded. In this case, the indexing code will try to
|
||||
remove any switches below,
|
||||
and they still might useful if you were backtracking
|
||||
from the first clause. */
|
||||
group[0].VarClauses = ap->cs.p_code.NOfClauses;
|
||||
group[0].LastClause = group[ngroups-1].LastClause;
|
||||
ngroups = 1;
|
||||
} else if (!group[0].VarClauses && ngroups > 2) {
|
||||
int ncls = group[ngroups-1].LastClause-group[1].FirstClause;
|
||||
group[1].VarClauses += ncls;
|
||||
@ -4134,7 +4144,9 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
|
||||
}
|
||||
if (ngroups == 1 && group->VarClauses && !found_pvar) {
|
||||
return do_index(min, max, cint, argno+1, fail_l, first, clleft, top);
|
||||
} else if (found_pvar) {
|
||||
} else if (found_pvar ||
|
||||
(ap->PredFlags & LogUpdatePredFlag && group[0].VarClauses)) {
|
||||
/* make sure we know where to suspend */
|
||||
Yap_emit(label_op, labl0, Zero, cint);
|
||||
labl = new_label();
|
||||
Yap_emit(jump_v_op, suspend_indexing(min, max, ap, cint), Zero, cint);
|
||||
|
||||
@ -122,6 +122,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
char *mname;
|
||||
Int arity;
|
||||
/* extern int gc_calls; */
|
||||
static PredEntry *pe;
|
||||
|
||||
sc = Yap_heap_regs;
|
||||
vsc_count++;
|
||||
|
||||
@ -7,11 +7,11 @@ professor_popularity(p5,l) :- {}.
|
||||
professor_popularity(p45,h) :- {}.
|
||||
professor_popularity(p15,m) :- {}.
|
||||
|
||||
course_rating(c0, a) :- {}.
|
||||
course_rating(c1, b) :- {}.
|
||||
course_rating(c2, c) :- {}.
|
||||
course_rating(c3, a) :- {}.
|
||||
course_rating(c4, a) :- {}.
|
||||
course_rating(c5, d) :- {}.
|
||||
course_rating(c62, b) :- {}.
|
||||
course_rating(c0, h) :- {}.
|
||||
course_rating(c1, m) :- {}.
|
||||
course_rating(c2, l) :- {}.
|
||||
course_rating(c3, h) :- {}.
|
||||
course_rating(c4, m) :- {}.
|
||||
course_rating(c5, l) :- {}.
|
||||
course_rating(c62, m) :- {}.
|
||||
|
||||
|
||||
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* comments: Function declarations for YAP *
|
||||
* version: $Id: Yapproto.h,v 1.71 2006-03-10 16:58:39 tiagosoares Exp $ *
|
||||
* version: $Id: Yapproto.h,v 1.72 2006-03-20 19:51:44 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* prototype file for Yap */
|
||||
@ -327,9 +327,7 @@ void STD_PROTO(Yap_InitUtilCPreds,(void));
|
||||
MYDDAS_GLOBAL STD_PROTO(myddas_util_initialize_myddas,(void));
|
||||
|
||||
/* myddas_util.c */
|
||||
#ifdef MYDDAS_MYSQL
|
||||
void STD_PROTO(myddas_util_table_write,(MYSQL_RES *));
|
||||
#endif
|
||||
/* Returns the connection type (mysql -> 1 or odbc -> 2) */
|
||||
Short STD_PROTO(myddas_util_connection_type,(void *));
|
||||
/* Adds a connection identifier to the MYDDAS connections list*/
|
||||
|
||||
@ -16,6 +16,13 @@
|
||||
|
||||
<h2>Yap-5.1.0:</h2>
|
||||
<ul>
|
||||
<li> FIXED: if LU indices have groups, we should create
|
||||
try-retry-trust sequences immediately, otherwise LU semantics can be
|
||||
compromised (obs ).</li>
|
||||
<li> FIXED: when cleaning trail, gc would not always clean value
|
||||
field! (obs Remko Troncon).</li>
|
||||
<li> FIXED: when cleaning megaclauses, clean flag too.</li>
|
||||
<li> FIXED: don't put array twice in list of live arrays (gc would loop).</li>
|
||||
<li> NEW: debugger will not backtrack over complete deterministic computations.</li>
|
||||
<li> NEW: debugger can show CP stack.</li>
|
||||
<li> NEW: internal procedure to show choice-point stack.</li>
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
vMdnl
|
||||
dnl
|
||||
dnl Process this file with autoconf to produce a configure script.
|
||||
dnl
|
||||
|
||||
|
||||
@ -910,6 +910,7 @@ Unix-like environments. A simple example is shown next:
|
||||
#
|
||||
# Hello World script file using Yap
|
||||
#
|
||||
# put a dot because of syntax errors .
|
||||
|
||||
:- write('Hello World'), nl.
|
||||
|
||||
|
||||
20
pl/debug.yap
20
pl/debug.yap
@ -318,8 +318,7 @@ debugging :-
|
||||
% we are skipping, so we can just call the goal,
|
||||
% while leaving the minimal structure in place.
|
||||
'$loop_spy'(GoalNumber, G, Module, InControl) :-
|
||||
CP is '$last_choice_pt',
|
||||
'$system_catch'('$loop_spy2'(GoalNumber, CP, G, Module, InControl),
|
||||
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl),
|
||||
Module, Event,
|
||||
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
|
||||
|
||||
@ -336,6 +335,11 @@ debugging :-
|
||||
'$loop_fail'(GoalNumber, G, Module, InControl).
|
||||
'$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !,
|
||||
throw('$fail_spy'(GoalNumber)).
|
||||
'$loop_spy_event'('$done_spy'(G0), GoalNumber, G, Module, InControl) :-
|
||||
G0 >= GoalNumber, !,
|
||||
'$continue_debugging'.
|
||||
'$loop_spy_event'('$done_spy'(GoalNumber), _, _, _, _) :- !,
|
||||
throw('$done_spy'(GoalNumber)).
|
||||
'$loop_spy_event'(abort, _, _, _, _) :- !,
|
||||
throw('$abort').
|
||||
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl) :-
|
||||
@ -358,7 +362,7 @@ debugging :-
|
||||
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
|
||||
|
||||
% if we are in
|
||||
'$loop_spy2'(GoalNumber, CP, G, Module, InControl) :-
|
||||
'$loop_spy2'(GoalNumber, G, Module, InControl) :-
|
||||
/* the following choice point is where the predicate is called */
|
||||
(
|
||||
/* call port */
|
||||
@ -370,7 +374,7 @@ debugging :-
|
||||
'$show_trace'(exit,G,Module,GoalNumber), /* output message at exit */
|
||||
/* exit port */
|
||||
/* get rid of deterministic computations */
|
||||
('$debugger_deterministic_goal'(G) -> '$cut_by'(CP) ; true),
|
||||
('$debugger_deterministic_goal'(G) -> throw('$done_spy'(GoalNumber)) ; true),
|
||||
'$continue_debugging'
|
||||
;
|
||||
/* backtracking from exit */
|
||||
@ -738,9 +742,13 @@ debugging :-
|
||||
'$continue_debug_show_cp'(prolog,'$do_live',0,(_;_),Level) :- !,
|
||||
format(user_error,' [~d] \'$toplevel\'',[Level]).
|
||||
'$continue_debug_show_cp'(prolog,'$do_log_upd_clause',4,'$do_log_upd_clause'(_,_,Goal,_),Level) :- !,
|
||||
format(user_error,' [~d] ~q~n',[Level,Goal]).
|
||||
format(user_error,' [~d] ',[Level]),
|
||||
'$debugger_write'(user_error,Goal),
|
||||
nl(user_error).
|
||||
'$continue_debug_show_cp'(prolog,'$do_static_clause',5,'$do_static_clause'(_,_,Goal,_,_),Level) :- !,
|
||||
format(user_error,' [~d] ~q~n',[Level,Goal]).
|
||||
format(user_error,' [~d] ',[Level]),
|
||||
'$debugger_write'(user_error,Goal),
|
||||
nl(user_error).
|
||||
'$continue_debug_show_cp'(Module,Name,Arity,Goal,_) :-
|
||||
functor(G0, Name, Arity), fail,
|
||||
'$hidden_predicate'(G0,Module),
|
||||
|
||||
Reference in New Issue
Block a user