take better care of zombies
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1574 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
01a088bd54
commit
3241452d64
93
C/cdmgr.c
93
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)
|
||||
|
||||
33
C/dbase.c
33
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)
|
||||
{
|
||||
|
||||
96
C/heapgc.c
96
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();
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
8
C/init.c
8
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 */
|
||||
|
||||
18
H/Heap.h
18
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
|
||||
|
||||
12
H/clause.h
12
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;
|
||||
|
||||
391
H/rheap.h
391
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
|
||||
|
||||
@ -16,8 +16,13 @@
|
||||
|
||||
<h2>Yap-5.1.0:</h2>
|
||||
<ul>
|
||||
<li> FIXED: use different chains for dead static clauses, static
|
||||
indices and dead mega clauses. Extend dead clauses with next field so that
|
||||
they can added into chain. Fix restore to see dead clauses.</li>
|
||||
<li> FIXED: check if indexing code is live before purging it (obs
|
||||
Bernd Gutmann).</li>
|
||||
<li> FIXED: pass backtrackable C-preds all flags they ask for (obs
|
||||
Tiago SOares).</li>
|
||||
Tiago Soares).</li>
|
||||
<li> FIXED: compilation with dynamic libraries and JPL compilation.</li>
|
||||
<li> FIXED: typo in manual (obs Bernd Gutmann).</li>
|
||||
<li> NEW: track the current block more aggressively, to avoid
|
||||
|
||||
Reference in New Issue
Block a user