YAP 7.1.0
agc.c
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: agc.c *
12* Last rev: *
13* mods: *
14* comments: reclaim unused atoms and functors *
15* *
16*************************************************************************/
17#ifdef SCCS
18static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
19#endif
20
21#include "absmi.h"
22#include "Foreign.h"
23#include "alloc.h"
24#include "yapio.h"
25#include "iopreds.h"
26#include "attvar.h"
27
28#ifdef DEBUG
29/* #define DEBUG_RESTORE1 1 */
30/* #define DEBUG_RESTORE2 1 */
31/* #define DEBUG_RESTORE3 1 */
32#define errout GLOBAL_stderr
33#endif
34
35static void RestoreEntries(PropEntry *, int USES_REGS);
36static void CleanCode(PredEntry * USES_REGS);
37static void RestoreDBTerm(DBTerm *dbr, bool src, int attachments USES_REGS);
38
39#define AtomMarkedBit 1
40
41static inline void
42MarkAtomEntry(AtomEntry *ae)
43{
44 CELL c = (CELL)(ae->NextOfAE);
45 c |= AtomMarkedBit;
46 ae->NextOfAE = (Atom)c;
47}
48
49static inline int
50AtomResetMark(AtomEntry *ae)
51{
52 CELL c = (CELL)(ae->NextOfAE);
53 if (c & AtomMarkedBit) {
54 c &= ~AtomMarkedBit;
55 ae->NextOfAE = (Atom)c;
56 return TRUE;
57 }
58 return FALSE;
59}
60
61static inline Atom
62CleanAtomMarkedBit(Atom a)
63{
64 CELL c = (CELL)a;
65 c &= ~AtomMarkedBit;
66 return (Atom)c;
67}
68
69
70static inline Functor
71FuncAdjust(Functor f)
72{
73 if (!IsExtensionFunctor(f)) {
74 AtomEntry *ae = RepAtom(NameOfFunctor(f));
75 MarkAtomEntry(ae);
76 }
77 return(f);
78}
79
80
81static inline Term
82AtomTermAdjust(Term t)
83{
84 AtomEntry *ae = RepAtom(AtomOfTerm(t));
85 MarkAtomEntry(ae);
86 return(t);
87}
88
89static inline Term
90TermToGlobalOrAtomAdjust(Term t)
91{
92 if (t && IsAtomTerm(t))
93 return AtomTermAdjust(t);
94 return(t);
95}
96
97static inline Atom
98AtomAdjust(Atom a)
99{
100 AtomEntry *ae;
101 if (a == NIL) return(a);
102 ae = RepAtom(a);
103 MarkAtomEntry(ae);
104 return(a);
105}
106
107#define IsOldCode(P) FALSE
108#define IsOldCodeCellPtr(P) FALSE
109#define IsOldDelay(P) FALSE
110#define IsOldDelayPtr(P) FALSE
111#define IsOldLocalInTR(P) FALSE
112#define IsOldLocalInTRPtr(P) FALSE
113#define IsOldGlobal(P) FALSE
114#define IsOldGlobalPtr(P) FALSE
115#define IsOldTrail(P) FALSE
116#define IsOldTrailPtr(P) FALSE
117
118#define CharP(X) ((char *)(X))
119
120#define REINIT_LOCK(P)
121#define REINIT_RWLOCK(P)
122#define BlobTypeAdjust(P) (P)
123#define NoAGCAtomAdjust(P) (P)
124#define OrArgAdjust(P)
125#define TabEntryAdjust(P)
126#define IntegerAdjust(D) (D)
127#define AddrAdjust(P) (P)
128#define MFileAdjust(P) (P)
129#define CodeVarAdjust(P) (P)
130#define ConstantAdjust(P) (P)
131#define ArityAdjust(P) (P)
132#define DoubleInCodeAdjust(P)
133#define IntegerInCodeAdjust(P)
134#define OpcodeAdjust(P) (P)
135#define ModuleAdjust(P) (P)
136#define ExternalFunctionAdjust(P) (P)
137#define DBRecordAdjust(P) (P)
138#define PredEntryAdjust(P) (P)
139#define ModEntryPtrAdjust(P) (P)
140#define AtomEntryAdjust(P) (P)
141#define GlobalEntryAdjust(P) (P)
142#define BlobTermInCodeAdjust(P) (P)
143#define CellPtoHeapAdjust(P) (P)
144#define PtoAtomHashEntryAdjust(P) (P)
145#define CellPtoHeapCellAdjust(P) (P)
146#define CellPtoTRAdjust(P) (P)
147#define CodeAddrAdjust(P) (P)
148#define ConsultObjAdjust(P) (P)
149#define DelayAddrAdjust(P) (P)
150#define DelayAdjust(P) (P)
151#define GlobalAdjust(P) (P)
152#define DBRefAdjust(P,REF) (P)
153#define DBRefPAdjust(P) (P)
154#define DBTermAdjust(P) (P)
155#define LUIndexAdjust(P) (P)
156#define SIndexAdjust(P) (P)
157#define LocalAddrAdjust(P) (P)
158#define GlobalAddrAdjust(P) (P)
159#define OpListAdjust(P) (P)
160#define PtoLUCAdjust(P) (P)
161#define PtoStCAdjust(P) (P)
162#define PtoArrayEAdjust(P) (P)
163#define PtoArraySAdjust(P) (P)
164#define PtoGlobalEAdjust(P) (P)
165#define PtoDelayAdjust(P) (P)
166#define PtoGloAdjust(P) (P)
167#define PtoLocAdjust(P) (P)
168#define PtoHeapCellAdjust(P) (P)
169#define TermToGlobalAdjust(P) (P)
170#define PtoOpAdjust(P) (P)
171#define PtoLUClauseAdjust(P) (P)
172#define PtoLUIndexAdjust(P) (P)
173#define PtoDBTLAdjust(P) (P)
174#define PtoPredAdjust(P) (P)
175#define PtoPtoPredAdjust(P) (P)
176#define OpRTableAdjust(P) (P)
177#define OpEntryAdjust(P) (P)
178#define PropAdjust(P) (P)
179#define TrailAddrAdjust(P) (P)
180#define XAdjust(P) (P)
181#define YAdjust(P) (P)
182#define HoldEntryAdjust(P) (P)
183#define CodeCharPAdjust(P) (P)
184#define CodeConstCharPAdjust(P) (P)
185#define CodeVoidPAdjust(P) (P)
186#define HaltHookAdjust(P) (P)
187
188#define recompute_mask(dbr)
189
190#define rehash(oldcode, NOfE, KindOfEntries)
191
192#define RestoreSWIHash()
193
194static void
195AdjustTermFlag(flag_term *tarr, UInt i)
196{
197 CACHE_REGS
198 if (IsVarTerm(tarr[i].at)) {
199 RestoreDBTerm( tarr[i].DBT, false, 0 PASS_REGS );
200 } else if (IsAtomTerm( tarr[i].at ) )
201 tarr[i].at = AtomTermAdjust(tarr[i].at);
202}
203
204static void RestoreFlags( UInt NFlags )
205{
206 CACHE_REGS
207 size_t i;
208 flag_term *tarr = GLOBAL_Flags;
209
210 if (worker_id == 0)
211 for (i=0; i<GLOBAL_flagCount; i++) {
212 AdjustTermFlag( tarr, i);
213 }
214 tarr = LOCAL_Flags;
215 for (i=0; i<LOCAL_flagCount; i++) {
216 AdjustTermFlag( tarr, i);
217 }
218}
219
220#include "rheap.h"
221
222static void
223RestoreHashPreds( USES_REGS1 )
224{
225}
226
227
228static void init_reg_copies(USES_REGS1)
229{
230 LOCAL_OldASP = ASP;
231 LOCAL_OldLCL0 = LCL0;
232 LOCAL_OldTR = TR;
233 LOCAL_OldGlobalBase = (CELL *)LOCAL_GlobalBase;
234 LOCAL_OldH = HR;
235 LOCAL_OldH0 = H0;
236 LOCAL_OldTrailBase = LOCAL_TrailBase;
237 LOCAL_OldTrailTop = LOCAL_TrailTop;
238 LOCAL_OldHeapBase = Yap_HeapBase;
239 LOCAL_OldHeapTop = HeapTop;
240}
241
242
243static void
244RestoreAtomList(Atom atm USES_REGS)
245{
246 AtomEntry *at;
247
248 at = RepAtom(atm);
249 if (EndOfPAEntr(at))
250 return;
251 do {
252 RestoreAtom(atm PASS_REGS);
253 atm = CleanAtomMarkedBit(at->NextOfAE);
254 at = RepAtom(atm);
255 } while (!EndOfPAEntr(at));
256}
257
258static void
259mark_trail(USES_REGS1)
260{
261 register tr_fr_ptr pt;
262
263 pt = TR;
264 /* moving the trail is simple */
265 while (pt != (tr_fr_ptr)LOCAL_TrailBase) {
266 CELL reg = TrailTerm(pt-1);
267
268 if (!IsVarTerm(reg)) {
269 if (IsAtomTerm(reg)) {
270 MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
271 }
272 }
273
274 pt--;
275 }
276}
277
278static void
279mark_registers(USES_REGS1)
280{
281 CELL *pt;
282
283 pt = XREGS;
284 /* moving the trail is simple */
285 while (pt != XREGS+MaxTemps) {
286 CELL reg = *pt++;
287
288 if (!IsVarTerm(reg)) {
289 if (IsAtomTerm(reg)) {
290 MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
291 }
292 }
293 }
294}
295
296static void
297mark_local(USES_REGS1)
298{
299 CELL *pt;
300
301 /* Adjusting the local */
302 pt = LCL0;
303 /* moving the trail is simple */
304 while (pt > ASP) {
305 CELL reg = *--pt;
306
307 if (!IsVarTerm(reg)) {
308 if (IsAtomTerm(reg)
309#ifdef TABLING
310 /* assume we cannot have atoms on first page,
311 so this must be an arity
312 */
313 && reg > Yap_page_size
314#endif
315 ) {
316 MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
317 }
318 }
319 }
320}
321
322static CELL *
323mark_global_cell(CELL *pt)
324{
325 CELL reg = *pt;
326
327 if (IsVarTerm(reg)) {
328 /* skip bitmaps */
329 switch(reg) {
330 case (CELL)FunctorDouble:
331#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
332 return pt + 4;
333#else
334 return pt + 3;
335#endif
336 case (CELL)FunctorString:
337 return pt + 3 + pt[1];
338 case (CELL)FunctorBigInt:
339 {
340 Int sz = 3 +
341 (sizeof(MP_INT)+
342 (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
343 return pt+sz;
344 }
345 case (CELL)FunctorBlob:
346 {
347 YAP_Opaque_CallOnGCMark f;
348 YAP_Opaque_CallOnGCRelocate f2;
349 Term t = AbsAppl(pt);
350 size_t sz = pt[2]+4;
351 if ( (f = Yap_blob_gc_mark_handler(t)) ) {
352 CELL ar[256];
353 Int i,n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, 256);
354 if (n < 0) {
355 Yap_Error(RESOURCE_ERROR_HEAP,TermNil,"not enough space for slot internal variables in agc");
356 }
357 for (i = 0; i< n; i++) {
358 CELL *pt = ar+i;
359 CELL reg = *pt;
360 if (!IsVarTerm(reg) && IsAtomTerm(reg)) {
361 *pt = AtomTermAdjust(reg);
362 }
363 }
364 if ( (f2 = Yap_blob_gc_relocate_handler(t)) < 0 ) {
365 int out = (f2)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, n);
366 if (out < 0)
367 Yap_Error(RESOURCE_ERROR_HEAP,TermNil,"bad restore of slot internal variables in agc");
368 }
369 }
370
371 return pt + sz;
372 }
373 case (CELL)FunctorLongInt:
374 return pt + 3;
375 break;
376 }
377 } else if (IsAtomTerm(reg)) {
378 MarkAtomEntry(RepAtom(AtomOfTerm(reg)));
379 return pt+1;
380 }
381 return pt+1;
382}
383
384static void
385mark_global(USES_REGS1)
386{
387 CELL *pt;
388
389 /*
390 * to clean the global now that functors are just variables pointing to
391 * the code
392 */
393 pt = H0;
394 while (pt < HR) {
395 pt = mark_global_cell(pt);
396 }
397}
398
399static void
400mark_stacks(USES_REGS1)
401{
402 mark_registers(PASS_REGS1);
403 mark_trail(PASS_REGS1);
404 mark_local(PASS_REGS1);
405 mark_global(PASS_REGS1);
406}
407
408static void
409clean_atom_list(AtomHashEntry *HashPtr)
410{
411 Atom atm = HashPtr->Entry;
412 Atom *patm = &(HashPtr->Entry);
413 while (atm != NIL) {
414 AtomEntry *at = RepAtom(atm);
415 if (AtomResetMark(at) ||
416 ( at->PropsOfAE != NIL && !IsBlob(at) ) ||
417 (GLOBAL_AGCHook != NULL && !GLOBAL_AGCHook(atm))) {
418 patm = &(at->NextOfAE);
419 atm = at->NextOfAE;
420 } else {
421 NOfAtoms--;
422 if (IsBlob(atm)) {
423 YAP_BlobPropEntry *b = RepBlobProp(at->PropsOfAE);
424 if (b->NextOfPE != NIL) {
425 patm = &(at->NextOfAE);
426 atm = at->NextOfAE;
427 continue;
428 }
429 NOfAtoms++;
430 NOfBlobs--;
431 b->NextOfPE = NIL;
432 Yap_FreeCodeSpace((char *)b);
433 GLOBAL_agc_collected += sizeof(YAP_BlobPropEntry);
434 GLOBAL_agc_collected += sizeof(AtomEntry)+sizeof(size_t)+at->rep.blob->length;
435 } else {
436#ifdef DEBUG_RESTORE3
437 fprintf(stderr, "Purged %p:%s patm=%p %p\n", at, at->StrOfAE, patm, at->NextOfAE);
438#endif
439 GLOBAL_agc_collected += sizeof(AtomEntry)+strlen((const char *)at->StrOfAE);
440 }
441 *patm = atm = at->NextOfAE;
442 at->NextOfAE = NIL;
443 Yap_FreeCodeSpace((char *)at);
444 }
445 }
446}
447
448/*
449 * This is the really tough part, to restore the whole of the heap
450 */
451static void
452clean_atoms(void)
453{
454 AtomHashEntry *HashPtr = HashChain;
455 register int i;
456
457 AtomResetMark(AtomFoundVar);
458 AtomResetMark(AtomFreeTerm);
459 for (i = 0; i < AtomHashTableSize; ++i) {
460 clean_atom_list(HashPtr);
461 HashPtr++;
462 }
463 clean_atom_list(&INVISIBLECHAIN);
464 {
465 AtomHashEntry list;
466 list.Entry = Blobs;
467 clean_atom_list(&list);
468 }
469}
470
471static void
472atom_gc(USES_REGS1)
473{
474 bool gc_verbose = Yap_is_gc_verbose();
475 bool gc_trace = false;
476
477return;
478 UInt time_start, agc_time;
479#if defined(YAPOR) || defined(THREADS)
480 return;
481#endif
482
483 if (Yap_GetValue(AtomGcTrace) != TermNil)
484 gc_trace = true;
485
486 GLOBAL_agc_calls++;
487 GLOBAL_agc_collected = 0;
488
489 if (gc_trace) {
490 fprintf(stderr, "%% agc:\n");
491 } else if (gc_verbose) {
492 fprintf(stderr, "%% Start of atom garbage collection %d:\n", GLOBAL_agc_calls);
493 }
494 time_start = Yap_cputime();
495 /* get the number of active registers */
496 YAPEnterCriticalSection();
497 init_reg_copies(PASS_REGS1);
498 mark_stacks(PASS_REGS1);
499 restore_codes();
500 clean_atoms();
501 NOfBlobsMax = NOfBlobs+(NOfBlobs/2+256< 1024 ? NOfBlobs/2+256 : 1024);
502 YAPLeaveCriticalSection();
503 agc_time = Yap_cputime()-time_start;
504 GLOBAL_tot_agc_time += agc_time;
505 GLOBAL_tot_agc_recovered += GLOBAL_agc_collected;
506 if (gc_verbose) {
507#ifdef _WIN32
508 fprintf(stderr, "%% Collected %I64d bytes.\n", GLOBAL_agc_collected);
509#else
510 fprintf(stderr, "%% Collected %lld bytes.\n", GLOBAL_agc_collected);
511#endif
512 fprintf(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);
513 }
514}
515
516void
517Yap_atom_gc(USES_REGS1)
518{
519 atom_gc(PASS_REGS1);
520}
521
522static Int
523p_atom_gc(USES_REGS1)
524{
525#ifndef FIXED_STACKS
526 atom_gc(PASS_REGS1);
527#endif /* FIXED_STACKS */
528 return TRUE;
529}
530
531static Int
532p_inform_agc(USES_REGS1)
533{
534 Term tn = MkIntegerTerm(GLOBAL_tot_agc_time);
535 Term tt = MkIntegerTerm(GLOBAL_agc_calls);
536 Term ts = MkIntegerTerm(GLOBAL_tot_agc_recovered);
537
538 return
539 Yap_unify(tn, ARG2) &&
540 Yap_unify(tt, ARG1) &&
541 Yap_unify(ts, ARG3);
542}
543
544
545void
546Yap_init_agc(void)
547{
548 Yap_InitCPred("$atom_gc", 0, p_atom_gc, 0);
549 Yap_InitCPred("$inform_agc", 3, p_inform_agc, 0);
550}
Foreign.h
load_foreign_files/3 has works for the following configurations:
gc_trace
@ gc_trace
show activity in garbag collector
Definition: YapGFlagInfo.h:306
DB_TERM
Definition: Yatom.h:689
MP_INT
Definition: TermExt.h:345
YAP_blob_prop_entry
Definition: Yatom.h:1150
atom_hash_entry
Definition: YapHeap.h:81
pred_entry
Definition: Yatom.h:544
flagTerm
a flag is represented as a Prolog term
Definition: YapFlags.h:189