garbage collection fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1139 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
921e576877
commit
3d308525e0
@ -186,7 +186,11 @@ Yap_MkBigIntTerm(MP_INT *big)
|
|||||||
ret[0] = (CELL)FunctorBigInt;
|
ret[0] = (CELL)FunctorBigInt;
|
||||||
memmove((void *)new, (const void *)(big->_mp_d), nlimbs*CellSize);
|
memmove((void *)new, (const void *)(big->_mp_d), nlimbs*CellSize);
|
||||||
H = (CELL *)(new+nlimbs);
|
H = (CELL *)(new+nlimbs);
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
H[0] = (H-ret)*sizeof(CELL)+EndSpecials;
|
||||||
|
#else
|
||||||
H[0] = ((H-ret)*sizeof(CELL)+EndSpecials)|MBIT;
|
H[0] = ((H-ret)*sizeof(CELL)+EndSpecials)|MBIT;
|
||||||
|
#endif
|
||||||
H++;
|
H++;
|
||||||
pre_alloc_base = NULL;
|
pre_alloc_base = NULL;
|
||||||
return(AbsAppl(ret));
|
return(AbsAppl(ret));
|
||||||
|
22
C/dbase.c
22
C/dbase.c
@ -585,7 +585,11 @@ copy_long_int(CELL *st, CELL *pt)
|
|||||||
/* first thing, store a link to the list before we move on */
|
/* first thing, store a link to the list before we move on */
|
||||||
st[0] = (CELL)FunctorLongInt;
|
st[0] = (CELL)FunctorLongInt;
|
||||||
st[1] = pt[1];
|
st[1] = pt[1];
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
st[2] = 2*sizeof(CELL)+EndSpecials;
|
||||||
|
#else
|
||||||
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
|
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
|
||||||
|
#endif
|
||||||
/* now reserve space */
|
/* now reserve space */
|
||||||
return st+3;
|
return st+3;
|
||||||
}
|
}
|
||||||
@ -598,9 +602,17 @@ copy_double(CELL *st, CELL *pt)
|
|||||||
st[1] = pt[1];
|
st[1] = pt[1];
|
||||||
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
|
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
|
||||||
st[2] = pt[2];
|
st[2] = pt[2];
|
||||||
st[3] = ((3*sizeof(CELL)+EndSpecials)|MBIT);
|
#if GC_NO_TAGS
|
||||||
|
st[3] = 3*sizeof(CELL)+EndSpecials;
|
||||||
#else
|
#else
|
||||||
|
st[3] = ((3*sizeof(CELL)+EndSpecials)|MBIT);
|
||||||
|
#endif /* GC_NO_TAGS */
|
||||||
|
#else
|
||||||
|
#if GC_NO_TAGS
|
||||||
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
|
st[2] = ((2*sizeof(CELL)+EndSpecials)|MBIT);
|
||||||
|
#else
|
||||||
|
st[2] = 2*sizeof(CELL)+EndSpecials;
|
||||||
|
#endif /* GC_NO_TAGS */
|
||||||
#endif
|
#endif
|
||||||
/* now reserve space */
|
/* now reserve space */
|
||||||
return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT);
|
return st+(2+SIZEOF_DOUBLE/SIZEOF_LONG_INT);
|
||||||
@ -620,7 +632,11 @@ copy_big_int(CELL *st, CELL *pt)
|
|||||||
memcpy((void *)(st+1), (void *)(pt+1), sz);
|
memcpy((void *)(st+1), (void *)(pt+1), sz);
|
||||||
st = st+1+sz/CellSize;
|
st = st+1+sz/CellSize;
|
||||||
/* then the tail for gc */
|
/* then the tail for gc */
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
st[0] = sz+CellSize+EndSpecials;
|
||||||
|
#else
|
||||||
st[0] = (sz+CellSize+EndSpecials)|MBIT;
|
st[0] = (sz+CellSize+EndSpecials)|MBIT;
|
||||||
|
#endif
|
||||||
return st+1;
|
return st+1;
|
||||||
}
|
}
|
||||||
#endif /* BIG_INT */
|
#endif /* BIG_INT */
|
||||||
@ -2483,14 +2499,14 @@ GetDBTerm(DBTerm *DBSP)
|
|||||||
return t;
|
return t;
|
||||||
}
|
}
|
||||||
pt = CellPtr(DBSP->Contents);
|
pt = CellPtr(DBSP->Contents);
|
||||||
if (H+NOf > ASP-CalculateStackGap()) {
|
if (H+NOf > ASP-CalculateStackGap()/sizeof(CELL)) {
|
||||||
if (Yap_PrologMode & InErrorMode) {
|
if (Yap_PrologMode & InErrorMode) {
|
||||||
if (H+NOf > ASP)
|
if (H+NOf > ASP)
|
||||||
fprintf(Yap_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n");
|
fprintf(Yap_stderr, "\n\n [ FATAL ERROR: No Stack for Error Handling ]\n");
|
||||||
Yap_exit( 1);
|
Yap_exit( 1);
|
||||||
} else {
|
} else {
|
||||||
Yap_Error_Size = NOf*sizeof(CELL);
|
Yap_Error_Size = NOf*sizeof(CELL);
|
||||||
return((Term)0);
|
return (Term)0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
HeapPtr = cpcells(HOld, pt, NOf);
|
HeapPtr = cpcells(HOld, pt, NOf);
|
||||||
|
438
C/heapgc.c
438
C/heapgc.c
@ -83,6 +83,10 @@ STATIC_PROTO(int is_gc_very_verbose, (void));
|
|||||||
|
|
||||||
#include "heapgc.h"
|
#include "heapgc.h"
|
||||||
|
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
char *bp;
|
||||||
|
#endif
|
||||||
|
|
||||||
static int discard_trail_entries = 0;
|
static int discard_trail_entries = 0;
|
||||||
|
|
||||||
/* support for hybrid garbage collection scheme */
|
/* support for hybrid garbage collection scheme */
|
||||||
@ -449,7 +453,7 @@ count_cells_marked(void)
|
|||||||
int found_marked = 0;
|
int found_marked = 0;
|
||||||
|
|
||||||
for (current = H - 1; current >= H0; current--) {
|
for (current = H - 1; current >= H0; current--) {
|
||||||
if (MARKED(*current)) {
|
if (MARKED_PTR(current)) {
|
||||||
found_marked++;
|
found_marked++;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -477,85 +481,333 @@ typedef struct db_entry {
|
|||||||
struct db_entry *right;
|
struct db_entry *right;
|
||||||
} *dbentry;
|
} *dbentry;
|
||||||
|
|
||||||
static dbentry db_vec, db_vec0;
|
static ADDR db_vec, db_vec0;
|
||||||
|
|
||||||
|
typedef struct RB_red_blk_node {
|
||||||
|
CODEADDR key;
|
||||||
|
CODEADDR lim;
|
||||||
|
db_entry_type db_type;
|
||||||
|
int red; /* if red=0 then the node is black */
|
||||||
|
struct RB_red_blk_node* left;
|
||||||
|
struct RB_red_blk_node* right;
|
||||||
|
struct RB_red_blk_node* parent;
|
||||||
|
} rb_red_blk_node;
|
||||||
|
|
||||||
|
static rb_red_blk_node *db_root, *db_nil;
|
||||||
|
|
||||||
|
static rb_red_blk_node *
|
||||||
|
RBMalloc(UInt size)
|
||||||
|
{
|
||||||
|
ADDR new = db_vec;
|
||||||
|
|
||||||
|
db_vec += size;
|
||||||
|
if ((ADDR)db_vec > Yap_TrailTop-1024) {
|
||||||
|
Yap_growtrail(64 * 1024L);
|
||||||
|
#if USE_SYSTEM_MALLOC
|
||||||
|
jump;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
return (rb_red_blk_node *)new;
|
||||||
|
}
|
||||||
|
|
||||||
|
static rb_red_blk_node *
|
||||||
|
RBTreeCreate(void) {
|
||||||
|
rb_red_blk_node* temp;
|
||||||
|
|
||||||
|
/* see the comment in the rb_red_blk_tree structure in red_black_tree.h */
|
||||||
|
/* for information on nil and root */
|
||||||
|
temp=db_nil= RBMalloc(sizeof(rb_red_blk_node));
|
||||||
|
temp->parent=temp->left=temp->right=temp;
|
||||||
|
temp->red=0;
|
||||||
|
temp->key=NULL;
|
||||||
|
temp = RBMalloc(sizeof(rb_red_blk_node));
|
||||||
|
temp->parent=temp->left=temp->right=db_nil;
|
||||||
|
temp->key=NULL;
|
||||||
|
temp->red=0;
|
||||||
|
return temp;
|
||||||
|
}
|
||||||
|
|
||||||
|
/***********************************************************************/
|
||||||
|
/* FUNCTION: LeftRotate */
|
||||||
|
/**/
|
||||||
|
/* INPUTS: This takes a tree so that it can access the appropriate */
|
||||||
|
/* root and nil pointers, and the node to rotate on. */
|
||||||
|
/**/
|
||||||
|
/* OUTPUT: None */
|
||||||
|
/**/
|
||||||
|
/* Modifies Input: tree, x */
|
||||||
|
/**/
|
||||||
|
/* EFFECTS: Rotates as described in _Introduction_To_Algorithms by */
|
||||||
|
/* Cormen, Leiserson, Rivest (Chapter 14). Basically this */
|
||||||
|
/* makes the parent of x be to the left of x, x the parent of */
|
||||||
|
/* its parent before the rotation and fixes other pointers */
|
||||||
|
/* accordingly. */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
static void
|
||||||
|
LeftRotate(rb_red_blk_node* x) {
|
||||||
|
rb_red_blk_node* y;
|
||||||
|
rb_red_blk_node* nil=db_nil;
|
||||||
|
|
||||||
|
/* I originally wrote this function to use the sentinel for */
|
||||||
|
/* nil to avoid checking for nil. However this introduces a */
|
||||||
|
/* very subtle bug because sometimes this function modifies */
|
||||||
|
/* the parent pointer of nil. This can be a problem if a */
|
||||||
|
/* function which calls LeftRotate also uses the nil sentinel */
|
||||||
|
/* and expects the nil sentinel's parent pointer to be unchanged */
|
||||||
|
/* after calling this function. For example, when RBDeleteFixUP */
|
||||||
|
/* calls LeftRotate it expects the parent pointer of nil to be */
|
||||||
|
/* unchanged. */
|
||||||
|
|
||||||
|
y=x->right;
|
||||||
|
x->right=y->left;
|
||||||
|
|
||||||
|
if (y->left != nil) y->left->parent=x; /* used to use sentinel here */
|
||||||
|
/* and do an unconditional assignment instead of testing for nil */
|
||||||
|
|
||||||
|
y->parent=x->parent;
|
||||||
|
|
||||||
|
/* instead of checking if x->parent is the root as in the book, we */
|
||||||
|
/* count on the root sentinel to implicitly take care of this case */
|
||||||
|
if( x == x->parent->left) {
|
||||||
|
x->parent->left=y;
|
||||||
|
} else {
|
||||||
|
x->parent->right=y;
|
||||||
|
}
|
||||||
|
y->left=x;
|
||||||
|
x->parent=y;
|
||||||
|
|
||||||
|
#ifdef DEBUG_ASSERT
|
||||||
|
Assert(!db_nil->red,"nil not red in LeftRotate");
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/***********************************************************************/
|
||||||
|
/* FUNCTION: RighttRotate */
|
||||||
|
/**/
|
||||||
|
/* INPUTS: This takes a tree so that it can access the appropriate */
|
||||||
|
/* root and nil pointers, and the node to rotate on. */
|
||||||
|
/**/
|
||||||
|
/* OUTPUT: None */
|
||||||
|
/**/
|
||||||
|
/* Modifies Input?: tree, y */
|
||||||
|
/**/
|
||||||
|
/* EFFECTS: Rotates as described in _Introduction_To_Algorithms by */
|
||||||
|
/* Cormen, Leiserson, Rivest (Chapter 14). Basically this */
|
||||||
|
/* makes the parent of x be to the left of x, x the parent of */
|
||||||
|
/* its parent before the rotation and fixes other pointers */
|
||||||
|
/* accordingly. */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
static void
|
||||||
|
RightRotate(rb_red_blk_node* y) {
|
||||||
|
rb_red_blk_node* x;
|
||||||
|
rb_red_blk_node* nil=db_nil;
|
||||||
|
|
||||||
|
/* I originally wrote this function to use the sentinel for */
|
||||||
|
/* nil to avoid checking for nil. However this introduces a */
|
||||||
|
/* very subtle bug because sometimes this function modifies */
|
||||||
|
/* the parent pointer of nil. This can be a problem if a */
|
||||||
|
/* function which calls LeftRotate also uses the nil sentinel */
|
||||||
|
/* and expects the nil sentinel's parent pointer to be unchanged */
|
||||||
|
/* after calling this function. For example, when RBDeleteFixUP */
|
||||||
|
/* calls LeftRotate it expects the parent pointer of nil to be */
|
||||||
|
/* unchanged. */
|
||||||
|
|
||||||
|
x=y->left;
|
||||||
|
y->left=x->right;
|
||||||
|
|
||||||
|
if (nil != x->right) x->right->parent=y; /*used to use sentinel here */
|
||||||
|
/* and do an unconditional assignment instead of testing for nil */
|
||||||
|
|
||||||
|
/* instead of checking if x->parent is the root as in the book, we */
|
||||||
|
/* count on the root sentinel to implicitly take care of this case */
|
||||||
|
x->parent=y->parent;
|
||||||
|
if( y == y->parent->left) {
|
||||||
|
y->parent->left=x;
|
||||||
|
} else {
|
||||||
|
y->parent->right=x;
|
||||||
|
}
|
||||||
|
x->right=y;
|
||||||
|
y->parent=x;
|
||||||
|
|
||||||
|
#ifdef DEBUG_ASSERT
|
||||||
|
Assert(!db_nil->red,"nil not red in RightRotate");
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
/***********************************************************************/
|
||||||
|
/* FUNCTION: TreeInsertHelp */
|
||||||
|
/**/
|
||||||
|
/* INPUTS: tree is the tree to insert into and z is the node to insert */
|
||||||
|
/**/
|
||||||
|
/* OUTPUT: none */
|
||||||
|
/**/
|
||||||
|
/* Modifies Input: tree, z */
|
||||||
|
/**/
|
||||||
|
/* EFFECTS: Inserts z into the tree as if it were a regular binary tree */
|
||||||
|
/* using the algorithm described in _Introduction_To_Algorithms_ */
|
||||||
|
/* by Cormen et al. This funciton is only intended to be called */
|
||||||
|
/* by the RBTreeInsert function and not by the user */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
static void
|
||||||
|
TreeInsertHelp(rb_red_blk_node* z) {
|
||||||
|
/* This function should only be called by InsertRBTree (see above) */
|
||||||
|
rb_red_blk_node* x;
|
||||||
|
rb_red_blk_node* y;
|
||||||
|
rb_red_blk_node* nil=db_nil;
|
||||||
|
|
||||||
|
z->left=z->right=nil;
|
||||||
|
y=db_root;
|
||||||
|
x=db_root->left;
|
||||||
|
while( x != nil) {
|
||||||
|
y=x;
|
||||||
|
if (x->key > z->key) { /* x.key > z.key */
|
||||||
|
x=x->left;
|
||||||
|
} else { /* x,key <= z.key */
|
||||||
|
x=x->right;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
z->parent=y;
|
||||||
|
if ( (y == db_root) ||
|
||||||
|
(y->key > z->key)) { /* y.key > z.key */
|
||||||
|
y->left=z;
|
||||||
|
} else {
|
||||||
|
y->right=z;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifdef DEBUG_ASSERT
|
||||||
|
Assert(!db_nil->red,"nil not red in TreeInsertHelp");
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Before calling Insert RBTree the node x should have its key set */
|
||||||
|
|
||||||
|
/***********************************************************************/
|
||||||
|
/* FUNCTION: RBTreeInsert */
|
||||||
|
/**/
|
||||||
|
/* INPUTS: tree is the red-black tree to insert a node which has a key */
|
||||||
|
/* pointed to by key and info pointed to by info. */
|
||||||
|
/**/
|
||||||
|
/* OUTPUT: This function returns a pointer to the newly inserted node */
|
||||||
|
/* which is guarunteed to be valid until this node is deleted. */
|
||||||
|
/* What this means is if another data structure stores this */
|
||||||
|
/* pointer then the tree does not need to be searched when this */
|
||||||
|
/* is to be deleted. */
|
||||||
|
/**/
|
||||||
|
/* Modifies Input: tree */
|
||||||
|
/**/
|
||||||
|
/* EFFECTS: Creates a node node which contains the appropriate key and */
|
||||||
|
/* info pointers and inserts it into the tree. */
|
||||||
|
/***********************************************************************/
|
||||||
|
|
||||||
|
static rb_red_blk_node *
|
||||||
|
RBTreeInsert(CODEADDR key, CODEADDR end, db_entry_type db_type) {
|
||||||
|
rb_red_blk_node * y;
|
||||||
|
rb_red_blk_node * x;
|
||||||
|
rb_red_blk_node * newNode;
|
||||||
|
|
||||||
|
x=(rb_red_blk_node*) RBMalloc(sizeof(rb_red_blk_node));
|
||||||
|
x->key=key;
|
||||||
|
x->lim=end;
|
||||||
|
x->db_type=db_type;
|
||||||
|
|
||||||
|
TreeInsertHelp(x);
|
||||||
|
newNode=x;
|
||||||
|
x->red=1;
|
||||||
|
while(x->parent->red) { /* use sentinel instead of checking for root */
|
||||||
|
if (x->parent == x->parent->parent->left) {
|
||||||
|
y=x->parent->parent->right;
|
||||||
|
if (y->red) {
|
||||||
|
x->parent->red=0;
|
||||||
|
y->red=0;
|
||||||
|
x->parent->parent->red=1;
|
||||||
|
x=x->parent->parent;
|
||||||
|
} else {
|
||||||
|
if (x == x->parent->right) {
|
||||||
|
x=x->parent;
|
||||||
|
LeftRotate(x);
|
||||||
|
}
|
||||||
|
x->parent->red=0;
|
||||||
|
x->parent->parent->red=1;
|
||||||
|
RightRotate(x->parent->parent);
|
||||||
|
}
|
||||||
|
} else { /* case for x->parent == x->parent->parent->right */
|
||||||
|
y=x->parent->parent->left;
|
||||||
|
if (y->red) {
|
||||||
|
x->parent->red=0;
|
||||||
|
y->red=0;
|
||||||
|
x->parent->parent->red=1;
|
||||||
|
x=x->parent->parent;
|
||||||
|
} else {
|
||||||
|
if (x == x->parent->left) {
|
||||||
|
x=x->parent;
|
||||||
|
RightRotate(x);
|
||||||
|
}
|
||||||
|
x->parent->red=0;
|
||||||
|
x->parent->parent->red=1;
|
||||||
|
LeftRotate(x->parent->parent);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
db_root->left->red=0;
|
||||||
|
return newNode;
|
||||||
|
|
||||||
|
#ifdef DEBUG_ASSERT
|
||||||
|
Assert(!db_nil->red,"nil not red in RBTreeInsert");
|
||||||
|
Assert(!db_root->red,"root not red in RBTreeInsert");
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/* init the table */
|
/* init the table */
|
||||||
static void
|
static void
|
||||||
store_in_dbtable(CODEADDR entry, CODEADDR end, db_entry_type db_type)
|
store_in_dbtable(CODEADDR entry, CODEADDR end, db_entry_type db_type)
|
||||||
{
|
{
|
||||||
dbentry parent = db_vec0;
|
RBTreeInsert(entry, end, db_type);
|
||||||
dbentry new = db_vec;
|
|
||||||
|
|
||||||
if ((ADDR)new > Yap_TrailTop-1024)
|
|
||||||
Yap_growtrail(64 * 1024L);
|
|
||||||
new->val = entry;
|
|
||||||
new->db_type = db_type;
|
|
||||||
new->lim = end;
|
|
||||||
new->left = new->right = NULL;
|
|
||||||
if (db_vec == db_vec0) {
|
|
||||||
db_vec++;
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
db_vec++;
|
|
||||||
parent = db_vec0;
|
|
||||||
beg:
|
|
||||||
if (entry < parent->val) {
|
|
||||||
if (parent->right == NULL) {
|
|
||||||
parent->right = new;
|
|
||||||
} else {
|
|
||||||
parent = parent->right;
|
|
||||||
goto beg;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
if (parent->left == NULL) {
|
|
||||||
parent->left = new;
|
|
||||||
} else {
|
|
||||||
parent = parent->left;
|
|
||||||
goto beg;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* find an element in the dbentries table */
|
/* find an element in the dbentries table */
|
||||||
static dbentry
|
static rb_red_blk_node *
|
||||||
find_ref_in_dbtable(CODEADDR entry)
|
find_ref_in_dbtable(CODEADDR entry)
|
||||||
{
|
{
|
||||||
dbentry current = db_vec0;
|
rb_red_blk_node *current = db_root->left;
|
||||||
|
|
||||||
while (current != NULL) {
|
while (current != db_nil) {
|
||||||
if (current->val < entry && current->lim > entry) {
|
if (current->key < entry && current->lim > entry) {
|
||||||
return(current);
|
return current;
|
||||||
}
|
}
|
||||||
if (entry < current->val)
|
if (entry < current->key)
|
||||||
current = current->right;
|
current = current->right;
|
||||||
else
|
else
|
||||||
current = current->left;
|
current = current->left;
|
||||||
}
|
}
|
||||||
return(NULL);
|
return current;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
mark_db_fixed(CELL *ptr) {
|
mark_db_fixed(CELL *ptr) {
|
||||||
dbentry el;
|
rb_red_blk_node *el;
|
||||||
|
|
||||||
el = find_ref_in_dbtable((CODEADDR)ptr);
|
el = find_ref_in_dbtable((CODEADDR)ptr);
|
||||||
if (el != NULL) {
|
if (el != db_nil) {
|
||||||
switch (el->db_type) {
|
switch (el->db_type) {
|
||||||
case db_entry:
|
case db_entry:
|
||||||
((DBRef)(el->val))->Flags |= GcFoundMask;
|
((DBRef)(el->key))->Flags |= GcFoundMask;
|
||||||
break;
|
break;
|
||||||
case cl_entry:
|
case cl_entry:
|
||||||
((DynamicClause *)(el->val))->ClFlags |= GcFoundMask;
|
((DynamicClause *)(el->key))->ClFlags |= GcFoundMask;
|
||||||
break;
|
break;
|
||||||
case lcl_entry:
|
case lcl_entry:
|
||||||
((LogUpdClause *)(el->val))->ClFlags |= GcFoundMask;
|
((LogUpdClause *)(el->key))->ClFlags |= GcFoundMask;
|
||||||
break;
|
break;
|
||||||
case li_entry:
|
case li_entry:
|
||||||
((LogUpdIndex *)(el->val))->ClFlags |= GcFoundMask;
|
((LogUpdIndex *)(el->key))->ClFlags |= GcFoundMask;
|
||||||
break;
|
break;
|
||||||
case dcl_entry:
|
case dcl_entry:
|
||||||
((DeadClause *)(el->val))->ClFlags |= GcFoundMask;
|
((DeadClause *)(el->key))->ClFlags |= GcFoundMask;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -565,7 +817,8 @@ static void
|
|||||||
init_dbtable(tr_fr_ptr trail_ptr) {
|
init_dbtable(tr_fr_ptr trail_ptr) {
|
||||||
DeadClause *cl = DeadClauses;
|
DeadClause *cl = DeadClauses;
|
||||||
|
|
||||||
db_vec0 = db_vec = (dbentry)TR;
|
db_vec0 = db_vec = (CODEADDR)TR;
|
||||||
|
db_root = RBTreeCreate();
|
||||||
while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) {
|
while (trail_ptr > (tr_fr_ptr)Yap_TrailBase) {
|
||||||
register CELL trail_cell;
|
register CELL trail_cell;
|
||||||
|
|
||||||
@ -745,7 +998,7 @@ check_global(void) {
|
|||||||
for (current = H - 1; current >= H0; current--) {
|
for (current = H - 1; current >= H0; current--) {
|
||||||
CELL ccurr = *current;
|
CELL ccurr = *current;
|
||||||
|
|
||||||
if (MARKED(ccurr)) {
|
if (MARKED_PTR(current)) {
|
||||||
CELL ccell = UNMARK_CELL(ccurr);
|
CELL ccell = UNMARK_CELL(ccurr);
|
||||||
if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)) {
|
if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)) {
|
||||||
/* oops, we found a blob */
|
/* oops, we found a blob */
|
||||||
@ -755,7 +1008,7 @@ check_global(void) {
|
|||||||
ccurr = *current;
|
ccurr = *current;
|
||||||
/* process the functor next */
|
/* process the functor next */
|
||||||
}
|
}
|
||||||
if (MARKED(ccurr)) {
|
if (MARKED_PTR(current)) {
|
||||||
printf("Oops, found marked cell at %p\n", current);
|
printf("Oops, found marked cell at %p\n", current);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -814,7 +1067,7 @@ mark_variable(CELL_PTR current)
|
|||||||
|
|
||||||
begin:
|
begin:
|
||||||
ccur = *current;
|
ccur = *current;
|
||||||
if (MARKED(ccur)) {
|
if (MARKED_PTR(current)) {
|
||||||
POP_CONTINUATION();
|
POP_CONTINUATION();
|
||||||
}
|
}
|
||||||
MARK(current);
|
MARK(current);
|
||||||
@ -827,7 +1080,8 @@ mark_variable(CELL_PTR current)
|
|||||||
#ifdef EASY_SHUNTING
|
#ifdef EASY_SHUNTING
|
||||||
CELL cnext;
|
CELL cnext;
|
||||||
/* do variable shunting between variables in the global */
|
/* do variable shunting between variables in the global */
|
||||||
if (!MARKED((cnext = *next))) {
|
cnext = *next;
|
||||||
|
if (!MARKED_PTR(next)) {
|
||||||
if (IsVarTerm(cnext) && (CELL)next == cnext) {
|
if (IsVarTerm(cnext) && (CELL)next == cnext) {
|
||||||
/* new global variable to new global variable */
|
/* new global variable to new global variable */
|
||||||
if (current < prev_HB && current >= HB && next >= HB && next < prev_HB) {
|
if (current < prev_HB && current >= HB && next >= HB && next < prev_HB) {
|
||||||
@ -925,7 +1179,7 @@ mark_variable(CELL_PTR current)
|
|||||||
}
|
}
|
||||||
POP_CONTINUATION();
|
POP_CONTINUATION();
|
||||||
}
|
}
|
||||||
if ( MARKED(cnext) || !ONHEAP(next) )
|
if ( MARKED_PTR(next) || !ONHEAP(next) )
|
||||||
POP_CONTINUATION();
|
POP_CONTINUATION();
|
||||||
|
|
||||||
if (next < H0) POP_CONTINUATION();
|
if (next < H0) POP_CONTINUATION();
|
||||||
@ -1138,7 +1392,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
|||||||
currv = 0;
|
currv = 0;
|
||||||
}
|
}
|
||||||
/* we may have already been here */
|
/* we may have already been here */
|
||||||
if (bmap < 0 && !MARKED(*saved_var)) {
|
if (bmap < 0 && !MARKED_PTR(saved_var)) {
|
||||||
#ifdef INSTRUMENT_GC
|
#ifdef INSTRUMENT_GC
|
||||||
Term ccur = *saved_var;
|
Term ccur = *saved_var;
|
||||||
|
|
||||||
@ -1176,7 +1430,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
|||||||
We do it at the end because we don't want to lose any variables
|
We do it at the end because we don't want to lose any variables
|
||||||
that would have been trimmed at the first environment visit.
|
that would have been trimmed at the first environment visit.
|
||||||
*/
|
*/
|
||||||
if (MARKED(gc_ENV[E_CB]))
|
if (MARKED_PTR(gc_ENV+E_CB))
|
||||||
return;
|
return;
|
||||||
MARK(gc_ENV+E_CB);
|
MARK(gc_ENV+E_CB);
|
||||||
|
|
||||||
@ -1233,7 +1487,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
|
|||||||
than its new binding is not accessible and we can reset it. Note
|
than its new binding is not accessible and we can reset it. Note
|
||||||
we must use gc_H to avoid trouble with dangling variables
|
we must use gc_H to avoid trouble with dangling variables
|
||||||
in the heap */
|
in the heap */
|
||||||
if (((hp < gc_H && hp >= H0) || (hp > (CELL *)gc_B && hp < LCL0) ) && !MARKED(*hp)) {
|
if (((hp < gc_H && hp >= H0) || (hp > (CELL *)gc_B && hp < LCL0) ) && !MARKED_PTR(hp)) {
|
||||||
#ifdef EARLY_RESET
|
#ifdef EARLY_RESET
|
||||||
/* reset to be a variable */
|
/* reset to be a variable */
|
||||||
RESET_VARIABLE(hp);
|
RESET_VARIABLE(hp);
|
||||||
@ -1810,7 +2064,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||||||
/* first, whatever we dumped on the trail. Easier just to do
|
/* first, whatever we dumped on the trail. Easier just to do
|
||||||
the registers separately? */
|
the registers separately? */
|
||||||
for (trail_ptr = old_TR; trail_ptr < TR; trail_ptr++) {
|
for (trail_ptr = old_TR; trail_ptr < TR; trail_ptr++) {
|
||||||
if (MARKED(TrailTerm(trail_ptr))) {
|
if (MARKED_PTR(&TrailTerm(trail_ptr))) {
|
||||||
UNMARK(&TrailTerm(trail_ptr));
|
UNMARK(&TrailTerm(trail_ptr));
|
||||||
if (HEAP_PTR(TrailTerm(trail_ptr))) {
|
if (HEAP_PTR(TrailTerm(trail_ptr))) {
|
||||||
into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(TrailTerm(trail_ptr)));
|
into_relocation_chain(&TrailTerm(trail_ptr), GET_NEXT(TrailTerm(trail_ptr)));
|
||||||
@ -1838,14 +2092,14 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||||||
TrailTerm(dest) = trail_cell;
|
TrailTerm(dest) = trail_cell;
|
||||||
if (IsVarTerm(trail_cell)) {
|
if (IsVarTerm(trail_cell)) {
|
||||||
/* we need to check whether this is a honest to god trail entry */
|
/* we need to check whether this is a honest to god trail entry */
|
||||||
if ((CELL *)trail_cell < H && MARKED(*(CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
|
if ((CELL *)trail_cell < H && MARKED_PTR((CELL *)trail_cell) && (CELL *)trail_cell >= H0) {
|
||||||
if (HEAP_PTR(trail_cell)) {
|
if (HEAP_PTR(trail_cell)) {
|
||||||
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
|
into_relocation_chain(&TrailTerm(dest), GET_NEXT(trail_cell));
|
||||||
}
|
}
|
||||||
#ifdef FROZEN_STACKS
|
#ifdef FROZEN_STACKS
|
||||||
/* it is complex to recover cells with frozen segments */
|
/* it is complex to recover cells with frozen segments */
|
||||||
TrailVal(dest) = TrailVal(trail_ptr);
|
TrailVal(dest) = TrailVal(trail_ptr);
|
||||||
if (MARKED(TrailVal(dest))) {
|
if (MARKED_PTR(&TrailVal(dest))) {
|
||||||
UNMARK(&TrailVal(dest));
|
UNMARK(&TrailVal(dest));
|
||||||
if (HEAP_PTR(TrailVal(dest))) {
|
if (HEAP_PTR(TrailVal(dest))) {
|
||||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||||
@ -1863,7 +2117,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||||||
#ifdef FROZEN_STACKS
|
#ifdef FROZEN_STACKS
|
||||||
/* it is complex to recover cells with frozen segments */
|
/* it is complex to recover cells with frozen segments */
|
||||||
TrailVal(dest) = TrailVal(trail_ptr);
|
TrailVal(dest) = TrailVal(trail_ptr);
|
||||||
if (MARKED(TrailVal(dest))) {
|
if (MARKED_PTR(&TrailVal(dest))) {
|
||||||
UNMARK(&TrailVal(dest));
|
UNMARK(&TrailVal(dest));
|
||||||
if (HEAP_PTR(TrailVal(dest))) {
|
if (HEAP_PTR(TrailVal(dest))) {
|
||||||
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
into_relocation_chain(&TrailVal(dest), GET_NEXT(TrailVal(dest)));
|
||||||
@ -1970,14 +2224,14 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||||||
CELL *ptr;
|
CELL *ptr;
|
||||||
CELL old = TrailTerm(trail_ptr+1);
|
CELL old = TrailTerm(trail_ptr+1);
|
||||||
|
|
||||||
if (MARKED(trail_cell))
|
if (MARKED_PTR(&TrailTerm(trail_ptr+2)))
|
||||||
ptr = RepAppl(UNMARK_CELL(trail_cell));
|
ptr = RepAppl(UNMARK_CELL(trail_cell));
|
||||||
else
|
else
|
||||||
ptr = RepAppl(trail_cell);
|
ptr = RepAppl(trail_cell);
|
||||||
|
|
||||||
TrailTerm(dest+1) = old;
|
TrailTerm(dest+1) = old;
|
||||||
TrailTerm(dest+2) = TrailTerm(dest) = trail_cell;
|
TrailTerm(dest+2) = TrailTerm(dest) = trail_cell;
|
||||||
if (MARKED(old)) {
|
if (MARKED_PTR(&TrailTerm(trail_ptr+1))) {
|
||||||
UNMARK(&TrailTerm(dest+1));
|
UNMARK(&TrailTerm(dest+1));
|
||||||
if (HEAP_PTR(old)) {
|
if (HEAP_PTR(old)) {
|
||||||
into_relocation_chain(&TrailTerm(dest+1), GET_NEXT(old));
|
into_relocation_chain(&TrailTerm(dest+1), GET_NEXT(old));
|
||||||
@ -1985,21 +2239,21 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
|
|||||||
}
|
}
|
||||||
#ifdef FROZEN_STACKS
|
#ifdef FROZEN_STACKS
|
||||||
TrailVal(dest+1) = TrailVal(trail_ptr+1);
|
TrailVal(dest+1) = TrailVal(trail_ptr+1);
|
||||||
if (MARKED(TrailVal(dest+1))) {
|
if (MARKED_PTR(&TrailVal(dest+1))) {
|
||||||
UNMARK(&TrailVal(dest+1));
|
UNMARK(&TrailVal(dest+1));
|
||||||
if (HEAP_PTR(TrailVal(dest+1))) {
|
if (HEAP_PTR(TrailVal(dest+1))) {
|
||||||
into_relocation_chain(&TrailVal(dest+1), GET_NEXT(TrailTerm(dest+1)));
|
into_relocation_chain(&TrailVal(dest+1), GET_NEXT(TrailTerm(dest+1)));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
TrailVal(dest+2) = TrailVal(trail_ptr+2);
|
TrailVal(dest+2) = TrailVal(trail_ptr+2);
|
||||||
if (MARKED(TrailVal(dest+2))) {
|
if (MARKED_PTR(&TrailVal(dest+2))) {
|
||||||
UNMARK(&TrailVal(dest+2));
|
UNMARK(&TrailVal(dest+2));
|
||||||
if (HEAP_PTR(TrailVal(dest+2))) {
|
if (HEAP_PTR(TrailVal(dest+2))) {
|
||||||
into_relocation_chain(&TrailVal(dest+2), GET_NEXT(TrailTerm(dest+2)));
|
into_relocation_chain(&TrailVal(dest+2), GET_NEXT(TrailTerm(dest+2)));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
if (MARKED(trail_cell)) {
|
if (MARKED_PTR(&TrailTerm(trail_ptr+2))) {
|
||||||
UNMARK(&TrailTerm(dest));
|
UNMARK(&TrailTerm(dest));
|
||||||
UNMARK(&TrailTerm(dest+2));
|
UNMARK(&TrailTerm(dest+2));
|
||||||
if (HEAP_PTR(trail_cell)) {
|
if (HEAP_PTR(trail_cell)) {
|
||||||
@ -2108,7 +2362,7 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
|||||||
}
|
}
|
||||||
if (bmap < 0) {
|
if (bmap < 0) {
|
||||||
CELL env_cell = *saved_var;
|
CELL env_cell = *saved_var;
|
||||||
if (MARKED(env_cell)) {
|
if (MARKED_PTR(saved_var)) {
|
||||||
UNMARK(saved_var);
|
UNMARK(saved_var);
|
||||||
if (HEAP_PTR(env_cell)) {
|
if (HEAP_PTR(env_cell)) {
|
||||||
into_relocation_chain(saved_var, GET_NEXT(env_cell));
|
into_relocation_chain(saved_var, GET_NEXT(env_cell));
|
||||||
@ -2122,7 +2376,7 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
|
|||||||
/* we use the B field in the environment to tell whether we have
|
/* we use the B field in the environment to tell whether we have
|
||||||
been here before or not
|
been here before or not
|
||||||
*/
|
*/
|
||||||
if (!MARKED(gc_ENV[E_CB]))
|
if (!MARKED_PTR(gc_ENV+E_CB))
|
||||||
return;
|
return;
|
||||||
UNMARK(gc_ENV+E_CB);
|
UNMARK(gc_ENV+E_CB);
|
||||||
|
|
||||||
@ -2140,7 +2394,7 @@ sweep_slots(CELL *ptr)
|
|||||||
ptr++;
|
ptr++;
|
||||||
while (ns > 0) {
|
while (ns > 0) {
|
||||||
CELL cp_cell = *ptr;
|
CELL cp_cell = *ptr;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(ptr)) {
|
||||||
UNMARK(ptr);
|
UNMARK(ptr);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(ptr, GET_NEXT(cp_cell));
|
into_relocation_chain(ptr, GET_NEXT(cp_cell));
|
||||||
@ -2246,7 +2500,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
vars = *answ_fr++;
|
vars = *answ_fr++;
|
||||||
while (vars--) {
|
while (vars--) {
|
||||||
CELL cp_cell = *answ_fr;
|
CELL cp_cell = *answ_fr;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(answ_fr)) {
|
||||||
UNMARK(answ_fr);
|
UNMARK(answ_fr);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(answ_fr, GET_NEXT(cp_cell));
|
into_relocation_chain(answ_fr, GET_NEXT(cp_cell));
|
||||||
@ -2271,7 +2525,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
nargs = *saved_reg++;
|
nargs = *saved_reg++;
|
||||||
while (nargs--) {
|
while (nargs--) {
|
||||||
CELL cp_cell = *saved_reg;
|
CELL cp_cell = *saved_reg;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(saved_reg)) {
|
||||||
UNMARK(saved_reg);
|
UNMARK(saved_reg);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
||||||
@ -2302,7 +2556,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
saved_reg < (CELL *)(gcp+1) + nargs;
|
saved_reg < (CELL *)(gcp+1) + nargs;
|
||||||
saved_reg++) {
|
saved_reg++) {
|
||||||
CELL cp_cell = *saved_reg;
|
CELL cp_cell = *saved_reg;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(saved_reg)) {
|
||||||
UNMARK(saved_reg);
|
UNMARK(saved_reg);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
||||||
@ -2313,7 +2567,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
nargs = *saved_reg++;
|
nargs = *saved_reg++;
|
||||||
while (nargs--) {
|
while (nargs--) {
|
||||||
CELL cp_cell = *saved_reg;
|
CELL cp_cell = *saved_reg;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(saved_reg)) {
|
||||||
UNMARK(saved_reg);
|
UNMARK(saved_reg);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
||||||
@ -2353,7 +2607,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
aux_ptr += heap_arity + subs_arity + vars_arity + 1;
|
aux_ptr += heap_arity + subs_arity + vars_arity + 1;
|
||||||
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) {
|
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) {
|
||||||
CELL cp_cell = *aux_ptr;
|
CELL cp_cell = *aux_ptr;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(aux_ptr)) {
|
||||||
UNMARK(aux_ptr);
|
UNMARK(aux_ptr);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
||||||
@ -2366,7 +2620,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
aux_ptr += 2 + subs_arity + vars_arity;
|
aux_ptr += 2 + subs_arity + vars_arity;
|
||||||
for (i = 0; i < vars_arity; i++) {
|
for (i = 0; i < vars_arity; i++) {
|
||||||
CELL cp_cell = *aux_ptr;
|
CELL cp_cell = *aux_ptr;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(aux_ptr)) {
|
||||||
UNMARK(aux_ptr);
|
UNMARK(aux_ptr);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
||||||
@ -2376,7 +2630,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
}
|
}
|
||||||
for (i = 1; i < subs_arity; i++) {
|
for (i = 1; i < subs_arity; i++) {
|
||||||
CELL cp_cell = *--aux_ptr;
|
CELL cp_cell = *--aux_ptr;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(aux_ptr)) {
|
||||||
UNMARK(aux_ptr);
|
UNMARK(aux_ptr);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
|
||||||
@ -2397,7 +2651,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
saved_reg < &(gc_B->cp_a1)+rtp->u.lds.s+rtp->u.lds.extra;
|
saved_reg < &(gc_B->cp_a1)+rtp->u.lds.s+rtp->u.lds.extra;
|
||||||
saved_reg++) {
|
saved_reg++) {
|
||||||
CELL cp_cell = *saved_reg;
|
CELL cp_cell = *saved_reg;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(saved_reg)) {
|
||||||
UNMARK(saved_reg);
|
UNMARK(saved_reg);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
||||||
@ -2419,7 +2673,7 @@ sweep_choicepoints(choiceptr gc_B)
|
|||||||
saved_reg < &gc_B->cp_a1 + rtp->u.ld.s;
|
saved_reg < &gc_B->cp_a1 + rtp->u.ld.s;
|
||||||
saved_reg++) {
|
saved_reg++) {
|
||||||
CELL cp_cell = *saved_reg;
|
CELL cp_cell = *saved_reg;
|
||||||
if (MARKED(cp_cell)) {
|
if (MARKED_PTR(saved_reg)) {
|
||||||
UNMARK(saved_reg);
|
UNMARK(saved_reg);
|
||||||
if (HEAP_PTR(cp_cell)) {
|
if (HEAP_PTR(cp_cell)) {
|
||||||
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
|
||||||
@ -2545,7 +2799,7 @@ compact_heap(void)
|
|||||||
#endif
|
#endif
|
||||||
dest = (CELL_PTR) H0 + total_marked - 1;
|
dest = (CELL_PTR) H0 + total_marked - 1;
|
||||||
for (current = H - 1; current >= H0; current--) {
|
for (current = H - 1; current >= H0; current--) {
|
||||||
if (MARKED(*current)) {
|
if (MARKED_PTR(current)) {
|
||||||
CELL ccell = UNMARK_CELL(*current);
|
CELL ccell = UNMARK_CELL(*current);
|
||||||
if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)
|
if (ccell < (CELL)AtomBase && ccell > EndSpecials && IsVarTerm(ccell)
|
||||||
) {
|
) {
|
||||||
@ -2554,7 +2808,7 @@ compact_heap(void)
|
|||||||
CELL *ptr = current - nofcells ;
|
CELL *ptr = current - nofcells ;
|
||||||
CELL func = ptr[0];
|
CELL func = ptr[0];
|
||||||
|
|
||||||
if (MARKED(func)) {
|
if (MARKED_PTR(ptr)) {
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
found_marked+=nofcells;
|
found_marked+=nofcells;
|
||||||
#endif /* DEBUG */
|
#endif /* DEBUG */
|
||||||
@ -2626,7 +2880,7 @@ compact_heap(void)
|
|||||||
dest = (CELL_PTR) H0;
|
dest = (CELL_PTR) H0;
|
||||||
for (current = H0; current < H; current++) {
|
for (current = H0; current < H; current++) {
|
||||||
CELL ccur = *current;
|
CELL ccur = *current;
|
||||||
if (MARKED(ccur)) {
|
if (MARKED_PTR(current)) {
|
||||||
CELL uccur = UNMARK_CELL(ccur);
|
CELL uccur = UNMARK_CELL(ccur);
|
||||||
if (uccur < (CELL)AtomBase && uccur > EndSpecials && IsVarTerm(uccur)) {
|
if (uccur < (CELL)AtomBase && uccur > EndSpecials && IsVarTerm(uccur)) {
|
||||||
/* oops, we found a blob */
|
/* oops, we found a blob */
|
||||||
@ -2928,7 +3182,7 @@ sweep_delays(CELL *max)
|
|||||||
{
|
{
|
||||||
CELL *ptr = (CELL *)Yap_GlobalBase;
|
CELL *ptr = (CELL *)Yap_GlobalBase;
|
||||||
while (ptr < max) {
|
while (ptr < max) {
|
||||||
if (MARKED(*ptr)) {
|
if (MARKED_PTR(ptr)) {
|
||||||
UNMARK(ptr);
|
UNMARK(ptr);
|
||||||
if (HEAP_PTR(*ptr)) {
|
if (HEAP_PTR(*ptr)) {
|
||||||
into_relocation_chain(ptr, GET_NEXT(*ptr));
|
into_relocation_chain(ptr, GET_NEXT(*ptr));
|
||||||
@ -3074,6 +3328,19 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
|||||||
total_smarked = 0;
|
total_smarked = 0;
|
||||||
#endif
|
#endif
|
||||||
discard_trail_entries = 0;
|
discard_trail_entries = 0;
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
{
|
||||||
|
UInt alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase;
|
||||||
|
bp = Yap_PreAllocCodeSpace();
|
||||||
|
if (bp+alloc_sz > (char *)AuxSp) {
|
||||||
|
/* not enough space */
|
||||||
|
bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz);
|
||||||
|
}
|
||||||
|
if (!bp)
|
||||||
|
return 0;
|
||||||
|
bzero((void *)bp, alloc_sz);
|
||||||
|
}
|
||||||
|
#endif /* GC_NO_TAGS */
|
||||||
#ifdef HYBRID_SCHEME
|
#ifdef HYBRID_SCHEME
|
||||||
iptop = (CELL_PTR *)H;
|
iptop = (CELL_PTR *)H;
|
||||||
#endif
|
#endif
|
||||||
@ -3084,9 +3351,12 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
|
|||||||
marking_phase(old_TR, current_env, nextop, max);
|
marking_phase(old_TR, current_env, nextop, max);
|
||||||
m_time = Yap_cputime();
|
m_time = Yap_cputime();
|
||||||
gc_time = m_time-time_start;
|
gc_time = m_time-time_start;
|
||||||
if (heap_cells)
|
if (heap_cells) {
|
||||||
effectiveness = ((heap_cells-total_marked)*100)/heap_cells;
|
if (heap_cells > 1000000)
|
||||||
else
|
effectiveness = (heap_cells-total_marked)/(heap_cells/100);
|
||||||
|
else
|
||||||
|
effectiveness = 100*(heap_cells-total_marked)/heap_cells;
|
||||||
|
} else
|
||||||
effectiveness = 0;
|
effectiveness = 0;
|
||||||
if (gc_verbose) {
|
if (gc_verbose) {
|
||||||
fprintf(Yap_stderr, "%% Mark: Recovered %ld cells of %ld (%ld%%) in %g sec\n",
|
fprintf(Yap_stderr, "%% Mark: Recovered %ld cells of %ld (%ld%%) in %g sec\n",
|
||||||
|
7
H/Regs.h
7
H/Regs.h
@ -10,7 +10,7 @@
|
|||||||
* File: Regs.h *
|
* File: Regs.h *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: YAP abstract machine registers *
|
* comments: YAP abstract machine registers *
|
||||||
* version: $Id: Regs.h,v 1.29 2004-06-05 03:37:00 vsc Exp $ *
|
* version: $Id: Regs.h,v 1.30 2004-09-16 17:29:08 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
|
|
||||||
@ -722,6 +722,7 @@ static inline UInt
|
|||||||
CalculateStackGap(void)
|
CalculateStackGap(void)
|
||||||
{
|
{
|
||||||
UInt gmin = (LCL0-H0)>>3;
|
UInt gmin = (LCL0-H0)>>3;
|
||||||
UInt min_gap = MinStackGap;
|
|
||||||
return(gmin < min_gap ? min_gap : gmin );
|
if (gmin < MinStackGap) gmin = MinStackGap;
|
||||||
|
return gmin;
|
||||||
}
|
}
|
||||||
|
62
H/heapgc.h
62
H/heapgc.h
@ -37,7 +37,9 @@
|
|||||||
)
|
)
|
||||||
#else
|
#else
|
||||||
#ifdef TAG_LOW_BITS_32
|
#ifdef TAG_LOW_BITS_32
|
||||||
#if INVERT_RBIT
|
#if GC_NO_TAGS
|
||||||
|
#define GET_NEXT(val) ((CELL *) ((val) & ~LowTagBits))
|
||||||
|
#elif INVERT_RBIT
|
||||||
#define GET_NEXT(val) ((CELL *) (((val) & ~(LowTagBits|MBIT))|RBIT))
|
#define GET_NEXT(val) ((CELL *) (((val) & ~(LowTagBits|MBIT))|RBIT))
|
||||||
#else
|
#else
|
||||||
#define GET_NEXT(val) ((CELL *) ((val) & ~(LowTagBits|MBIT|RBIT)))
|
#define GET_NEXT(val) ((CELL *) ((val) & ~(LowTagBits|MBIT|RBIT)))
|
||||||
@ -80,6 +82,55 @@
|
|||||||
(CellPtr(B) < CellPtr(val) && CellPtr(val) <= \
|
(CellPtr(B) < CellPtr(val) && CellPtr(val) <= \
|
||||||
LCL0 && HEAP_PTR(val))))
|
LCL0 && HEAP_PTR(val))))
|
||||||
|
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
|
||||||
|
extern char *bp;
|
||||||
|
|
||||||
|
#define MARK_BIT 1
|
||||||
|
#define RMARK_BIT 2
|
||||||
|
|
||||||
|
#define mcell(X) bp[X-(CELL *)Yap_GlobalBase]
|
||||||
|
|
||||||
|
static inline int
|
||||||
|
MARKED_PTR(CELL* ptr)
|
||||||
|
{
|
||||||
|
return mcell(ptr) & MARK_BIT;
|
||||||
|
}
|
||||||
|
|
||||||
|
static inline void
|
||||||
|
MARK(CELL* ptr)
|
||||||
|
{
|
||||||
|
mcell(ptr) = mcell(ptr) | MARK_BIT;
|
||||||
|
}
|
||||||
|
|
||||||
|
static inline void
|
||||||
|
UNMARK(CELL* ptr)
|
||||||
|
{
|
||||||
|
mcell(ptr) = mcell(ptr) & ~MARK_BIT;
|
||||||
|
}
|
||||||
|
|
||||||
|
#define UNMARK_CELL(X) (X)
|
||||||
|
|
||||||
|
static inline void
|
||||||
|
RMARK(CELL* ptr)
|
||||||
|
{
|
||||||
|
mcell(ptr) = mcell(ptr) | RMARK_BIT;
|
||||||
|
}
|
||||||
|
|
||||||
|
static inline void
|
||||||
|
UNRMARK(CELL* ptr)
|
||||||
|
{
|
||||||
|
mcell(ptr) = mcell(ptr) & ~RMARK_BIT;
|
||||||
|
}
|
||||||
|
|
||||||
|
static inline int
|
||||||
|
RMARKED(CELL* ptr)
|
||||||
|
{
|
||||||
|
return !GCIsPrimitiveTerm(*ptr) && (mcell(ptr) & RMARK_BIT);
|
||||||
|
}
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
/* is the object pointed to by ptr marked? */
|
/* is the object pointed to by ptr marked? */
|
||||||
#ifdef TAGS_FAST_OPS
|
#ifdef TAGS_FAST_OPS
|
||||||
#define MARKED_VAR(val) ((val) & MBIT)
|
#define MARKED_VAR(val) ((val) & MBIT)
|
||||||
@ -103,7 +154,10 @@
|
|||||||
|
|
||||||
#define UNMARK_CELL(val) ((val) ^ MBIT) /* unmark the object pointed to by ptr */
|
#define UNMARK_CELL(val) ((val) ^ MBIT) /* unmark the object pointed to by ptr */
|
||||||
|
|
||||||
|
#define MARKED_PTR(ptr) MARKED(*(ptr))
|
||||||
|
|
||||||
#ifdef TAGS_FAST_OPS
|
#ifdef TAGS_FAST_OPS
|
||||||
|
|
||||||
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && (IsVarTerm(val) ?\
|
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && (IsVarTerm(val) ?\
|
||||||
((val) & RBIT) : !((val) & RBIT)))
|
((val) & RBIT) : !((val) & RBIT)))
|
||||||
|
|
||||||
@ -114,13 +168,17 @@
|
|||||||
? \
|
? \
|
||||||
((val) & ~MBIT) : ((val) | MBIT))
|
((val) & ~MBIT) : ((val) | MBIT))
|
||||||
#else
|
#else
|
||||||
|
|
||||||
#if INVERT_RBIT
|
#if INVERT_RBIT
|
||||||
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && !((val) & RBIT))
|
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && !((val) & RBIT))
|
||||||
#else
|
#else
|
||||||
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && ((val) & RBIT))
|
#define RMARKED(val) (!GCIsPrimitiveTerm(val) && ((val) & RBIT))
|
||||||
#endif
|
#endif
|
||||||
#endif
|
|
||||||
|
|
||||||
|
#endif /* GC_NO_TAGS */
|
||||||
|
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
/* is the object pointed to by ptr marked as in a relocation chain? */
|
/* is the object pointed to by ptr marked as in a relocation chain? */
|
||||||
|
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
* File: TermExt.h *
|
* File: TermExt.h *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Extensions to standard terms for YAP *
|
* comments: Extensions to standard terms for YAP *
|
||||||
* version: $Id: TermExt.h.m4,v 1.14 2004-06-05 03:37:00 vsc Exp $ *
|
* version: $Id: TermExt.h.m4,v 1.15 2004-09-16 17:29:08 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
#ifdef USE_SYSTEM_MALLOC
|
#ifdef USE_SYSTEM_MALLOC
|
||||||
@ -110,7 +110,11 @@ typedef struct special_functors_struct
|
|||||||
special_functors;
|
special_functors;
|
||||||
|
|
||||||
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
|
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
Inline(MkFloatTerm, Term, Float, dbl, (H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=(2*sizeof(CELL)+EndSpecials),H+=3,AbsAppl(H-3)))
|
||||||
|
#else
|
||||||
Inline(MkFloatTerm, Term, Float, dbl, (H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)))
|
Inline(MkFloatTerm, Term, Float, dbl, (H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)))
|
||||||
|
#endif
|
||||||
|
|
||||||
Destructor(Term, FloatOf, Float, t, *(Float *)(RepAppl(t)+1))
|
Destructor(Term, FloatOf, Float, t, *(Float *)(RepAppl(t)+1))
|
||||||
|
|
||||||
@ -146,7 +150,11 @@ CpFloatUnaligned(CELL *ptr)
|
|||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
Inline(MkFloatTerm, Term, Float, dbl, (AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=(3*sizeof(CELL)+EndSpecials), H+=4, AbsAppl(H-4)))
|
||||||
|
#else
|
||||||
Inline(MkFloatTerm, Term, Float, dbl, (AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=((3*sizeof(CELL)+EndSpecials)|MBIT), H+=4, AbsAppl(H-4)))
|
Inline(MkFloatTerm, Term, Float, dbl, (AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=((3*sizeof(CELL)+EndSpecials)|MBIT), H+=4, AbsAppl(H-4)))
|
||||||
|
#endif
|
||||||
|
|
||||||
Destructor(Term, FloatOf, Float, t, (DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t))))
|
Destructor(Term, FloatOf, Float, t, (DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t))))
|
||||||
/* no alignment problems for 64 bit machines */
|
/* no alignment problems for 64 bit machines */
|
||||||
@ -160,7 +168,11 @@ Inline(IsFloatTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == FunctorDo
|
|||||||
|
|
||||||
|
|
||||||
/* extern Functor FunctorLongInt; */
|
/* extern Functor FunctorLongInt; */
|
||||||
|
#if GC_NO_TAGS
|
||||||
|
Inline(MkLongIntTerm, Term, Int, i, (H[0] = (CELL)FunctorLongInt,H[1] = (CELL)(i),H[2]=(2*sizeof(CELL)+EndSpecials),H+=3,AbsAppl(H-3)))
|
||||||
|
#else
|
||||||
Inline(MkLongIntTerm, Term, Int, i, (H[0] = (CELL)FunctorLongInt,H[1] = (CELL)(i),H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)))
|
Inline(MkLongIntTerm, Term, Int, i, (H[0] = (CELL)FunctorLongInt,H[1] = (CELL)(i),H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)))
|
||||||
|
#endif
|
||||||
Destructor(Term, LongIntOf, Int, t, RepAppl(t)[1])
|
Destructor(Term, LongIntOf, Int, t, RepAppl(t)[1])
|
||||||
Inline(IsLongIntTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt)
|
Inline(IsLongIntTerm, int, Term, t, IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt)
|
||||||
|
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
* File: Yap.h.m4 *
|
* File: Yap.h.m4 *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: main header file for YAP *
|
* comments: main header file for YAP *
|
||||||
* version: $Id: Yap.h.m4,v 1.63 2004-08-11 16:14:55 vsc Exp $ *
|
* version: $Id: Yap.h.m4,v 1.64 2004-09-16 17:29:08 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
#include "config.h"
|
#include "config.h"
|
||||||
@ -668,21 +668,27 @@ and RefOfTerm(t) : Term -> DBRef = ...
|
|||||||
#endif /* !LONG_ADDRESSES */
|
#endif /* !LONG_ADDRESSES */
|
||||||
|
|
||||||
#ifdef TAG_LOW_BITS_32
|
#ifdef TAG_LOW_BITS_32
|
||||||
|
|
||||||
|
#if !GC_NO_TAGS
|
||||||
#define MBIT 0x80000000
|
#define MBIT 0x80000000
|
||||||
#define RBIT 0x40000000
|
#define RBIT 0x40000000
|
||||||
|
|
||||||
#if IN_SECOND_QUADRANT
|
#if IN_SECOND_QUADRANT
|
||||||
#define INVERT_RBIT 1 /* RBIT is 1 by default */
|
#define INVERT_RBIT 1 /* RBIT is 1 by default */
|
||||||
#endif
|
#endif
|
||||||
|
#endif !GC_NO_TAGS
|
||||||
|
|
||||||
#else
|
#else
|
||||||
|
|
||||||
|
#if !GC_NO_TAGS
|
||||||
#if defined(SBA) && defined(__linux__)
|
#if defined(SBA) && defined(__linux__)
|
||||||
#define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */
|
#define MBIT /* 0x20000000 */ MKTAG(0x1,0) /* mark bit */
|
||||||
#else
|
#else
|
||||||
#define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */
|
#define RBIT /* 0x20000000 */ MKTAG(0x1,0) /* relocation chain bit */
|
||||||
#define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */
|
#define MBIT /* 0x40000000 */ MKTAG(0x2,0) /* mark bit */
|
||||||
#endif
|
#endif
|
||||||
|
#endif !GC_NO_TAGS
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#define TermSize sizeof(Term)
|
#define TermSize sizeof(Term)
|
||||||
|
Reference in New Issue
Block a user