2 Copyright (C) 2001-2007, The Perl Foundation.
7 src/gc/gc_gms.c - Generational mark and sweep garbage collection
11 The following comments describe a generational garbage collection
16 - non-copying, mark & sweep
18 - implicit reclamation, treadmill
22 A plain mark & sweep collector performs work depending on the amount
23 of all allocated objects. The advantage of a generational GC is
24 achieved by not processing all objects. This is based on the weak
25 generational hypothesis, which states that young objects are likely to
26 die early. Old objects, which have survived a few GC cycles tend to be
29 The terms young and old objects imply that there is some ordering in
30 object creation time and the ordering is also followed by object
33 Specifically object references have to follow the marking direction.
34 In pure functional programming languages this can be a very simple
37 +------------+ object references
39 old .... young .... youngest
41 <-------- scan direction
43 If (simplified) the only reference-like operation of the interpreter
48 and the object references "car" and "cdr" are created prior to the
49 "aggregate" "cons", all object references point always to older
50 objects. By scanning from the youngest to the oldest objects, all
51 non-marked objects can be reclaimed immediately. And the scan can be
52 aborted at any time after some processing, creating a generational GC
55 But the programming languages we are serving are working basically the
56 other direction, when it comes to object history:
60 A reference operation like this needs first an aggregate and then the
61 contents of it. So the scan direction is from old objects to younger
62 ones. In such a scheme it's a bit more complicated to skip parts of
65 To take advantage of not processing all the objects, these are divided
66 into generations, e.g.:
69 generation 0 generation 1
71 A mark phase now processes the root set and only objects from the
72 young generation. When all objects are either referenced by the root
73 set or only by the young generation, the algorithm is correct and
76 But there is of course the possibilty that a young object is
77 stored into an aggregate of an older generation. This case is tracked
78 by the write barrier, which remembers all such operations in the IGP
79 (inter generational pointer) list. When now generation 1 is marked,
80 the IGP list can be considered as an extension to the root set, so
81 that again all live objects of the young generation are detected.
88 =item C<typedef struct _gc_gms_gen Gc_gms_gen>
90 Describes the state of one generation for one pool.
92 =item C<typedef struct _gc_gms_hdr Gc_gms_hdr>
94 This header is in front of all Parrot objects. It forms a doubly-linked
95 list of all objects in one pool and points to its generation.
101 These two macros convert from and to headers and objects.
103 =item C<typedef struct _gc_gms_hdr_list Gc_gms_hdr_list>
105 A chained list of headers used e.g. for the IGP list.
113 #include "parrot/parrot.h"
114 #include "parrot/dod.h"
118 typedef struct Gc_gms_private
{
119 UINTVAL current_gen_no
; /* the nursery generation number */
122 /* HEADERIZER HFILE: include/parrot/dod.h */
124 /* HEADERIZER BEGIN: static */
125 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
127 static int end_cycle_cb(PARROT_INTERP
,
128 ARGMOD(Small_Object_Pool
*pool
),
131 __attribute__nonnull__(1)
132 __attribute__nonnull__(2)
133 FUNC_MODIFIES(*pool
);
135 static void gc_gms_add_free_object(PARROT_INTERP
,
136 SHIM(Small_Object_Pool
*pool
),
138 __attribute__nonnull__(1);
140 static void gc_gms_alloc_objects(PARROT_INTERP
,
141 ARGMOD(Small_Object_Pool
*pool
))
142 __attribute__nonnull__(1)
143 __attribute__nonnull__(2)
144 FUNC_MODIFIES(*pool
);
146 static void gc_gms_chain_objects(PARROT_INTERP
,
147 ARGMOD(Small_Object_Pool
*pool
),
148 ARGIN(Small_Object_Arena
*new_arena
),
150 __attribute__nonnull__(1)
151 __attribute__nonnull__(2)
152 __attribute__nonnull__(3)
153 FUNC_MODIFIES(*pool
);
155 static void gc_gms_clear_hdr_list(PARROT_INTERP
, ARGMOD(Gc_gms_hdr_list
*l
))
156 __attribute__nonnull__(1)
157 __attribute__nonnull__(2)
160 static void gc_gms_clear_igp(PARROT_INTERP
, ARGIN(Gc_gms_gen
*gen
))
161 __attribute__nonnull__(1)
162 __attribute__nonnull__(2);
165 PARROT_CANNOT_RETURN_NULL
166 static Gc_gms_gen
* gc_gms_create_gen(PARROT_INTERP
,
167 ARGMOD(Small_Object_Pool
*pool
),
169 __attribute__nonnull__(1)
170 __attribute__nonnull__(2)
171 FUNC_MODIFIES(*pool
);
173 static void gc_gms_end_cycle(PARROT_INTERP
)
174 __attribute__nonnull__(1);
176 PARROT_WARN_UNUSED_RESULT
177 PARROT_CANNOT_RETURN_NULL
178 static Gc_gms_gen
* gc_gms_find_gen(PARROT_INTERP
,
179 ARGIN(const Gc_gms_hdr
*h
),
181 __attribute__nonnull__(1)
182 __attribute__nonnull__(2);
184 PARROT_WARN_UNUSED_RESULT
185 PARROT_CANNOT_RETURN_NULL
186 static PObj
* gc_gms_get_free_object(PARROT_INTERP
,
187 ARGMOD(Small_Object_Pool
*pool
))
188 __attribute__nonnull__(1)
189 __attribute__nonnull__(2)
190 FUNC_MODIFIES(*pool
);
192 static void gc_gms_init_gen(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
193 __attribute__nonnull__(1)
194 __attribute__nonnull__(2)
195 FUNC_MODIFIES(*pool
);
197 static void gc_gms_init_mark(PARROT_INTERP
)
198 __attribute__nonnull__(1);
200 static void gc_gms_merge_gen(PARROT_INTERP
,
201 ARGMOD(Small_Object_Pool
*pool
),
203 SHIM(Gc_gms_plan
*plan
))
204 __attribute__nonnull__(1)
205 __attribute__nonnull__(2)
206 FUNC_MODIFIES(*pool
);
208 static void gc_gms_more_objects(PARROT_INTERP
,
209 ARGMOD(Small_Object_Pool
*pool
))
210 __attribute__nonnull__(1)
211 __attribute__nonnull__(2)
212 FUNC_MODIFIES(*pool
);
214 static void gc_gms_pool_init(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
215 __attribute__nonnull__(1)
216 __attribute__nonnull__(2)
217 FUNC_MODIFIES(*pool
);
219 static void gc_gms_promote(PARROT_INTERP
,
220 ARGIN(Gc_gms_hdr
*h
),
222 __attribute__nonnull__(1)
223 __attribute__nonnull__(2);
225 static void gc_gms_set_gen(PARROT_INTERP
)
226 __attribute__nonnull__(1);
228 static void gc_gms_setto_black(PARROT_INTERP
,
229 ARGMOD(Gc_gms_hdr
*h
),
231 __attribute__nonnull__(1)
232 __attribute__nonnull__(2)
235 static void gc_gms_setto_gray(PARROT_INTERP
,
236 ARGIN(Gc_gms_hdr
*h
),
238 __attribute__nonnull__(1)
239 __attribute__nonnull__(2);
241 static void gc_gms_store_hdr_list(PARROT_INTERP
,
242 ARGMOD(Gc_gms_hdr_list
*l
),
243 ARGIN(Gc_gms_hdr
*h
))
244 __attribute__nonnull__(1)
245 __attribute__nonnull__(2)
246 __attribute__nonnull__(3)
249 static void gc_gms_store_igp(PARROT_INTERP
, ARGIN(Gc_gms_hdr
*h
))
250 __attribute__nonnull__(1)
251 __attribute__nonnull__(2);
253 static void gc_gms_sweep(PARROT_INTERP
)
254 __attribute__nonnull__(1);
256 static int gc_gms_trace_children(PARROT_INTERP
)
257 __attribute__nonnull__(1);
259 static int gc_gms_trace_root(PARROT_INTERP
, int trace_stack
)
260 __attribute__nonnull__(1);
262 static void gc_gms_use_gen(PARROT_INTERP
,
263 ARGMOD(Small_Object_Pool
*pool
),
265 ARGIN(const Gc_gms_plan
*plan
))
266 __attribute__nonnull__(1)
267 __attribute__nonnull__(2)
268 __attribute__nonnull__(4)
269 FUNC_MODIFIES(*pool
);
271 static void gms_debug_verify(PARROT_INTERP
,
272 ARGMOD(Small_Object_Pool
*pool
),
273 ARGIN(const char *action
))
274 __attribute__nonnull__(1)
275 __attribute__nonnull__(2)
276 __attribute__nonnull__(3)
277 FUNC_MODIFIES(*pool
);
279 static int init_mark_cb(PARROT_INTERP
,
280 ARGMOD(Small_Object_Pool
*pool
),
283 __attribute__nonnull__(1)
284 __attribute__nonnull__(2)
285 __attribute__nonnull__(4)
286 FUNC_MODIFIES(*pool
);
288 static void parrot_gc_gms_deinit(PARROT_INTERP
)
289 __attribute__nonnull__(1);
291 static void parrot_gc_gms_run(PARROT_INTERP
, int flags
)
292 __attribute__nonnull__(1);
294 PARROT_WARN_UNUSED_RESULT
295 static int set_gen_cb(PARROT_INTERP
,
296 ARGIN(Small_Object_Pool
*pool
),
299 __attribute__nonnull__(1)
300 __attribute__nonnull__(2)
301 __attribute__nonnull__(4);
303 static int sweep_cb_buf(PARROT_INTERP
,
304 ARGMOD(Small_Object_Pool
*pool
),
307 __attribute__nonnull__(1)
308 __attribute__nonnull__(2)
309 FUNC_MODIFIES(*pool
);
311 static int sweep_cb_pmc(PARROT_INTERP
,
312 ARGIN(Small_Object_Pool
*pool
),
315 __attribute__nonnull__(1)
316 __attribute__nonnull__(2);
318 static int trace_children_cb(PARROT_INTERP
,
319 ARGIN(Small_Object_Pool
*pool
),
322 __attribute__nonnull__(1)
323 __attribute__nonnull__(2);
325 static int trace_igp_cb(PARROT_INTERP
,
326 ARGIN(Small_Object_Pool
*pool
),
329 __attribute__nonnull__(1)
330 __attribute__nonnull__(2);
332 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
333 /* HEADERIZER END: static */
342 Main problem TODO 1):
344 [ PCont ] ... continuation object in old generation
347 [ Stack chunk ] --> [ e.g. P register frame ] ... new generation
349 By pushing a new stack chunk onto the (old) existing stack frame,
350 we'd need a WRITE_BARRIER that promotes the stack chunk to the old
351 generation of the continuation.
352 This would also need an IGP entry for the stack chunk buffer. But -
353 as buffers aren't really containers in Parrot - this isn't possible.
355 To get that right, the code needs better support by the running
357 - never promote continuations (and stacks) in the current stack frame
359 - create scope_enter / scope_exit opcodes
361 A scope_enter happens on a subroutine call *and' with new_pad /
362 push_pad opcodes. Each lexical scope must have its distinct register
363 frame, else timely destruction can't work.
364 If the frame needs active destruction, the old frame should be
365 converted to the (new-1) generation, the inner frame is the nursery.
366 On scope exit the newest (nursery) generation is collected and the
367 current generation number is reset back to (new-1).
369 If the scope_enter doesn't indicate timely destruction, generation
370 promoting should be done only, if object statistics indicate the
371 presence of a fair amount of live objects.
373 TODO 2) in lazy sweep
374 If timely destruction didn't find (all) eager objects, go back to
375 older generations, until all these objects have been seen.
377 TODO 3) interpreter startup
378 After all internal structures are created, promote interpreter state
379 into initial first old generation by running one GC cycle before
380 program execution begins (or just treat all objects as being alive).
387 * call code to verify chain of pointers after each change
388 * this is very expensive, but should be used during development
390 # define GC_GMS_DEBUG 0
392 # define UNITS_PER_ALLOC_GROWTH_FACTOR 1.75
393 # define POOL_MAX_BYTES 65536*128
397 =head2 Initialization functions
401 =item C<static void parrot_gc_gms_deinit>
410 parrot_gc_gms_deinit(PARROT_INTERP
)
412 Arenas
* const arena_base
= interp
->arena_base
;
415 * TODO free generations
417 mem_sys_free(arena_base
->gc_private
);
418 arena_base
->gc_private
= NULL
;
423 =item C<static void gc_gms_pool_init>
425 Initialize pool variables. This function must set the pool function pointers
426 for C<add_free_object>, C<get_free_object>, C<alloc_objects>, and
434 gc_gms_pool_init(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
436 pool
->add_free_object
= gc_gms_add_free_object
;
437 pool
->get_free_object
= gc_gms_get_free_object
;
438 pool
->alloc_objects
= gc_gms_alloc_objects
;
439 pool
->more_objects
= gc_gms_more_objects
;
441 /* initialize generations */
442 gc_gms_init_gen(interp
, pool
);
443 pool
->white
= pool
->white_fin
= pool
->free_list
= &pool
->marker
;
445 pool
->object_size
+= sizeof (Gc_gms_hdr
);
450 =item C<void Parrot_gc_gms_init>
452 Initialize the state structures of the gc system. Called immediately before
453 creation of memory pools.
461 Parrot_gc_gms_init(PARROT_INTERP
)
463 Arenas
* const arena_base
= interp
->arena_base
;
465 arena_base
->gc_private
= mem_sys_allocate_zeroed(sizeof (Gc_gms_private
));
468 * set function hooks according to pdd09
470 arena_base
->do_gc_mark
= parrot_gc_gms_run
;
471 arena_base
->finalize_gc_system
= parrot_gc_gms_deinit
;
472 arena_base
->init_pool
= gc_gms_pool_init
;
480 =head2 Interface functions
484 =item C<static void gc_gms_add_free_object>
486 Unused. White (dead) objects are added in a bunch to the free_list.
493 gc_gms_add_free_object(PARROT_INTERP
, SHIM(Small_Object_Pool
*pool
),
496 real_exception(interp
, NULL
, 1, "gms abuse");
502 =item C<static void gc_gms_chain_objects>
504 TODO: interfere active_destroy and put these items into a
505 separate white area, so that a sweep has just to run through these
509 - all objects are chained together forming a circular list
510 - pool->marker is the "anchor" of the circle (shown twice below)
514 1a) one bunch of allocated objects was consumed: the free ptr did
517 +===+---+---+---+---+---+===+
518 I M I w | w | w | w | w I M I
519 + +---+---+---+---+---+ +
524 All these pointer ranges include the first element, but not the last one.
526 [white ... free_list) is the list of all whites
528 1b) after allocating another bunch of objects
530 +===+---+---+---+---+---+---+---+---+---+---+===+
531 I M I w | w | w | w | w | f | f | f | f | f I M I
532 + +---+---+---+---+---+---+---+---+---+---+ +
542 gc_gms_chain_objects(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
),
543 ARGIN(Small_Object_Arena
*new_arena
), size_t real_size
)
545 Gc_gms_hdr
*next
, *prev
;
548 Gc_gms_hdr
*p
= new_arena
->start_objects
;
549 Gc_gms_hdr
* const marker
= &pool
->marker
;
551 PARROT_ASSERT(pool
->free_list
== marker
);
553 /* update pool statistics */
554 n
= new_arena
->total_objects
;
555 pool
->total_objects
+= n
;
556 pool
->num_free_objects
+= n
;
558 /* initially all is pointing to marker */
559 if (pool
->white
== marker
) {
560 /* set origin of first allocation */
563 pool
->white
= pool
->white_fin
= p
;
568 /* chain objects together by inserting to the left of marker */
570 /* point to end of last object */
571 p
= (void*) ((char*) p
+ real_size
* n
);
573 for (i
= 0; i
< n
; ++i
) {
574 p
= (void*) ((char *)p
- real_size
);
578 p
->gen
= (void *)0xdeadbeef;
582 PARROT_ASSERT(p
== new_arena
->start_objects
);
586 PARROT_ASSERT(p
!= marker
);
591 =item C<static void gc_gms_alloc_objects>
593 Allocate new objects for the given pool.
600 gc_gms_alloc_objects(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
602 const size_t real_size
= pool
->object_size
;
603 Small_Object_Arena
* const new_arena
= mem_internal_allocate(sizeof (Small_Object_Arena
));
604 const size_t size
= real_size
* pool
->objects_per_alloc
;
606 new_arena
->start_objects
= mem_internal_allocate(size
);
607 /* insert arena in list */
608 Parrot_append_arena_in_pool(interp
, pool
, new_arena
, size
);
609 /* create chain of objects, set free pointer */
610 gc_gms_chain_objects(interp
, pool
, new_arena
, real_size
);
612 /* allocate more next time */
613 pool
->objects_per_alloc
= (UINTVAL
) pool
->objects_per_alloc
*
614 UNITS_PER_ALLOC_GROWTH_FACTOR
;
615 size
= real_size
* pool
->objects_per_alloc
;
616 if (size
> POOL_MAX_BYTES
) {
617 pool
->objects_per_alloc
= POOL_MAX_BYTES
/ real_size
;
623 =item C<static void gc_gms_more_objects>
625 Run a GC cycle or allocate new objects for the given pool.
632 gc_gms_more_objects(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
636 else if (pool
->last_Arena
) {
637 Parrot_do_dod_run(interp
, GC_trace_stack_FLAG
);
638 if (pool
->num_free_objects
<= pool
->replenish_level
)
642 if (pool
->free_list
== &pool
->marker
) {
643 (*pool
->alloc_objects
) (interp
, pool
);
649 =item C<static PObj * gc_gms_get_free_object>
651 Get a new object off the free_list in the given pool.
653 2) object consumption
654 the free ptr moves towards the marker
660 PARROT_WARN_UNUSED_RESULT
661 PARROT_CANNOT_RETURN_NULL
663 gc_gms_get_free_object(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
668 hdr
= pool
->free_list
;
669 if (hdr
== &pool
->marker
)
670 (pool
->more_objects
)(interp
, pool
);
672 hdr
= pool
->free_list
;
673 pool
->free_list
= hdr
->next
;
674 hdr
->gen
= pool
->last_gen
;
675 ptr
= GMSH_to_PObj(hdr
);
676 PObj_flags_SETTO((PObj
*) ptr
, 0);
684 =head2 Generation handling functions
686 overall header chain layout
688 gen 0 gen 1 ... gen N
689 marker [first last) [first last) ... [first last) marker
691 The last (youngest) generation N holds these (pool) pointers:
693 [ black ... gray ) during marking
694 [ gray ... white ) during marking
695 [ white ... free_list ) allocated items
696 [ free_list ... marker ) free items
698 The black, white, and generation ranges have additionally (TODO)
699 *fin variants, which refer to PMCs that need destruction/finalization.
700 These are always in front of the ranges to be processed first.
704 =item C<static Gc_gms_gen * gc_gms_create_gen>
706 Create a generation structure for the given generation number.
713 PARROT_CANNOT_RETURN_NULL
715 gc_gms_create_gen(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
), size_t gen_no
)
717 Gc_gms_gen
* const gen
= mem_sys_allocate(sizeof (*gen
));
719 gen
->gen_no
= gen_no
;
721 gen
->timely_destruct_obj_sofar
= 0;
722 gen
->black_color
= b_PObj_live_FLAG
;
725 gen
->first
= gen
->last
= gen
->fin
= &pool
->marker
;
726 gen
->igp
.first
= NULL
;
727 gen
->igp
.last
= NULL
;
734 =item C<static void gc_gms_init_gen>
736 Initalize the generation system by creating the first two generations.
743 gc_gms_init_gen(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
))
745 Gc_gms_private
*gmsp
;
747 * Generations are numbered beginning at zero
751 * If a constant hash PMC refers to non-constant header buffers or
752 * items, these items can be placed in the constant generation 0
753 * XXX: OTOH this would work only for this GC subsystem.
755 pool
->first_gen
= gc_gms_create_gen(interp
, pool
, 0);
756 pool
->last_gen
= pool
->first_gen
;
757 gmsp
= interp
->arena_base
->gc_private
;
758 gmsp
->current_gen_no
= 0;
763 =item C<static Gc_gms_gen * gc_gms_find_gen>
765 RT #48260: Not yet documented!!!
771 PARROT_WARN_UNUSED_RESULT
772 PARROT_CANNOT_RETURN_NULL
774 gc_gms_find_gen(PARROT_INTERP
, ARGIN(const Gc_gms_hdr
*h
), UINTVAL gen_no
)
777 const Small_Object_Pool
* const pool
= h
->gen
->pool
;
781 for (gen
= pool
->first_gen
; gen
; gen
= gen
->next
) {
782 if (gen_no
== gen
->gen_no
)
784 if (gen
->gen_no
> gen_no
) {
789 /* we could create generations lazily - not all object sizes
790 * might exist in every generation
792 * TODO insert generation
794 real_exception(interp
, NULL
, 1, "generation %d not found for hdr %p",
800 =item C<static void gc_gms_promote>
802 RT #48260: Not yet documented!!!
809 gc_gms_promote(PARROT_INTERP
, ARGIN(Gc_gms_hdr
*h
), UINTVAL gen_no
)
812 Gc_gms_hdr
*prev
, *next
;
813 Small_Object_Pool
* const pool
= h
->gen
->pool
;
815 /* unsnap from current generation */
818 if (h
== pool
->white
) {
824 /* locate generation pointer */
825 gen
= gc_gms_find_gen(interp
, h
, gen_no
);
826 PARROT_ASSERT(gen
->last
);
827 PARROT_ASSERT(gen
->first
);
829 /* TODO if it needs destroy put it in front */
832 next
= gen
->last
= h
->next
;
834 if (gen
->first
== &pool
->marker
)
841 gms_debug_verify(interp
, pool
, "promote");
847 =item C<static void gc_gms_store_hdr_list>
849 RT #48260: Not yet documented!!!
856 gc_gms_store_hdr_list(PARROT_INTERP
, ARGMOD(Gc_gms_hdr_list
*l
), ARGIN(Gc_gms_hdr
*h
))
858 Gc_gms_hdr_store
* const s
= l
->last
;
860 /* if it's not created or if it's full allocate new store */
861 if (!s
|| s
->ptr
== &s
->store
[GC_GMS_STORE_SIZE
]) {
862 s
= mem_sys_allocate(sizeof (Gc_gms_hdr_store
));
863 s
->ptr
= &s
->store
[0];
865 /* chain new store to old one */
867 PARROT_ASSERT(l
->last
);
880 =item C<static void gc_gms_clear_hdr_list>
882 RT #48260: Not yet documented!!!
889 gc_gms_clear_hdr_list(PARROT_INTERP
, ARGMOD(Gc_gms_hdr_list
*l
))
891 Gc_gms_hdr_store
*s
, *next
;
893 for (s
= l
->first
; s
; s
= next
) {
897 l
->first
= l
->last
= NULL
;
902 =item C<static void gc_gms_store_igp>
904 RT #48260: Not yet documented!!!
911 gc_gms_store_igp(PARROT_INTERP
, ARGIN(Gc_gms_hdr
*h
))
913 Gc_gms_gen
* const gen
= h
->gen
;
914 Gc_gms_hdr_list
* const igp
= &gen
->igp
;
916 gc_gms_store_hdr_list(interp
, igp
, h
);
921 =item C<static void gc_gms_clear_igp>
923 RT #48260: Not yet documented!!!
930 gc_gms_clear_igp(PARROT_INTERP
, ARGIN(Gc_gms_gen
*gen
))
932 Gc_gms_hdr_list
* const igp
= &gen
->igp
;
934 gc_gms_clear_hdr_list(interp
, igp
);
939 =item C<void parrot_gc_gms_wb>
941 Called by the write barrier. The aggregate belongs to an older generation
942 then the I<new> value written into it. Put the header of the new value
943 onto the IGP list for the current generation, if it contains pointers
944 to other items, and promote it to the old generation.
951 parrot_gc_gms_wb(PARROT_INTERP
, ARGIN(PMC
*agg
), ARGIN(void *old
),
954 Gc_gms_hdr
* const nh
= PObj_to_GMSH(_new
);
955 Gc_gms_hdr
* const ah
= PObj_to_GMSH(agg
);
957 /* if this may be an aggregate store it in IGP list, thus making
958 * it a possible root for this generation
960 if (PObj_is_PMC_TEST((PObj
*)_new
) && ((PMC
*)_new
)->pmc_ext
)
961 gc_gms_store_igp(interp
, nh
);
963 /* promote RHS to old generation of aggregate */
964 gc_gms_promote(interp
, nh
, ah
->gen
->gen_no
);
967 * TODO check old - its overwritten, increment overwrite count,
968 * if it's an aggregate all contents *may* be dead now, so
969 * increment overwrite count by elements
975 =item C<void parrot_gc_gms_wb_key>
977 RT #48260: Not yet documented!!!
984 parrot_gc_gms_wb_key(PARROT_INTERP
, ARGIN(PMC
*agg
), ARGIN(void *old
),
985 ARGIN(void *old_key
), ARGIN(void *_new
), ARGIN(void *new_key
))
989 /* handle hash values */
990 parrot_gc_gms_wb(interp
, agg
, old
, _new
);
992 /* if hash keys are PObj* then promote new key too */
994 /* TODO: check if key is a PObj */
996 nh
= PObj_to_GMSH(new_key
);
997 ah
= PObj_to_GMSH(agg
);
999 /* promote new key to old generation of aggregate */
1000 gc_gms_promote(interp
, nh
, ah
->gen
->gen_no
);
1003 typedef struct Gc_gms_plan
{
1010 =item C<static void gc_gms_merge_gen>
1012 RT #48260: Not yet documented!!!
1019 gc_gms_merge_gen(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
),
1020 int flag
, SHIM(Gc_gms_plan
*plan
))
1024 /* run through the blacks and set their generation pointer
1025 * to the previous generation
1027 Gc_gms_gen
* const gen
= pool
->last_gen
;
1028 Gc_gms_gen
* const prev
= gen
->prev
;
1030 for (h
= pool
->black
; h
!= pool
->free_list
; h
= h
->next
) {
1032 /* TODO update statistics */
1033 /* TODO merge hdrs that need finalization */
1035 prev
->last
= pool
->free_list
;
1039 gc_gms_clear_igp(interp
, gen
);
1044 =item C<static void gc_gms_use_gen>
1046 RT #48260: Not yet documented!!!
1053 gc_gms_use_gen(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
),
1054 int flag
, ARGIN(const Gc_gms_plan
*plan
))
1056 Gc_gms_gen
*gen
, *prev
;
1059 /* set hdr pointers in last generation */
1060 gen
= pool
->last_gen
;
1061 gen
->first
= pool
->black
;
1062 gen
->fin
= pool
->black_fin
;
1063 gen
->last
= pool
->free_list
;
1065 /* create and append a new generation */
1066 next_gen
= plan
->gen_no
+ 1;
1067 gen
= gc_gms_create_gen(interp
, pool
, next_gen
);
1068 prev
= pool
->last_gen
;
1069 pool
->last_gen
= gen
;
1073 /* set generation in interpreter */
1074 interp
->gc_generation
= next_gen
;
1079 =item C<static int set_gen_cb>
1081 RT #48260: Not yet documented!!!
1087 PARROT_WARN_UNUSED_RESULT
1089 set_gen_cb(PARROT_INTERP
, ARGIN(Small_Object_Pool
*pool
), int flag
, ARGIN(void *arg
))
1091 Gc_gms_plan
* const plan
= (Gc_gms_plan
*)arg
;
1093 if (plan
->merge_gen
)
1094 gc_gms_merge_gen(interp
, pool
, flag
, plan
);
1096 gc_gms_use_gen(interp
, pool
, flag
, plan
);
1102 =item C<static void gc_gms_set_gen>
1104 RT #48260: Not yet documented!!!
1111 gc_gms_set_gen(PARROT_INTERP
)
1114 Gc_gms_private
*gmsp
;
1116 * there are these basic plans
1117 * 1) Use the black as the next old generation
1118 * 2) Merge the blacks to the existing older generation
1119 * The plan to use depends on the interpreter, specifically, if
1120 * we are doing a lazy run, entering a new scope, or what not.
1121 * 3) If we are leaving a scope (denoted by a lazy DOD run
1122 * and we had created one or more generations in this scope
1123 * go back by resetting the generation number to the outer
1124 * scope's generation
1125 * 4) Check the overwrite count of older generations. If there is
1126 * a significant percentage of possibly dead objects, scan
1127 * older generations too.
1129 * TODO only 1 and 2 done for now
1130 * 3) and 4) need to reset live flags of the previous generation(s)
1131 * or better use the per-generation black_color for marking
1133 gmsp
= interp
->arena_base
->gc_private
;
1135 plan
.gen_no
= gmsp
->current_gen_no
;
1136 if (gmsp
->current_gen_no
> 0)
1139 gmsp
->current_gen_no
= 1;
1140 Parrot_forall_header_pools(interp
, POOL_ALL
, &plan
, set_gen_cb
);
1147 =head2 Marking functions
1151 Init: gray := black := white
1153 3) marking the root set
1155 3a) the white 'h' is to be set to gray to be scanned for children
1157 +---+---+---+---+---+---+-> +---+->
1158 | b | b | g | g | g | w | h |
1159 +---+---+---+---+---+---+ <-+---+
1164 3b) DFS if 'h' needs timely destruction
1166 +---+---+---+---+---+---+---+->
1167 | b | b | h | g | g | g | w
1168 +---+---+---+---+---+---+---+
1174 3c) BFS in the normal case
1176 +---+---+---+---+---+---+---+->
1177 | b | b | g | g | g | h | w
1178 +---+---+---+---+---+---+---+
1183 3d) the white is a scalar and immediately blackened
1186 +---+---+---+---+---+---+---+->
1187 | b | b | h | g | g | g | w
1188 +---+---+---+---+---+---+---+
1193 3e) blacken the gray 'h' during trace_children
1195 +---+---+---+---+---+---+---+->
1196 | b | b | h | g | g | g | w
1197 +---+---+---+---+---+---+---+
1203 +---+---+---+---+---+---+---+->
1204 | b | b | h | g | g | g | w
1205 +---+---+---+---+---+---+---+
1218 =item C<static void gc_gms_setto_gray>
1220 Set the white header C<h> to gray.
1227 gc_gms_setto_gray(PARROT_INTERP
, ARGIN(Gc_gms_hdr
*h
), int priority
)
1229 Small_Object_Pool
* const pool
= h
->gen
->pool
;
1231 * TODO high_priority like in src/dod.c
1234 * if the white is adjacent to gray, move pointer
1236 if (pool
->white
== h
&& (!priority
|| pool
->white
== pool
->gray
))
1237 pool
->white
= h
->next
;
1239 Gc_gms_hdr
*next
, *prev
;
1243 if (h
== pool
->white
)
1249 /* insert at gray */
1250 next
= pool
->gray
; /* DFS */
1254 /* insert before white */
1255 next
= pool
->white
; /* BFS */
1263 /* if there wasn't any gray or black before */
1264 if (pool
->gray
== pool
->white
) {
1266 if (pool
->black
== pool
->white
) {
1271 PARROT_ASSERT(h
!= pool
->white
);
1272 /* verify all these pointer moves */
1274 gms_debug_verify(interp
, pool
, "to_gray");
1280 =item C<static void gc_gms_setto_black>
1282 Set the white header C<h> to black.
1289 gc_gms_setto_black(PARROT_INTERP
, ARGMOD(Gc_gms_hdr
*h
), int priority
)
1291 Small_Object_Pool
* const pool
= h
->gen
->pool
;
1294 * TODO high_priority like src/dod.c
1295 * TODO if h needs destructions insert in front of chain
1298 * if the white is adjacent to black, move pointer
1300 if (pool
->black
== h
) {
1301 PARROT_ASSERT(pool
->gray
== h
);
1302 PARROT_ASSERT(pool
->white
== h
);
1303 pool
->white
= h
->next
;
1304 pool
->gray
= h
->next
;
1307 Gc_gms_hdr
*next
, *prev
;
1311 if (h
== pool
->white
) {
1313 if (h
== pool
->gray
)
1319 /* insert before gray */
1326 if (pool
->black
== pool
->gray
) {
1330 PARROT_ASSERT(h
!= pool
->white
);
1331 PARROT_ASSERT(h
!= pool
->gray
);
1333 gms_debug_verify(interp
, pool
, "to_black");
1339 =item C<void parrot_gc_gms_pobject_lives>
1341 Set the object live - called by the pobject_lives macro
1349 parrot_gc_gms_pobject_lives(PARROT_INTERP
, ARGMOD(PObj
*obj
))
1355 priority
= PObj_needs_early_DOD_TEST(obj
);
1357 ++interp
->arena_base
->num_early_PMCs_seen
;
1358 h
= PObj_to_GMSH(obj
);
1359 /* unsnap it from white, put it into gray or black */
1360 if (PObj_is_PMC_TEST(obj
) && ((PMC
*)obj
)->pmc_ext
)
1361 gc_gms_setto_gray(interp
, h
, priority
);
1363 gc_gms_setto_black(interp
, h
, priority
);
1368 =item C<static int init_mark_cb>
1370 RT #48260: Not yet documented!!!
1377 init_mark_cb(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
), int flag
, ARGIN(void *arg
))
1379 pool
->gray
= pool
->black
= pool
->black_fin
= pool
->white
;
1381 gms_debug_verify(interp
, pool
, "init_mark");
1388 =item C<static void gc_gms_init_mark>
1390 Initialize the mark phase of GC.
1397 gc_gms_init_mark(PARROT_INTERP
)
1399 Arenas
* const arena_base
= interp
->arena_base
;
1401 arena_base
->dod_trace_ptr
= NULL
;
1402 arena_base
->dod_mark_start
= NULL
;
1403 arena_base
->num_early_PMCs_seen
= 0;
1404 arena_base
->num_extended_PMCs
= 0;
1406 Parrot_forall_header_pools(interp
, POOL_ALL
, 0, init_mark_cb
);
1411 =item C<static int trace_igp_cb>
1413 RT #48260: Not yet documented!!!
1420 trace_igp_cb(PARROT_INTERP
, ARGIN(Small_Object_Pool
*pool
), int flag
, SHIM(void *arg
))
1422 Gc_gms_hdr_store
*s
;
1423 Gc_gms_gen
* const gen
= pool
->last_gen
;
1424 Gc_gms_hdr_list
* const igp
= &gen
->igp
;
1426 for (s
= igp
->first
; s
; s
= s
->next
) {
1427 const Gc_gms_hdr
**p
;
1428 for (p
= s
->store
; p
< s
->ptr
; ++p
) {
1429 Gc_gms_hdr
* const h
= *p
;
1430 pobject_lives(interp
, GMSH_to_PObj(h
));
1438 =item C<static int gc_gms_trace_root>
1440 Trace the root set. If C<trace_stack> is true, trace system areas.
1447 gc_gms_trace_root(PARROT_INTERP
, int trace_stack
)
1449 const int ret
= Parrot_dod_trace_root(interp
, trace_stack
);
1453 Parrot_forall_header_pools(interp
, POOL_ALL
, 0, trace_igp_cb
);
1459 =item C<static int trace_children_cb>
1461 RT #48260: Not yet documented!!!
1468 trace_children_cb(PARROT_INTERP
, ARGIN(Small_Object_Pool
*pool
), int flag
, SHIM(void *arg
))
1470 Arenas
* const arena_base
= interp
->arena_base
;
1471 const int lazy_dod
= arena_base
->lazy_dod
;
1472 const UINTVAL mask
= PObj_data_is_PMC_array_FLAG
| PObj_custom_mark_FLAG
;
1475 for (h
= pool
->gray
; h
!= pool
->white
;) {
1476 PMC
* const current
= (PMC
*)GMSH_to_PObj(h
);
1479 if (lazy_dod
&& arena_base
->num_early_PMCs_seen
>=
1480 arena_base
->num_early_DOD_PMCs
) {
1483 /* TODO propagate flag in pobject_lives */
1484 arena_base
->dod_trace_ptr
= current
;
1485 if (!PObj_needs_early_DOD_TEST(current
))
1486 PObj_high_priority_DOD_CLEAR(current
);
1488 bits
= PObj_get_FLAGS(current
) & mask
;
1490 if (bits
== PObj_data_is_PMC_array_FLAG
) {
1491 /* malloced array of PMCs */
1492 PMC
** const data
= PMC_data(current
);
1496 for (i
= 0; i
< PMC_int_val(current
); i
++) {
1498 pobject_lives(interp
, (PObj
*)data
[i
]);
1504 /* All that's left is the custom */
1505 VTABLE_mark(interp
, current
);
1508 if (h
!= pool
->gray
) {
1509 /* if a gray was inserted DFS, it is next */
1522 =item C<static int gc_gms_trace_children>
1524 Traverse gray objects: mark and blacken. Returns 0 if the trace was aborted
1532 gc_gms_trace_children(PARROT_INTERP
)
1534 return !Parrot_forall_header_pools(interp
, POOL_PMC
, 0,
1540 =item C<static int sweep_cb_pmc>
1542 move everything from white up to the free_list to the free_list
1543 scan for active destroy objects
1544 TODO put these in front of the pool at pool->white_fin
1551 sweep_cb_pmc(PARROT_INTERP
, ARGIN(Small_Object_Pool
*pool
), int flag
, SHIM(void *arg
))
1554 Arenas
* const arena_base
= interp
->arena_base
;
1556 /* TODO object stats */
1558 for (h
= pool
->white
; h
!= pool
->free_list
; h
= h
->next
) {
1559 PMC
* const obj
= (PMC
*)GMSH_to_PObj(h
);
1560 if (PObj_needs_early_DOD_TEST(obj
))
1561 --arena_base
->num_early_DOD_PMCs
;
1562 if (PObj_active_destroy_TEST(obj
))
1563 VTABLE_destroy(interp
, (PMC
*)obj
);
1564 if (PObj_is_PMC_EXT_TEST(obj
) && obj
->pmc_ext
) {
1565 /* if the PMC has a PMC_EXT structure,
1566 * return it to the pool
1568 Small_Object_Pool
* const ext_pool
= arena_base
->pmc_ext_pool
;
1569 ext_pool
->add_free_object(interp
, ext_pool
, obj
->pmc_ext
);
1573 pool
->free_list
= pool
->white
;
1579 =item C<static int sweep_cb_buf>
1581 RT #48260: Not yet documented!!!
1588 sweep_cb_buf(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
), int flag
, SHIM(void *arg
))
1592 /* TODO object stats */
1594 for (h
= pool
->white
; h
!= pool
->free_list
; h
= h
->next
) {
1595 PObj
* const obj
= GMSH_to_PObj(h
);
1597 * this is ugly, we still have to sweep all buffers
1599 if (PObj_sysmem_TEST(obj
) && PObj_bufstart(obj
)) {
1600 /* has sysmem allocated, e.g. string_pin */
1601 mem_sys_free(PObj_bufstart(obj
));
1602 PObj_bufstart(obj
) = NULL
;
1603 PObj_buflen(obj
) = 0;
1606 # ifdef GC_IS_MALLOC
1607 /* free allocated space at (int*)bufstart - 1,
1608 * but not if it is used COW or external
1610 if (PObj_bufstart(obj
) &&
1611 !PObj_is_external_or_free_TESTALL(obj
)) {
1612 if (PObj_COW_TEST(obj
)) {
1613 INTVAL
*refcount
= PObj_bufrefcountptr(obj
);
1616 free(refcount
); /* the actual bufstart */
1619 free(PObj_bufrefcountptr(obj
));
1623 * XXX Jarkko did report that on irix pool->mem_pool
1624 * was NULL, which really shouldn't happen
1626 if (pool
->mem_pool
) {
1627 if (!PObj_COW_TEST(obj
)) {
1629 pool
->mem_pool
)->guaranteed_reclaimable
+=
1633 pool
->mem_pool
)->possibly_reclaimable
+=
1637 PObj_buflen(obj
) = 0;
1640 pool
->free_list
= pool
->white
;
1646 =item C<static void gc_gms_sweep>
1648 Free unused resources, put white objects onto free_list.
1655 gc_gms_sweep(PARROT_INTERP
)
1657 Parrot_forall_header_pools(interp
, POOL_PMC
, 0, sweep_cb_pmc
);
1658 Parrot_forall_header_pools(interp
, POOL_BUFFER
, 0, sweep_cb_buf
);
1663 =item C<static int end_cycle_cb>
1665 RT #48260: Not yet documented!!!
1672 end_cycle_cb(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
), int flag
, SHIM(void *arg
))
1677 * TODO just swap black and white
1679 if (!pool
->black
|| pool
->black
== &pool
->marker
)
1681 for (h
= pool
->black
; h
!= pool
->white
; h
= h
->next
)
1682 PObj_live_CLEAR(GMSH_to_PObj(h
));
1683 pool
->black
= pool
->black_fin
= pool
->gray
= pool
->white
;
1689 =item C<static void gc_gms_end_cycle>
1691 RT #48260: Not yet documented!!!
1698 gc_gms_end_cycle(PARROT_INTERP
)
1700 Parrot_forall_header_pools(interp
, POOL_ALL
, 0, end_cycle_cb
);
1707 =head2 Interface function main entry
1711 =item C<static void parrot_gc_gms_run>
1713 Interface to C<Parrot_do_dod_run>. C<flags> is one of:
1715 GC_lazy_FLAG ... timely destruction
1716 GC_finish_FLAG ... run a final sweep to destruct objects at
1717 interpreter shutdown
1724 parrot_gc_gms_run(PARROT_INTERP
, int flags
)
1726 Arenas
* const arena_base
= interp
->arena_base
;
1727 Gc_gms_private
*g_gms
;
1729 if (arena_base
->DOD_block_level
) {
1732 ++arena_base
->DOD_block_level
;
1733 g_gms
= arena_base
->gc_private
;
1734 if (flags
& GC_finish_FLAG
) {
1735 Small_Object_Pool
* const pool
= arena_base
->pmc_pool
;
1737 pool
->white
= pool
->marker
.next
;
1738 /* XXX need to sweep over objects that have finalizers only */
1739 Parrot_forall_header_pools(interp
, POOL_PMC
, 0, sweep_cb_pmc
);
1740 gc_gms_end_cycle(interp
);
1741 --arena_base
->DOD_block_level
;
1745 /* normal or lazy DOD run */
1746 arena_base
->dod_runs
++;
1747 arena_base
->lazy_dod
= (flags
& GC_lazy_FLAG
);
1748 gc_gms_init_mark(interp
);
1749 if (gc_gms_trace_root(interp
, !arena_base
->lazy_dod
) &&
1750 gc_gms_trace_children(interp
)) {
1751 gc_gms_sweep(interp
);
1752 gc_gms_set_gen(interp
);
1756 * successful lazy DOD run
1758 ++arena_base
->lazy_dod_runs
;
1760 gc_gms_end_cycle(interp
);
1761 --arena_base
->DOD_block_level
;
1766 =item C<static void gms_debug_verify>
1768 RT #48260: Not yet documented!!!
1776 gms_debug_verify(PARROT_INTERP
, ARGMOD(Small_Object_Pool
*pool
), ARGIN(const char *action
))
1782 const size_t n
= pool
->total_objects
;
1784 bf
= gf
= wf
= ff
= 0;
1787 for (i
= 0, h
= &pool
->marker
; i
<= n
+ 10; ++i
) {
1788 if (i
&& h
== &pool
->marker
)
1790 if (h
== pool
->black
)
1792 if (h
== pool
->gray
)
1794 if (h
== pool
->white
)
1796 if (h
== pool
->free_list
)
1801 fprintf(stderr
, "gms_verify %s: chain corrupt %u objs %u total\n",
1804 fprintf(stderr
, "gms_verify %s: found %u blacks\n", action
, bf
);
1806 fprintf(stderr
, "gms_verify %s: found %u grays\n", action
, gf
);
1808 fprintf(stderr
, "gms_verify %s: found %u whites\n", action
, wf
);
1810 fprintf(stderr
, "gms_verify %s: found %u frees\n", action
, ff
);
1814 # endif /* GC_GMS_DEBUG */
1816 #endif /* PARROT_GC_GMS */
1824 F<src/gc/dod.c>, F<include/parrot/dod.h>, F<include/parrot/pobj.h>,
1829 Initial version by leo (2005.01.12 - 2005.01.30)
1838 * c-file-style: "parrot"
1840 * vim: expandtab shiftwidth=4: