/************************************************************************* * * * 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 "Foreign.h" #include "alloc.h" #include "yapio.h" #include "iopreds.h" #include "attvar.h" #ifdef DEBUG /* #define DEBUG_RESTORE1 1 */ /* #define DEBUG_RESTORE2 1 */ /* #define DEBUG_RESTORE3 1 */ #define errout GLOBAL_stderr #endif STATIC_PROTO(void RestoreEntries, (PropEntry *, int USES_REGS)); STATIC_PROTO(void CleanCode, (PredEntry * USES_REGS)); #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) { if (!IsExtensionFunctor(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 Term TermToGlobalOrAtomAdjust(Term t) { if (t && IsAtomTerm(t)) return AtomTermAdjust(t); return(t); } static inline Atom AtomAdjust(Atom a) { AtomEntry *ae; if (a == NIL) return(a); ae = RepAtom(a); MarkAtomEntry(ae); return(a); } #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 REINIT_LOCK(P) #define REINIT_RWLOCK(P) #define BlobTypeAdjust(P) (P) #define NoAGCAtomAdjust(P) (P) #define OrArgAdjust(P) #define TabEntryAdjust(P) #define IntegerAdjust(D) (D) #define AddrAdjust(P) (P) #define MFileAdjust(P) (P) #define CodeVarAdjust(P) (P) #define ConstantAdjust(P) (P) #define ArityAdjust(P) (P) #define DoubleInCodeAdjust(P) #define IntegerInCodeAdjust(P) #define OpcodeAdjust(P) (P) #define ModuleAdjust(P) (P) #define ExternalFunctionAdjust(P) (P) #define DBRecordAdjust(P) (P) #define PredEntryAdjust(P) (P) #define ModEntryPtrAdjust(P) (P) #define AtomEntryAdjust(P) (P) #define GlobalEntryAdjust(P) (P) #define BlobTermInCodeAdjust(P) (P) #define CellPtoHeapAdjust(P) (P) #define PtoAtomHashEntryAdjust(P) (P) #define CellPtoHeapCellAdjust(P) (P) #define CellPtoTRAdjust(P) (P) #define CodeAddrAdjust(P) (P) #define ConsultObjAdjust(P) (P) #define DelayAddrAdjust(P) (P) #define DelayAdjust(P) (P) #define GlobalAdjust(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 OpListAdjust(P) (P) #define PtoLUCAdjust(P) (P) #define PtoStCAdjust(P) (P) #define PtoArrayEAdjust(P) (P) #define PtoArraySAdjust(P) (P) #define PtoGlobalEAdjust(P) (P) #define PtoDelayAdjust(P) (P) #define PtoGloAdjust(P) (P) #define PtoLocAdjust(P) (P) #define PtoHeapCellAdjust(P) (P) #define TermToGlobalAdjust(P) (P) #define PtoOpAdjust(P) (P) #define PtoLUClauseAdjust(P) (P) #define PtoLUIndexAdjust(P) (P) #define PtoDBTLAdjust(P) (P) #define PtoPredAdjust(P) (P) #define PtoPtoPredAdjust(P) (P) #define OpRTableAdjust(P) (P) #define OpEntryAdjust(P) (P) #define PropAdjust(P) (P) #define TrailAddrAdjust(P) (P) #define XAdjust(P) (P) #define YAdjust(P) (P) #define HoldEntryAdjust(P) (P) #define CodeCharPAdjust(P) (P) #define CodeVoidPAdjust(P) (P) #define HaltHookAdjust(P) (P) #define recompute_mask(dbr) #define rehash(oldcode, NOfE, KindOfEntries) #define RestoreSWIHash() #include "rheap.h" static void RestoreHashPreds( USES_REGS1 ) { UInt i; for (i = 0; i < PredHashTableSize; i++) { PredEntry *p = PredHash[i]; if (p) p = PredEntryAdjust(p); while (p) { Prop nextp; if (p->NextOfPE) p->NextOfPE = PropAdjust(p->NextOfPE); nextp = p->NextOfPE; CleanCode(p PASS_REGS); p = RepPredProp(nextp); } } } static void init_reg_copies(USES_REGS1) { LOCAL_OldASP = ASP; LOCAL_OldLCL0 = LCL0; LOCAL_OldTR = TR; LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase; LOCAL_OldH = H; LOCAL_OldH0 = H0; LOCAL_OldTrailBase = LOCAL_TrailBase; LOCAL_OldTrailTop = LOCAL_TrailTop; LOCAL_OldHeapBase = Yap_HeapBase; LOCAL_OldHeapTop = HeapTop; } static void RestoreAtomList(Atom atm USES_REGS) { AtomEntry *at; at = RepAtom(atm); if (EndOfPAEntr(at)) return; do { RestoreAtom(atm PASS_REGS); atm = CleanAtomMarkedBit(at->NextOfAE); at = RepAtom(atm); } while (!EndOfPAEntr(at)); } static void mark_trail(USES_REGS1) { register tr_fr_ptr pt; pt = TR; /* moving the trail is simple */ while (pt != (tr_fr_ptr)LOCAL_TrailBase) { CELL reg = TrailTerm(pt-1); if (!IsVarTerm(reg)) { if (IsAtomTerm(reg)) { MarkAtomEntry(RepAtom(AtomOfTerm(reg))); } } pt--; } } static void mark_registers(USES_REGS1) { CELL *pt; pt = XREGS; /* moving the trail is simple */ while (pt != XREGS+MaxTemps) { CELL reg = *pt++; if (!IsVarTerm(reg)) { if (IsAtomTerm(reg)) { MarkAtomEntry(RepAtom(AtomOfTerm(reg))); } } } } static void mark_local(USES_REGS1) { CELL *pt; /* Adjusting the local */ pt = LCL0; /* moving the trail is simple */ while (pt > ASP) { CELL reg = *--pt; if (!IsVarTerm(reg)) { if (IsAtomTerm(reg) #ifdef TABLING /* assume we cannot have atoms on first page, so this must be an arity */ && reg > Yap_page_size #endif ) { MarkAtomEntry(RepAtom(AtomOfTerm(reg))); } } } } 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 case (CELL)FunctorBigInt: { Int sz = 3 + (sizeof(MP_INT)+ (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL); return pt + sz; } 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(USES_REGS1) { CELL *pt; /* * to clean the global now that functors are just variables pointing to * the code */ pt = H0; while (pt < H) { pt = mark_global_cell(pt); } } static void mark_stacks(USES_REGS1) { mark_registers(PASS_REGS1); mark_trail(PASS_REGS1); mark_local(PASS_REGS1); mark_global(PASS_REGS1); } static void clean_atom_list(AtomHashEntry *HashPtr) { Atom atm = HashPtr->Entry; Atom *patm = &(HashPtr->Entry); while (atm != NIL) { AtomEntry *at = RepAtom(atm); if (AtomResetMark(at) || at->PropsOfAE != NIL || (GLOBAL_AGCHook != NULL && !GLOBAL_AGCHook(atm))) { patm = &(at->NextOfAE); atm = at->NextOfAE; } else { NOfAtoms--; if (IsWideAtom(atm)) { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%S\n", at, at->WStrOfAE); #endif GLOBAL_agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE); } else { #ifdef DEBUG_RESTORE3 fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE); #endif GLOBAL_agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE); } *patm = atm = at->NextOfAE; Yap_FreeCodeSpace((char *)at); } } } /* * This is the really tough part, to restore the whole of the heap */ static void clean_atoms(void) { AtomHashEntry *HashPtr = HashChain; register int i; AtomResetMark(AtomFoundVar); AtomResetMark(AtomFreeTerm); for (i = 0; i < AtomHashTableSize; ++i) { clean_atom_list(HashPtr); HashPtr++; } HashPtr = WideHashChain; for (i = 0; i < WideAtomHashTableSize; ++i) { clean_atom_list(HashPtr); HashPtr++; } clean_atom_list(&INVISIBLECHAIN); { AtomHashEntry list; list.Entry = SWI_Blobs; clean_atom_list(&list); } } static void atom_gc(USES_REGS1) { int gc_verbose = Yap_is_gc_verbose(); int gc_trace = 0; UInt time_start, agc_time; #if defined(YAPOR) || defined(THREADS) return; #endif if (Yap_GetValue(AtomGcTrace) != TermNil) gc_trace = 1; GLOBAL_agc_calls++; GLOBAL_agc_collected = 0; if (gc_trace) { fprintf(GLOBAL_stderr, "%% agc:\n"); } else if (gc_verbose) { fprintf(GLOBAL_stderr, "%% Start of atom garbage collection %d:\n", GLOBAL_agc_calls); } time_start = Yap_cputime(); /* get the number of active registers */ YAPEnterCriticalSection(); init_reg_copies(PASS_REGS1); mark_stacks(PASS_REGS1); restore_codes(); clean_atoms(); YAPLeaveCriticalSection(); agc_time = Yap_cputime()-time_start; GLOBAL_tot_agc_time += agc_time; GLOBAL_tot_agc_recovered += GLOBAL_agc_collected; if (gc_verbose) { #ifdef _WIN32 fprintf(GLOBAL_stderr, "%% Collected %I64d bytes.\n", GLOBAL_agc_collected); #else fprintf(GLOBAL_stderr, "%% Collected %lld bytes.\n", GLOBAL_agc_collected); #endif fprintf(GLOBAL_stderr, "%% GC %d took %g sec, total of %g sec doing GC so far.\n", GLOBAL_agc_calls, (double)agc_time/1000, (double)GLOBAL_tot_agc_time/1000); } } void Yap_atom_gc(USES_REGS1) { atom_gc(PASS_REGS1); } static Int p_atom_gc(USES_REGS1) { #ifndef FIXED_STACKS atom_gc(PASS_REGS1); #endif /* FIXED_STACKS */ return TRUE; } static Int p_inform_agc(USES_REGS1) { Term tn = MkIntegerTerm(GLOBAL_tot_agc_time); Term tt = MkIntegerTerm(GLOBAL_agc_calls); Term ts = MkIntegerTerm(GLOBAL_tot_agc_recovered); return Yap_unify(tn, ARG2) && Yap_unify(tt, ARG1) && Yap_unify(ts, ARG3); } static Int p_agc_threshold(USES_REGS1) { Term t = Deref(ARG1); if (IsVarTerm(t)) { return Yap_unify(ARG1, MkIntegerTerm(GLOBAL_AGcThreshold)); } else if (!IsIntegerTerm(t)) { Yap_Error(TYPE_ERROR_INTEGER,t,"prolog_flag/2 agc_margin"); return FALSE; } else { Int i = IntegerOfTerm(t); if (i<0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t,"prolog_flag/2 agc_margin"); return FALSE; } else { GLOBAL_AGcThreshold = i; return TRUE; } } } void Yap_init_agc(void) { Yap_InitCPred("$atom_gc", 0, p_atom_gc, HiddenPredFlag); Yap_InitCPred("$inform_agc", 3, p_inform_agc, HiddenPredFlag); Yap_InitCPred("$agc_threshold", 1, p_agc_threshold, HiddenPredFlag|SafePredFlag); }