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 2006-03-20 19:51:44 +00:00
parent cbc94bbaf7
commit 1edb3a8115
10 changed files with 127 additions and 105 deletions

116
C/cdmgr.c
View File

@ -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;

View File

@ -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",

View File

@ -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
*
@ -3947,6 +3950,7 @@ static UInt *
do_nonvar_group(GroupDef *grp, Term t, UInt compound_term, CELL *sreg, UInt arity, UInt labl, struct intermediates *cint, UInt argno, int first, int last_arg, UInt nxtlbl, int clleft, CELL *top) {
TypeSwitch *type_sw;
PredEntry *ap = cint->CurrentPred;
/* move cl pointer */
if (grp->AtomClauses + grp->PairClauses + grp->StructClauses > 1) {
@ -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,10 +4144,12 @@ 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);
Yap_emit(jump_v_op, suspend_indexing(min, max, ap, cint), Zero, cint);
}
}
for (i=0; i < ngroups; i++) {

View File

@ -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++;

View File

@ -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) :- {}.

View File

@ -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*/

View File

@ -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>

View File

@ -1,4 +1,4 @@
vMdnl
dnl
dnl Process this file with autoconf to produce a configure script.
dnl

View File

@ -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.

View File

@ -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),