Don't try to mess with sequences that don't end with a trust.

A fix for the atom garbage collector actually ignore floats ;-).


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1297 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-05-27 21:44:00 +00:00
parent c1480cfd91
commit 6dbf25e54c
2 changed files with 60 additions and 45 deletions

89
C/agc.c
View File

@ -22,6 +22,7 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
#include "absmi.h"
#include "alloc.h"
#include "yapio.h"
#include "attvar.h"
#ifdef DEBUG
/* #define DEBUG_RESTORE2 1 */
@ -188,9 +189,6 @@ mark_atoms(void)
do {
#ifdef DEBUG_RESTORE2 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE);
if (strcmp(at->StrOfAE,"$module_expansion") == 0) {
printf("oops\n");
}
#endif
RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE;
@ -235,55 +233,60 @@ mark_local(void)
}
}
static CELL *
mark_global_cell(CELL *pt)
{
CELL reg = *pt;
if (IsVarTerm(reg)) {
/* skip bitmaps */
switch(reg) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
return pt + 4;
#else
return pt + 3;
#endif
#if USE_GMP
case (CELL)FunctorBigInt:
{
Int sz = 1+
sizeof(MP_INT)+
(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
return pt + sz+1;
}
#endif
case (CELL)FunctorLongInt:
return pt += 3;
break;
}
} else if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
return pt+1;
}
return pt+1;
}
static void
mark_global(void)
{
register CELL *pt;
CELL *pt;
/*
* to clean the global now that functors are just variables pointing to
* the code
*/
pt = CellPtr(Yap_GlobalBase);
#if COROUTINING
CELL *ptf = (CELL *)DelayTop();
pt = (CELL *)Yap_GlobalBase;
while (pt < ptf) {
pt = mark_global_cell(pt);
}
#endif
pt = H0;
while (pt < H) {
register CELL reg;
reg = *pt;
if (IsVarTerm(reg)) {
pt++;
continue;
} else if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
} else if (IsApplTerm(reg)) {
Functor f = FunctorOfTerm(reg);
if (f <= FunctorDouble && f >= FunctorLongInt) {
/* skip bitmaps */
switch((CELL)f) {
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
pt += 3;
#else
pt += 2;
#endif
break;
#if USE_GMP
case (CELL)FunctorBigInt:
{
Int sz = 1+
sizeof(MP_INT)+
(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t));
pt += sz;
}
break;
#endif
case (CELL)FunctorLongInt:
default:
pt += 2;
break;
}
}
}
pt++;
pt = mark_global_cell(pt);
}
}

View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-05-25 18:58:37 $,$Author: vsc $ *
* Last rev: $Date: 2005-05-27 21:44:00 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.126 2005/05/25 18:58:37 vsc
* fix another bug in nth_instance, thanks to Pat Caldon
*
* Revision 1.125 2005/04/28 14:50:45 vsc
* clause should always deref before testing type
*
@ -6104,6 +6107,11 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
}
}
static int is_trust(OPCODE opc) {
op_numbers op = Yap_op_from_opcode(opc);
return op == _trust;
}
static yamop *
insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
{
@ -6117,7 +6125,10 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
begin = NEXTOP(begin, xll);
op = Yap_op_from_opcode(begin->opc);
}
if (op != _enter_lu_pred && op != _stale_lu_index) {
/* block should start with an enter_lu_pred and end with a trust,
otherwise I just don't understand what is going on */
if ((op != _enter_lu_pred && op != _stale_lu_index) ||
! is_trust(begin->u.xll.l2->opc)) {
if (blk->ClFlags & SwitchRootMask) {
Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
} else {
@ -6166,6 +6177,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
if (ap->ArityOfPE >= 2 &&
ap->ArityOfPE <= 4) {
yamop *cl = last->u.ld.d;
nlast->opc = Yap_opcode(_retry2+(ap->ArityOfPE-2));
nlast->u.l.l = cl;
where = NEXTOP(nlast,l);