diff --git a/C/cdmgr.c b/C/cdmgr.c index 877f75889..f1da099a9 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2006-03-22 16:14:20 $,$Author: vsc $ * +* Last rev: $Date: 2006-03-22 20:07:28 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.180 2006/03/22 16:14:20 vsc +* don't be too eager at throwing indexing code for static predicates away. +* * Revision 1.179 2006/03/21 17:11:39 vsc * prevent breakage * @@ -566,6 +569,7 @@ Yap_BuildMegaClause(PredEntry *ap) mcl->ClSize = sz*ap->cs.p_code.NOfClauses; mcl->ClPred = ap; mcl->ClItemSize = sz; + mcl->ClNext = NULL; cl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause); ptr = mcl->ClCode; @@ -968,21 +972,20 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code) } static void -kill_static_child_indxs(StaticIndex *indx) +kill_static_child_indxs(StaticIndex *indx, int in_use) { StaticIndex *cl = indx->ChildIndex; while (cl != NULL) { StaticIndex *next = cl->SiblingIndex; - kill_static_child_indxs(cl); + kill_static_child_indxs(cl, in_use); cl = next; } - if (static_in_use(indx->ClPred, TRUE)) { - DeadClause *dcl = (DeadClause *)indx; - UInt sz = indx->ClSize; - dcl->NextCl = DeadClauses; - dcl->ClFlags = 0; - dcl->ClSize = sz; - DeadClauses = dcl; + if (in_use) { + LOCK(DeadStaticIndicesLock); + indx->SiblingIndex = DeadStaticIndices; + indx->ChildIndex = NULL; + DeadStaticIndices = indx; + UNLOCK(DeadStaticIndicesLock); } else { Yap_InformOfRemoval((CODEADDR)indx); Yap_FreeCodeSpace((char *)indx); @@ -1111,7 +1114,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap) static void kill_top_static_iblock(StaticIndex *c, PredEntry *ap) { - kill_static_child_indxs(c); + kill_static_child_indxs(c, static_in_use(ap, TRUE)); RemoveMainIndex(ap); } @@ -1150,7 +1153,7 @@ Yap_kill_iblock(ClauseUnion *blk, ClauseUnion *parent_blk, PredEntry *ap) cl->SiblingIndex = c->SiblingIndex; } } - kill_static_child_indxs(c); + kill_static_child_indxs(c, static_in_use(ap, TRUE)); } } @@ -1272,13 +1275,11 @@ retract_all(PredEntry *p, int in_use) } else if (p->PredFlags & MegaClausePredFlag) { MegaClause *cl = ClauseCodeToMegaClause(q); - if (cl->ClFlags & HasBlobsMask) { - DeadClause *dcl = (DeadClause *)cl; - UInt sz = cl->ClSize; - dcl->NextCl = DeadClauses; - dcl->ClFlags = 0; - dcl->ClSize = sz; - DeadClauses = dcl; + if (in_use || cl->ClFlags & HasBlobsMask) { + LOCK(DeadMegaClausesLock); + cl->ClNext = DeadMegaClauses; + DeadMegaClauses = cl; + UNLOCK(DeadMegaClausesLock); } else { Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); @@ -1289,22 +1290,22 @@ retract_all(PredEntry *p, int in_use) } else { StaticClause *cl = ClauseCodeToStaticClause(q); - do { - if (cl->ClFlags & HasBlobsMask) { - DeadClause *dcl = (DeadClause *)cl; - UInt sz = cl->ClSize; - dcl->NextCl = DeadClauses; - dcl->ClFlags = 0; - dcl->ClSize = sz; - DeadClauses = dcl; + while (cl) { + StaticClause *ncl = cl->ClNext; + + if (in_use|| cl->ClFlags & HasBlobsMask) { + LOCK(StaticClausesLock); + cl->ClNext = DeadStaticClauses; + DeadStaticClauses = cl; + UNLOCK(StaticClausesLock); } else { Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); } p->cs.p_code.NOfClauses--; - if (cl->ClCode == p->cs.p_code.LastClause) break; - cl = cl->ClNext; - } while (TRUE); + if (!ncl) break; + cl = ncl; + } } } p->cs.p_code.FirstClause = NULL; @@ -1993,12 +1994,10 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) { #endif WRITE_UNLOCK(ap->PRWLock); if (cl->ClFlags & HasBlobsMask || static_in_use(ap,TRUE)) { - DeadClause *dcl = (DeadClause *)cl; - UInt sz = cl->ClSize; - dcl->NextCl = DeadClauses; - dcl->ClFlags = 0; - dcl->ClSize = sz; - DeadClauses = dcl; + LOCK(DeadStaticClauses); + cl->ClNext = DeadStaticClauses; + DeadStaticClauses = cl; + UNLOCK(DeadStaticClauses); } else { Yap_InformOfRemoval((CODEADDR)cl); Yap_FreeCodeSpace((char *)cl); @@ -4468,13 +4467,25 @@ p_call_count_set(void) static Int p_clean_up_dead_clauses(void) { - while (DeadClauses != NULL) { - char *pt = (char *)DeadClauses; - DeadClauses = DeadClauses->NextCl; + while (DeadStaticClauses != NULL) { + char *pt = (char *)DeadStaticClauses; + DeadStaticClauses = DeadStaticClauses->ClNext; Yap_InformOfRemoval((CODEADDR)pt); Yap_FreeCodeSpace(pt); } - return(TRUE); + while (DeadStaticIndices != NULL) { + char *pt = (char *)DeadStaticIndices; + DeadStaticIndices = DeadStaticIndices->SiblingIndex; + Yap_InformOfRemoval((CODEADDR)pt); + Yap_FreeCodeSpace(pt); + } + while (DeadMegaClauses != NULL) { + char *pt = (char *)DeadMegaClauses; + DeadMegaClauses = DeadMegaClauses->ClNext; + Yap_InformOfRemoval((CODEADDR)pt); + Yap_FreeCodeSpace(pt); + } + return TRUE; } static Int /* $parent_pred(Module, Name, Arity) */ @@ -5268,6 +5279,7 @@ p_static_pred_statistics(void) return static_statistics(pe); } +#ifdef DEBUG static Int p_predicate_erased_statistics(void) { @@ -5311,6 +5323,7 @@ p_predicate_erased_statistics(void) Yap_unify(ARG4,MkIntegerTerm(icls)) && Yap_unify(ARG5,MkIntegerTerm(isz)); } +#endif static Int p_program_continuation(void) diff --git a/C/dbase.c b/C/dbase.c index d50f7dcf1..19b991ed0 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -3912,39 +3912,6 @@ RemoveDBEntry(DBRef entryref) FreeDBSpace((char *) entryref); } -static void -clean_lu_index(DBRef index) { - DBRef *te = (DBRef *)(index->DBT.Contents); - DBRef ref; - - LOCK(index->lock); - if (DBREF_IN_USE(index)) { - index->Flags |= ErasedMask; - UNLOCK(index->lock); - return; - } - while ((ref = *te++) != NULL) { - LOCK(ref->lock); - /* note that the first element of the conditional generates a - side-effect, and should never be swapped around with the other */ - if ( --(ref->NOfRefsTo) == 0 && (ref->Flags & ErasedMask)) { - if (!DBREF_IN_USE(ref)) { - UNLOCK(ref->lock); - RemoveDBEntry(ref); - } else { - UNLOCK(ref->lock); - } - } else { - UNLOCK(ref->lock); - } - } - UNLOCK(index->lock); - /* can I get rid of this index? */ - FreeDBSpace((char *)index); -} - - - static yamop * find_next_clause(DBRef ref0) { diff --git a/C/heapgc.c b/C/heapgc.c index ea8e3c25a..8b5433129 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -863,7 +863,9 @@ mark_db_fixed(CELL *ptr) { static void init_dbtable(tr_fr_ptr trail_ptr) { - DeadClause *cl = DeadClauses; + StaticClause *sc = DeadStaticClauses; + MegaClause *mc = DeadMegaClauses; + StaticIndex *si = DeadStaticIndices; db_vec0 = db_vec = (ADDR)TR; db_root = RBTreeCreate(); @@ -914,9 +916,17 @@ init_dbtable(tr_fr_ptr trail_ptr) { } } } - while (cl != NULL) { - store_in_dbtable((CODEADDR)cl, (CODEADDR)cl+cl->ClSize, dcl_entry); - cl = cl->NextCl; + while (sc) { + store_in_dbtable((CODEADDR)sc, (CODEADDR)sc+sc->ClSize, dcl_entry); + sc = sc->ClNext; + } + while (si) { + store_in_dbtable((CODEADDR)si, (CODEADDR)si+si->ClSize, dcl_entry); + si = si->SiblingIndex; + } + while (mc) { + store_in_dbtable((CODEADDR)mc, (CODEADDR)mc+mc->ClSize, dcl_entry); + mc = mc->ClNext; } if (db_vec == db_vec0) { /* could not find any entries: probably using LOG UPD semantics */ @@ -2111,6 +2121,65 @@ into_relocation_chain(CELL_PTR current, CELL_PTR next) } +static void +CleanDeadClauses(void) +{ + { + StaticClause **cptr; + StaticClause *cl; + + cptr = &(DeadStaticClauses); + cl = DeadStaticClauses; + while (cl) { + if (!ref_in_use((DBRef)cl)) { + char *ocl = (char *)cl; + cl = cl->ClNext; + *cptr = cl; + Yap_FreeCodeSpace(ocl); + } else { + cptr = &(cl->ClNext); + cl = cl->ClNext; + } + } + } + { + StaticIndex **cptr; + StaticIndex *cl; + + cptr = &(DeadStaticIndices); + cl = DeadStaticIndices; + while (cl) { + if (!ref_in_use((DBRef)cl)) { + char *ocl = (char *)cl; + cl = cl->SiblingIndex; + *cptr = cl; + Yap_FreeCodeSpace(ocl); + } else { + cptr = &(cl->SiblingIndex); + cl = cl->SiblingIndex; + } + } + } + { + MegaClause **cptr; + MegaClause *cl; + + cptr = &(DeadMegaClauses); + cl = DeadMegaClauses; + while (cl) { + if (!ref_in_use((DBRef)cl)) { + char *ocl = (char *)cl; + cl = cl->ClNext; + *cptr = cl; + Yap_FreeCodeSpace(ocl); + } else { + cptr = &(cl->ClNext); + cl = cl->ClNext; + } + } + } +} + /* insert trail cells which point to heap objects into relocation chains */ static void @@ -2380,24 +2449,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR) (unsigned long int)OldHeapUsed); #endif } - { - DeadClause **cptr; - DeadClause *cl; - - cptr = &(DeadClauses); - cl = DeadClauses; - while (cl != NULL) { - if (!ref_in_use((DBRef)cl)) { - char *ocl = (char *)cl; - cl = cl->NextCl; - *cptr = cl; - Yap_FreeCodeSpace(ocl); - } else { - cptr = &(cl->NextCl); - cl = cl->NextCl; - } - } - } + CleanDeadClauses(); } diff --git a/C/index.c b/C/index.c index e9cd5c144..b4446e65b 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-03-21 21:30:54 $,$Author: vsc $ * +* Last rev: $Date: 2006-03-22 20:07:28 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.158 2006/03/21 21:30:54 vsc +* avoid looking around when expanding for statics too. +* * Revision 1.157 2006/03/21 19:20:34 vsc * fix fix on index expansion * @@ -4883,7 +4886,7 @@ index_jmp(ClausePointer cur, ClausePointer parent, yamop *ipc, int is_lu, yamop cur.lui = ncur; return cur; } else { - StaticIndex *scur = cur.si, *ncur, *ncur0; + StaticIndex *scur = cur.si; /* check myself */ if (ipc >= scur->ClCode && ipc <= (yamop *)((CODEADDR)scur+scur->ClSize)) return cur; diff --git a/C/init.c b/C/init.c index 9ea432d2a..c764fe069 100644 --- a/C/init.c +++ b/C/init.c @@ -947,7 +947,9 @@ InitCodes(void) INIT_LOCK(Yap_heap_regs->free_blocks_lock); INIT_LOCK(Yap_heap_regs->heap_used_lock); INIT_LOCK(Yap_heap_regs->heap_top_lock); - INIT_LOCK(Yap_heap_regs->dead_clauses_lock); + INIT_LOCK(Yap_heap_regs->dead_static_clauses_lock); + INIT_LOCK(Yap_heap_regs->dead_mega_clauses_lock); + INIT_LOCK(Yap_heap_regs->dead_static_indices_lock); Yap_heap_regs->heap_top_owner = -1; { int i; @@ -1179,7 +1181,9 @@ InitCodes(void) Yap_heap_regs->size_of_overflow = 0; /* make sure no one else can use these two atoms */ CurrentModule = 0; - Yap_heap_regs->dead_clauses = NULL; + Yap_heap_regs->dead_static_clauses = NULL; + Yap_heap_regs->dead_mega_clauses = NULL; + Yap_heap_regs->dead_static_indices = NULL; Yap_ReleaseAtom(AtomOfTerm(Yap_heap_regs->term_refound_var)); /* make sure we have undefp defined */ /* predicates can only be defined after this point */ diff --git a/H/Heap.h b/H/Heap.h index ad3935267..7a2927c5a 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.92 2006-03-06 14:04:56 vsc Exp $ * +* version: $Id: Heap.h,v 1.93 2006-03-22 20:07:28 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -295,7 +295,9 @@ typedef struct various_codes { #if defined(YAPOR) || defined(THREADS) lockvar heap_used_lock; /* protect HeapUsed */ lockvar heap_top_lock; /* protect HeapTop */ - lockvar dead_clauses_lock; /* protect DeadClauses */ + lockvar dead_static_clauses_lock; /* protect DeadStaticClauses */ + lockvar dead_mega_clauses_lock; /* protect DeadMegaClauses */ + lockvar dead_static_indices_lock; /* protect DeadStaticIndices */ int heap_top_owner; #ifdef LOW_LEVEL_TRACER lockvar low_level_trace_lock; @@ -305,7 +307,9 @@ typedef struct various_codes { Term module_name[MaxModules]; struct pred_entry *module_pred[MaxModules]; SMALLUNSGN no_of_modules; - struct dead_clause *dead_clauses; + struct static_clause *dead_static_clauses; + struct static_mega_clause *dead_mega_clauses; + struct static_index *dead_static_indices; Atom atom_abol, atom_alarm, @@ -880,7 +884,9 @@ struct various_codes *Yap_heap_regs; #define ForeignCodeMax Yap_heap_regs->foreign_code_max; #define ForeignCodeLoaded Yap_heap_regs->foreign_code_loaded #define ParserErrorStyle Yap_heap_regs->parser_error_style -#define DeadClauses Yap_heap_regs->dead_clauses +#define DeadStaticClauses Yap_heap_regs->dead_static_clauses +#define DeadMegaClauses Yap_heap_regs->dead_mega_clauses +#define DeadStaticIndices Yap_heap_regs->dead_static_indices #define SizeOfOverflow Yap_heap_regs->size_of_overflow #define LastWtimePtr Yap_heap_regs->last_wtime #define BGL Yap_heap_regs->bgl @@ -893,7 +899,9 @@ struct various_codes *Yap_heap_regs; #define NOfThreadsCreated Yap_heap_regs->n_of_threads_created #define ThreadsTotalTime Yap_heap_regs->threads_total_time #define HeapUsedLock Yap_heap_regs->heap_used_lock -#define DeadClausesLock Yap_heap_regs->dead_clauses_lock +#define DeadStaticClausesLock Yap_heap_regs->dead_static_clauses_lock +#define DeadMegaClausesLock Yap_heap_regs->dead_mega_clauses_lock +#define DeadStaticIndicesLock Yap_heap_regs->dead_static_indices_lock #endif #define CreepCode Yap_heap_regs->creep_code #define UndefCode Yap_heap_regs->undef_code diff --git a/H/clause.h b/H/clause.h index df1d90ebf..0ca39caaa 100644 --- a/H/clause.h +++ b/H/clause.h @@ -126,21 +126,11 @@ typedef struct static_mega_clause { UInt ClSize; PredEntry *ClPred; UInt ClItemSize; + struct static_mega_clause *ClNext; /* The instructions, at least one of the form sl */ yamop ClCode[MIN_ARRAY]; } MegaClause; -typedef struct dead_clause { - CELL ClFlags; -#if defined(YAPOR) || defined(THREADS) - /* A lock for manipulating the clause */ - lockvar ClLock; - UInt ref_count; -#endif - UInt ClSize; - struct dead_clause *NextCl; /* dead clause */ -} DeadClause; - typedef union clause_obj { struct logic_upd_clause luc; struct logic_upd_index lui; diff --git a/H/rheap.h b/H/rheap.h index 17dd151ae..86c90def1 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,12 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2006-03-06 14:04:56 $,$Author: vsc $ * +* Last rev: $Date: 2006-03-22 20:07:28 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.63 2006/03/06 14:04:56 vsc +* fixes to garbage collector +* fixes to debugger +* * Revision 1.62 2006/02/24 14:03:42 vsc * fix refs to old LogUpd implementation (pre 5). * @@ -140,6 +144,183 @@ do_clean_susp_clauses(yamop *ipc) { } } +#include "rclause.h" + +/* Restoring the heap */ + +/* adjusts terms stored in the data base, when they have no variables */ +static Term +AdjustDBTerm(Term trm, Term *p_base) +{ + if (IsAtomTerm(trm)) + return AtomTermAdjust(trm); + if (IsPairTerm(trm)) { + Term *p; + + p = PtoHeapCellAdjust(RepPair(trm)); + if (p >= p_base) { + p[0] = AdjustDBTerm(p[0], p); + p[1] = AdjustDBTerm(p[1], p); + } + return AbsPair(p); + } + if (IsApplTerm(trm)) { + Term *p; + Functor f; + Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm)); + /* if it is before the current position, then we are looking + at old code */ + if (p >= p_base) { + f = (Functor)p[0]; + if (!IsExtensionFunctor(f)) { + UInt Arity, i; + + f = FuncAdjust(f); + *p++ = (Term)f; + Arity = ArityOfFunctor(f); + for (i = 0; i < Arity; ++i) { + *p = AdjustDBTerm(*p, p0); + p++; + } + } + } + return AbsAppl(p0); + } + return trm; +} + +static void +RestoreDBTerm(DBTerm *dbr) +{ +#ifdef COROUTINING + if (dbr->attachments) + dbr->attachments = AdjustDBTerm(dbr->attachments, dbr->Contents); +#endif + if (dbr->DBRefs != NULL) { + DBRef *cp; + DBRef tm; + + dbr->DBRefs = DBRefPAdjust(dbr->DBRefs); + cp = dbr->DBRefs; + while ((tm = *--cp) != 0) + *cp = DBRefAdjust(tm); + } + dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents); +} + +/* Restores a prolog clause, in its compiled form */ +static void +RestoreStaticClause(StaticClause *cl) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + if (cl->ClFlags & FactMask) { + cl->usc.ClPred = PtoPredAdjust(cl->usc.ClPred); + } else { + cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource); + } + if (cl->ClNext) { + cl->ClNext = PtoStCAdjust(cl->ClNext); + } + restore_opcodes(cl->ClCode); +} + +/* Restores a prolog clause, in its compiled form */ +static void +RestoreMegaClause(MegaClause *cl) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + cl->ClPred = PtoPredAdjust(cl->ClPred); + if (cl->ClNext) { + cl->ClNext = (MegaClause *)AddrAdjust((ADDR)(cl->ClNext)); + } + restore_opcodes(cl->ClCode); +} + +/* Restores a prolog clause, in its compiled form */ +static void +RestoreDynamicClause(DynamicClause *cl, PredEntry *pp) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + if (cl->ClPrevious != NULL) { + cl->ClPrevious = PtoOpAdjust(cl->ClPrevious); + } + INIT_LOCK(cl->ClLock); + restore_opcodes(cl->ClCode); +} + +/* Restores a prolog clause, in its compiled form */ +static void +RestoreLUClause(LogUpdClause *cl, PredEntry *pp) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + INIT_LOCK(cl->ClLock); + if (cl->ClFlags & LogUpdRuleMask) { + cl->ClExt = PtoOpAdjust(cl->ClExt); + } + if (cl->ClSource) { + cl->ClSource = DBTermAdjust(cl->ClSource); + RestoreDBTerm(cl->ClSource); + } + if (cl->ClPrev) { + cl->ClPrev = PtoLUCAdjust(cl->ClPrev); + } + if (cl->ClNext) { + cl->ClNext = PtoLUCAdjust(cl->ClNext); + } + cl->ClPred = PtoPredAdjust(cl->ClPred); + restore_opcodes(cl->ClCode); +} + +static void +CleanLUIndex(LogUpdIndex *idx) +{ + idx->ClRefCount = 0; + INIT_LOCK(idx->ClLock); + idx->ClPred = PtoPredAdjust(idx->ClPred); + if (idx->ParentIndex) + idx->ParentIndex = LUIndexAdjust(idx->ParentIndex); + if (idx->SiblingIndex) { + idx->SiblingIndex = LUIndexAdjust(idx->SiblingIndex); + CleanLUIndex(idx->SiblingIndex); + } + if (idx->ChildIndex) { + idx->ChildIndex = LUIndexAdjust(idx->ChildIndex); + CleanLUIndex(idx->ChildIndex); + } + if (!(idx->ClFlags & SwitchTableMask)) { + restore_opcodes(idx->ClCode); + } +} + +static void +CleanSIndex(StaticIndex *idx) +{ + idx->ClPred = PtoPredAdjust(idx->ClPred); + if (idx->SiblingIndex) { + idx->SiblingIndex = SIndexAdjust(idx->SiblingIndex); + CleanSIndex(idx->SiblingIndex); + } + if (idx->ChildIndex) { + idx->ChildIndex = SIndexAdjust(idx->ChildIndex); + CleanSIndex(idx->ChildIndex); + } + if (!(idx->ClFlags & SwitchTableMask)) { + restore_opcodes(idx->ClCode); + } +} + /* restore the failcodes */ static void restore_codes(void) @@ -246,17 +427,37 @@ restore_codes(void) Yap_heap_regs->atprompt = AtomAdjust(Yap_heap_regs->atprompt); } - if (Yap_heap_regs->char_conversion_table != NULL) { + if (Yap_heap_regs->char_conversion_table) { Yap_heap_regs->char_conversion_table = (char *) AddrAdjust((ADDR)Yap_heap_regs->char_conversion_table); } - if (Yap_heap_regs->char_conversion_table2 != NULL) { + if (Yap_heap_regs->char_conversion_table2) { Yap_heap_regs->char_conversion_table2 = (char *) AddrAdjust((ADDR)Yap_heap_regs->char_conversion_table2); } - if (Yap_heap_regs->dead_clauses != NULL) { - Yap_heap_regs->dead_clauses = (DeadClause *) - AddrAdjust((ADDR)(Yap_heap_regs->dead_clauses)); + if (Yap_heap_regs->dead_static_clauses) { + StaticClause *sc = PtoStCAdjust(Yap_heap_regs->dead_static_clauses); + Yap_heap_regs->dead_static_clauses = sc; + while (sc) { + RestoreStaticClause(sc); + sc = sc->ClNext; + } + } + if (Yap_heap_regs->dead_mega_clauses) { + MegaClause *mc = (MegaClause *)AddrAdjust((ADDR)(Yap_heap_regs->dead_mega_clauses)); + Yap_heap_regs->dead_mega_clauses = mc; + while (mc) { + RestoreMegaClause(mc); + mc = mc->ClNext; + } + } + if (Yap_heap_regs->dead_static_indices) { + StaticIndex *si = (StaticIndex *)AddrAdjust((ADDR)(Yap_heap_regs->dead_static_indices)); + Yap_heap_regs->dead_static_indices = si; + while (si) { + CleanSIndex(si); + si = si->SiblingIndex; + } } Yap_heap_regs->retry_recorded_k_code = PtoOpAdjust(Yap_heap_regs->retry_recorded_k_code); @@ -533,68 +734,6 @@ restore_codes(void) } -/* Restoring the heap */ - -/* adjusts terms stored in the data base, when they have no variables */ -static Term -AdjustDBTerm(Term trm, Term *p_base) -{ - if (IsAtomTerm(trm)) - return AtomTermAdjust(trm); - if (IsPairTerm(trm)) { - Term *p; - - p = PtoHeapCellAdjust(RepPair(trm)); - if (p >= p_base) { - p[0] = AdjustDBTerm(p[0], p); - p[1] = AdjustDBTerm(p[1], p); - } - return AbsPair(p); - } - if (IsApplTerm(trm)) { - Term *p; - Functor f; - Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm)); - /* if it is before the current position, then we are looking - at old code */ - if (p >= p_base) { - f = (Functor)p[0]; - if (!IsExtensionFunctor(f)) { - UInt Arity, i; - - f = FuncAdjust(f); - *p++ = (Term)f; - Arity = ArityOfFunctor(f); - for (i = 0; i < Arity; ++i) { - *p = AdjustDBTerm(*p, p0); - p++; - } - } - } - return AbsAppl(p0); - } - return trm; -} - -static void -RestoreDBTerm(DBTerm *dbr) -{ -#ifdef COROUTINING - if (dbr->attachments) - dbr->attachments = AdjustDBTerm(dbr->attachments, dbr->Contents); -#endif - if (dbr->DBRefs != NULL) { - DBRef *cp; - DBRef tm; - - dbr->DBRefs = DBRefPAdjust(dbr->DBRefs); - cp = dbr->DBRefs; - while ((tm = *--cp) != 0) - *cp = DBRefAdjust(tm); - } - dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents); -} - static void RestoreDBEntry(DBRef dbr) { @@ -658,80 +797,6 @@ RestoreDB(DBEntry *pp) } } -#include "rclause.h" - -/* Restores a prolog clause, in its compiled form */ -static void -RestoreStaticClause(StaticClause *cl, PredEntry *pp) -/* - * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not - */ -{ - if (cl->ClFlags & FactMask) { - cl->usc.ClPred = PtoPredAdjust(cl->usc.ClPred); - } else { - cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource); - } - if (cl->ClNext) { - cl->ClNext = PtoStCAdjust(cl->ClNext); - } - restore_opcodes(cl->ClCode); -} - -/* Restores a prolog clause, in its compiled form */ -static void -RestoreMegaClause(MegaClause *cl, PredEntry *pp) -/* - * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not - */ -{ - cl->ClPred = PtoPredAdjust(cl->ClPred); - restore_opcodes(cl->ClCode); -} - -/* Restores a prolog clause, in its compiled form */ -static void -RestoreDynamicClause(DynamicClause *cl, PredEntry *pp) -/* - * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not - */ -{ - if (cl->ClPrevious != NULL) { - cl->ClPrevious = PtoOpAdjust(cl->ClPrevious); - } - INIT_LOCK(cl->ClLock); - restore_opcodes(cl->ClCode); -} - -/* Restores a prolog clause, in its compiled form */ -static void -RestoreLUClause(LogUpdClause *cl, PredEntry *pp) -/* - * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not - */ -{ - INIT_LOCK(cl->ClLock); - if (cl->ClFlags & LogUpdRuleMask) { - cl->ClExt = PtoOpAdjust(cl->ClExt); - } - if (cl->ClSource) { - cl->ClSource = DBTermAdjust(cl->ClSource); - RestoreDBTerm(cl->ClSource); - } - if (cl->ClPrev) { - cl->ClPrev = PtoLUCAdjust(cl->ClPrev); - } - if (cl->ClNext) { - cl->ClNext = PtoLUCAdjust(cl->ClNext); - } - cl->ClPred = PtoPredAdjust(cl->ClPred); - restore_opcodes(cl->ClCode); -} - /* * Restores a group of clauses for the same predicate, starting with First * and ending with Last, First may be equal to Last @@ -749,7 +814,7 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp) } else if (pp->PredFlags & MegaClausePredFlag) { MegaClause *cl = ClauseCodeToMegaClause(First); - RestoreMegaClause(cl, pp); + RestoreMegaClause(cl); } else if (pp->PredFlags & DynamicPredFlag) { yamop *cl = First; @@ -762,7 +827,7 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp) StaticClause *cl = ClauseCodeToStaticClause(First); do { - RestoreStaticClause(cl, pp); + RestoreStaticClause(cl); if (cl->ClCode == Last) return; cl = cl->ClNext; } while (TRUE); @@ -770,44 +835,6 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp) } -static void -CleanLUIndex(LogUpdIndex *idx) -{ - idx->ClRefCount = 0; - INIT_LOCK(idx->ClLock); - idx->ClPred = PtoPredAdjust(idx->ClPred); - if (idx->ParentIndex) - idx->ParentIndex = LUIndexAdjust(idx->ParentIndex); - if (idx->SiblingIndex) { - idx->SiblingIndex = LUIndexAdjust(idx->SiblingIndex); - CleanLUIndex(idx->SiblingIndex); - } - if (idx->ChildIndex) { - idx->ChildIndex = LUIndexAdjust(idx->ChildIndex); - CleanLUIndex(idx->ChildIndex); - } - if (!(idx->ClFlags & SwitchTableMask)) { - restore_opcodes(idx->ClCode); - } -} - -static void -CleanSIndex(StaticIndex *idx) -{ - idx->ClPred = PtoPredAdjust(idx->ClPred); - if (idx->SiblingIndex) { - idx->SiblingIndex = SIndexAdjust(idx->SiblingIndex); - CleanSIndex(idx->SiblingIndex); - } - if (idx->ChildIndex) { - idx->ChildIndex = SIndexAdjust(idx->ChildIndex); - CleanSIndex(idx->ChildIndex); - } - if (!(idx->ClFlags & SwitchTableMask)) { - restore_opcodes(idx->ClCode); - } -} - /* Restores a DB structure, as it was saved in the heap */ static void diff --git a/changes-5.1.html b/changes-5.1.html index 546983da0..e414c1f2c 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,8 +16,13 @@

Yap-5.1.0: