diff --git a/C/cdmgr.c b/C/cdmgr.c index cb9ffcab6..b7c601872 100644 --- a/C/cdmgr.c +++ b/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 #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; diff --git a/C/heapgc.c b/C/heapgc.c index f366abeee..2cf2e3def 100644 --- a/C/heapgc.c +++ b/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", diff --git a/C/index.c b/C/index.c index 75fb79fad..98a019d69 100644 --- a/C/index.c +++ b/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 * @@ -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++) { diff --git a/C/tracer.c b/C/tracer.c index aab64c11a..f7cf5e68f 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -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++; diff --git a/CLPBN/clpbn/examples/School/evidence_128.yap b/CLPBN/clpbn/examples/School/evidence_128.yap index c674b10e4..d3d72799f 100644 --- a/CLPBN/clpbn/examples/School/evidence_128.yap +++ b/CLPBN/clpbn/examples/School/evidence_128.yap @@ -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) :- {}. diff --git a/H/Yapproto.h b/H/Yapproto.h index 432fd680a..e2e3c04a6 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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*/ diff --git a/changes-5.1.html b/changes-5.1.html index 987dc4365..3500653fc 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,13 @@

Yap-5.1.0: