This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/agc.c
vsc a7f550d667 New comment-based message style
Fix thread support (at least don't deadlock with oneself)
small fixes for coroutining predicates
force Yap to recover space in arrays of dbrefs
use private predicates in debugger.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1084 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2004-06-23 17:24:20 +00:00

420 lines
8.6 KiB
C

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: agc.c *
* Last rev: *
* mods: *
* comments: reclaim unused atoms and functors *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
#endif
#include "absmi.h"
#include "alloc.h"
#include "yapio.h"
#ifdef DEBUG
/* #define DEBUG_RESTORE2 1 */
#define errout Yap_stderr
#endif
STATIC_PROTO(void RestoreEntries, (PropEntry *));
STATIC_PROTO(void CleanCode, (PredEntry *));
static int agc_calls;
static unsigned long int agc_collected;
static Int tot_agc_time = 0; /* total time spent in GC */
static Int tot_agc_recovered = 0; /* number of heap objects in all garbage collections */
#define AtomMarkedBit 1
static inline void
MarkAtomEntry(AtomEntry *ae)
{
CELL c = (CELL)(ae->NextOfAE);
c |= AtomMarkedBit;
ae->NextOfAE = (Atom)c;
}
static inline int
AtomResetMark(AtomEntry *ae)
{
CELL c = (CELL)(ae->NextOfAE);
if (c & AtomMarkedBit) {
c &= ~AtomMarkedBit;
ae->NextOfAE = (Atom)c;
return (TRUE);
}
return (FALSE);
}
static inline Atom
CleanAtomMarkedBit(Atom a)
{
CELL c = (CELL)a;
c &= ~AtomMarkedBit;
return((Atom)c);
}
static inline Functor
FuncAdjust(Functor f)
{
AtomEntry *ae = RepAtom(NameOfFunctor(f));
MarkAtomEntry(ae);
return(f);
}
static inline Term
AtomTermAdjust(Term t)
{
AtomEntry *ae = RepAtom(AtomOfTerm(t));
MarkAtomEntry(ae);
return(t);
}
static inline Atom
AtomAdjust(Atom a)
{
AtomEntry *ae;
if (a == NIL) return(a);
ae = RepAtom(a);
MarkAtomEntry(ae);
return(a);
}
#define HDiff TRUE
#define OldHeapTop HeapTop
#define IsOldCode(P) FALSE
#define IsOldCodeCellPtr(P) FALSE
#define IsOldDelay(P) FALSE
#define IsOldDelayPtr(P) FALSE
#define IsOldLocalInTR(P) FALSE
#define IsOldLocalInTRPtr(P) FALSE
#define IsOldGlobal(P) FALSE
#define IsOldGlobalPtr(P) FALSE
#define IsOldTrail(P) FALSE
#define IsOldTrailPtr(P) FALSE
#define CharP(X) ((char *)(X))
#define AddrAdjust(P) (P)
#define AtomEntryAdjust(P) (P)
#define BlobTermAdjust(P) (P)
#define CellPtoHeapAdjust(P) (P)
#define CellPtoHeapCellAdjust(P) (P)
#define CellPtoTRAdjust(P) (P)
#define CodeAddrAdjust(P) (P)
#define ConsultObjAdjust(P) (P)
#define DelayAddrAdjust(P) (P)
#define DBRefAdjust(P) (P)
#define DBRefPAdjust(P) (P)
#define DBTermAdjust(P) (P)
#define LUIndexAdjust(P) (P)
#define SIndexAdjust(P) (P)
#define LocalAddrAdjust(P) (P)
#define GlobalAddrAdjust(P) (P)
#define PtoLUCAdjust(P) (P)
#define PtoStCAdjust(P) (P)
#define PtoArrayEAdjust(P) (P)
#define PtoDelayAdjust(P) (P)
#define PtoGloAdjust(P) (P)
#define PtoLocAdjust(P) (P)
#define PtoHeapCellAdjust(P) (P)
#define PtoOpAdjust(P) (P)
#define PtoPredAdjust(P) (P)
#define PropAdjust(P) (P)
#define TrailAddrAdjust(P) (P)
#define XAdjust(P) (P)
#define YAdjust(P) (P)
static void
recompute_mask(DBRef dbr)
{
return;
}
static void
rehash(CELL *oldcode, int NOfE, int KindOfEntries)
{
}
#include "rheap.h"
/*
* This is the really tough part, to restore the whole of the heap
*/
static void
mark_atoms(void)
{
AtomHashEntry *HashPtr = HashChain;
register int i;
Atom atm;
AtomEntry *at;
restore_codes();
for (i = 0; i < AtomHashTableSize; ++i) {
atm = HashPtr->Entry;
if (atm) {
at = RepAtom(atm);
do {
#ifdef DEBUG_RESTORE2 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif
RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE;
at = RepAtom(CleanAtomMarkedBit(atm));
} while (!EndOfPAEntr(at));
}
HashPtr++;
}
atm = INVISIBLECHAIN.Entry;
at = RepAtom(atm);
if (EndOfPAEntr(at)) {
return;
}
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;
at = RepAtom(CleanAtomMarkedBit(atm));
} while (!EndOfPAEntr(at));
}
static void
mark_trail(void)
{
register CELL *pt;
pt = (CELL *)TR;
/* moving the trail is simple */
while (pt != (CELL *)Yap_TrailBase) {
register CELL reg = pt[-1];
pt--;
if (!IsVarTerm(reg)) {
if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
}
}
}
}
static void
mark_local(void)
{
register CELL *pt;
/* Adjusting the local */
pt = LCL0;
/* moving the trail is simple */
while (pt > ASP) {
CELL reg = *--pt;
if (!IsVarTerm(reg)) {
if (IsAtomTerm(reg)) {
MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
}
}
}
}
static void
mark_global(void)
{
register CELL *pt;
/*
* to clean the global now that functors are just variables pointing to
* the code
*/
pt = CellPtr(Yap_GlobalBase);
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++;
}
}
static void
mark_stacks(void)
{
mark_trail();
mark_local();
mark_global();
}
/*
* This is the really tough part, to restore the whole of the heap
*/
static void
clean_atoms(void)
{
AtomHashEntry *HashPtr = HashChain;
register int i;
Atom atm;
Atom *patm;
AtomEntry *at;
for (i = 0; i < AtomHashTableSize; ++i) {
atm = HashPtr->Entry;
patm = &(HashPtr->Entry);
while (atm != NIL) {
at = RepAtom(CleanAtomMarkedBit(atm));
if (AtomResetMark(at) || (AGCHook != NULL && !AGCHook(atm))) {
patm = &(at->NextOfAE);
atm = at->NextOfAE;
NOfAtoms--;
} else {
#ifdef DEBUG_RESTORE2
fprintf(stderr, "Purged %s\n", at->StrOfAE);
#endif
*patm = at->NextOfAE;
atm = at->NextOfAE;
agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE);
Yap_FreeCodeSpace((char *)at);
}
}
HashPtr++;
}
patm = &(INVISIBLECHAIN.Entry);
atm = INVISIBLECHAIN.Entry;
while (atm != NIL) {
at = RepAtom(CleanAtomMarkedBit(atm));
if (AtomResetMark(at) || (AGCHook != NULL && !AGCHook(atm))) {
patm = &(atm->NextOfAE);
NOfAtoms--;
atm = at->NextOfAE;
} else {
#ifdef DEBUG_RESTORE2
fprintf(stderr, "Purged %s\n", at->StrOfAE);
#endif
*patm = at->NextOfAE;
atm = at->NextOfAE;
agc_collected += sizeof(AtomEntry) + strlen(at->StrOfAE);
Yap_FreeCodeSpace((char *)at);
}
}
}
static void
atom_gc(void)
{
int gc_verbose = Yap_is_gc_verbose();
int gc_trace = 0;
UInt time_start, agc_time;
if (Yap_GetValue(AtomGcTrace) != TermNil)
gc_trace = 1;
agc_calls++;
agc_collected = 0;
if (gc_trace) {
fprintf(Yap_stderr, "%% agc:\n");
} else if (gc_verbose) {
fprintf(Yap_stderr, "%% Start of atom garbage collection %d:\n", agc_calls);
}
time_start = Yap_cputime();
/* get the number of active registers */
YAPEnterCriticalSection();
mark_stacks();
mark_atoms();
clean_atoms();
YAPLeaveCriticalSection();
agc_time = Yap_cputime()-time_start;
tot_agc_time += agc_time;
tot_agc_recovered += agc_collected;
if (gc_verbose) {
fprintf(Yap_stderr, "%% Collected %ld bytes.\n", agc_collected);
fprintf(Yap_stderr, "%% GC %d took %g sec, total of %g sec doing GC so far.\n", agc_calls, (double)agc_time/1000, (double)tot_agc_time/1000);
}
}
void
Yap_atom_gc(void)
{
atom_gc();
}
static Int
p_atom_gc(void)
{
#ifndef FIXED_STACKS
atom_gc();
#endif /* FIXED_STACKS */
return(TRUE);
}
static Int
p_inform_agc(void)
{
Term tn = MkIntegerTerm(tot_agc_time);
Term tt = MkIntegerTerm(agc_calls);
Term ts = MkIntegerTerm(tot_agc_recovered);
return(Yap_unify(tn, ARG2) && Yap_unify(tt, ARG1) && Yap_unify(ts, ARG3));
}
void
Yap_init_agc(void)
{
Yap_InitCPred("$atom_gc", 0, p_atom_gc, 0);
Yap_InitCPred("$inform_agc", 3, p_inform_agc, 0);
}