[svn:parrot] r38646 - branches/gc_api/src/gc
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Sat May 9 15:24:50 UTC 2009
Author: whiteknight
Date: Sat May 9 15:24:50 2009
New Revision: 38646
URL: https://trac.parrot.org/parrot/changeset/38646
Log:
[gc_api] rearrange some things so they're in a reasonable order
Modified:
branches/gc_api/src/gc/api.c
Modified: branches/gc_api/src/gc/api.c
==============================================================================
--- branches/gc_api/src/gc/api.c Sat May 9 15:05:32 2009 (r38645)
+++ branches/gc_api/src/gc/api.c Sat May 9 15:24:50 2009 (r38646)
@@ -43,11 +43,6 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*dest_interp);
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static PMC_EXT * new_pmc_ext(PARROT_INTERP)
- __attribute__nonnull__(1);
-
static int sweep_cb_buf(PARROT_INTERP,
ARGMOD(Small_Object_Pool *pool),
SHIM(int flag),
@@ -70,8 +65,6 @@
#define ASSERT_ARGS_fix_pmc_syncs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(dest_interp) \
|| PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_new_pmc_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_sweep_cb_buf __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool) \
@@ -95,6 +88,8 @@
are marked alive. Implementation is generally dependant on the particular
garbage collector in use.
+Previously known as C<pobject_lives>.
+
=cut
*/
@@ -104,6 +99,9 @@
Parrot_gc_mark_PObj_alive(PARROT_INTERP, ARGMOD(PObj *obj))
{
ASSERT_ARGS(Parrot_gc_mark_PObj_alive)
+ /* TODO: Have each core register a ->pobject_lives function pointer in the
+ Arenas struct, and call that pointer directly instead of having a messy
+ set of #if preparser conditions. */
#if PARROT_GC_GMS
do {
if (!PObj_live_TEST(obj) && \
@@ -150,7 +148,6 @@
#endif /* PARROT_GC_GMS */
}
-
/*
=item C<void Parrot_gc_initialize(PARROT_INTERP, void *stacktop)>
@@ -189,6 +186,24 @@
Parrot_initialize_header_pools(interp);
}
+/*
+
+=item C<void Parrot_gc_finalize(PARROT_INTERP)>
+
+Finalize the GC system, if the current GC core has defined a finalization
+routine.
+
+=cut
+
+*/
+
+void
+Parrot_gc_finalize(PARROT_INTERP)
+{
+ if (interp->arena_base->finalize_gc_system)
+ interp->arena_base->finalize_gc_system(interp);
+}
+
/*
@@ -219,8 +234,9 @@
/* clear flags, set is_PMC_FLAG */
if (flags & PObj_is_PMC_EXT_FLAG) {
+ Small_Object_Pool * const pool = interp->arena_base->pmc_ext_pool;
flags |= PObj_is_special_PMC_FLAG;
- pmc->pmc_ext = new_pmc_ext(interp);
+ pmc->pmc_ext = (PMC_EXT *)pool->get_free_object(interp, pool);
if (flags & PObj_is_PMC_shared_FLAG)
Parrot_gc_add_pmc_sync(interp, pmc);
@@ -265,49 +281,6 @@
/*
-=item C<void Parrot_gc_free_string_header(PARROT_INTERP, STRING *s)>
-
-Adds the given STRING to the free list for later reuse.
-
-=cut
-
-*/
-
-void
-Parrot_gc_free_string_header(PARROT_INTERP, ARGMOD(STRING *s))
-{
- ASSERT_ARGS(Parrot_gc_free_string_header);
- if (!PObj_constant_TEST(s)) {
- Small_Object_Pool * const pool = interp->arena_base->string_header_pool;
- pool->add_free_object(interp, pool, s);
- }
-}
-
-/*
-
-=item C<static PMC_EXT * new_pmc_ext(PARROT_INTERP)>
-
-Gets a new free C<PMC_EXT> structure from the PMC_EXT pool. A pointer to the
-new PMC_EXT is returned. Does not check to ensure the PMC_EXT is non-null
-before it is returned (yet).
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static PMC_EXT *
-new_pmc_ext(PARROT_INTERP)
-{
- ASSERT_ARGS(new_pmc_ext)
- Small_Object_Pool * const pool = interp->arena_base->pmc_ext_pool;
- return (PMC_EXT *)pool->get_free_object(interp, pool);
-}
-
-
-/*
-
=item C<void Parrot_gc_add_pmc_ext(PARROT_INTERP, PMC *pmc)>
Obtains a new C<PMC_EXT> structure, and attaches it to the given C<PMC>.
@@ -322,7 +295,8 @@
Parrot_gc_add_pmc_ext(PARROT_INTERP, ARGMOD(PMC *pmc))
{
ASSERT_ARGS(Parrot_gc_add_pmc_ext)
- pmc->pmc_ext = new_pmc_ext(interp);
+ Small_Object_Pool * const pool = interp->arena_base->pmc_ext_pool;
+ pmc->pmc_ext = (PMC_EXT *)pool->get_free_object(interp, pool);
if(!pmc->pmc_ext)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: PMC_EXT allocation failed!\n");
@@ -341,6 +315,37 @@
PMC_next_for_GC(pmc) = PMCNULL;
}
+/*
+
+=item C<void Parrot_gc_free_pmc_ext(PARROT_INTERP, PMC *p)>
+
+Frees the C<PMC_EXT> structure attached to a PMC, if it exists.
+
+=cut
+
+*/
+
+void
+Parrot_gc_free_pmc_ext(PARROT_INTERP, ARGMOD(PMC *p))
+{
+ ASSERT_ARGS(Parrot_gc_free_pmc_ext)
+ /* if the PMC has a PMC_EXT structure, return it to the pool/arena */
+ Arenas * const arena_base = interp->arena_base;
+ Small_Object_Pool * const ext_pool = arena_base->pmc_ext_pool;
+
+ if (PObj_is_PMC_shared_TEST(p) && PMC_sync(p)) {
+ MUTEX_DESTROY(PMC_sync(p)->pmc_lock);
+ mem_internal_free(PMC_sync(p));
+ PMC_sync(p) = NULL;
+ }
+
+ if (p->pmc_ext)
+ ext_pool->add_free_object(interp, ext_pool, p->pmc_ext);
+
+ ext_pool->num_free_objects++;
+
+ p->pmc_ext = NULL;
+}
/*
@@ -360,9 +365,6 @@
ASSERT_ARGS(Parrot_gc_add_pmc_sync)
if (!PObj_is_PMC_EXT_TEST(pmc))
Parrot_gc_add_pmc_ext(interp, pmc);
- /* Would like to be able to do this, instead of allocating directly from
- the OS. Causes a segfault that hasn't been figured out yet. */
- /* PMC_sync(pmc) = (Sync *)Parrot_gc_new_bufferlike_header(interp, sizeof(Sync)); */
PMC_sync(pmc) = mem_allocate_typed(Sync);
if(!PMC_sync(pmc))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ALLOCATION_ERROR,
@@ -372,7 +374,6 @@
MUTEX_INIT(PMC_sync(pmc)->pmc_lock);
}
-
/*
=item C<STRING * Parrot_gc_new_string_header(PARROT_INTERP, UINTVAL flags)>
@@ -407,6 +408,25 @@
return string;
}
+/*
+
+=item C<void Parrot_gc_free_string_header(PARROT_INTERP, STRING *s)>
+
+Adds the given STRING to the free list for later reuse.
+
+=cut
+
+*/
+
+void
+Parrot_gc_free_string_header(PARROT_INTERP, ARGMOD(STRING *s))
+{
+ ASSERT_ARGS(Parrot_gc_free_string_header);
+ if (!PObj_constant_TEST(s)) {
+ Small_Object_Pool * const pool = interp->arena_base->string_header_pool;
+ pool->add_free_object(interp, pool, s);
+ }
+}
/*
@@ -449,532 +469,470 @@
Parrot_gc_free_bufferlike_header(PARROT_INTERP, ARGMOD(PObj *obj),
size_t size)
{
+ ASSERT_ARGS(Parrot_gc_free_bufferlike_header);
Small_Object_Pool * const pool = get_bufferlike_pool(interp, size);
pool->add_free_object(interp, pool, obj);
}
/*
-=item C<void Parrot_gc_free_pmc_ext(PARROT_INTERP, PMC *p)>
+=item C<void Parrot_gc_allocate_buffer_storage_aligned(PARROT_INTERP, Buffer
+*buffer, size_t size)>
-Frees the C<PMC_EXT> structure attached to a PMC, if it exists.
+Allocates a chunk of memory of at least size C<size> for the given Buffer.
+buffer is guaranteed to be properly aligned for things like C<FLOATVALS>,
+so the size may be rounded up or down to guarantee that this alignment holds.
=cut
*/
void
-Parrot_gc_free_pmc_ext(PARROT_INTERP, ARGMOD(PMC *p))
+Parrot_gc_allocate_buffer_storage_aligned(PARROT_INTERP,
+ ARGOUT(Buffer *buffer), size_t size)
{
- ASSERT_ARGS(Parrot_gc_free_pmc_ext)
- /* if the PMC has a PMC_EXT structure, return it to the pool/arena */
- Arenas * const arena_base = interp->arena_base;
- Small_Object_Pool * const ext_pool = arena_base->pmc_ext_pool;
-
- if (PObj_is_PMC_shared_TEST(p) && PMC_sync(p)) {
- /* Small_Object_Pool * pool = get_bufferlike_pool(interp, sizeof(Sync)); */
- MUTEX_DESTROY(PMC_sync(p)->pmc_lock);
- mem_internal_free(PMC_sync(p));
- /* pool->add_free_object(interp, pool, PMC_sync(p)); */
- PMC_sync(p) = NULL;
- }
-
- if (p->pmc_ext)
- ext_pool->add_free_object(interp, ext_pool, p->pmc_ext);
-
- ext_pool->num_free_objects++;
+ ASSERT_ARGS(Parrot_gc_allocate_buffer_storage_aligned)
+ size_t new_size;
+ char *mem;
- p->pmc_ext = NULL;
+ PObj_buflen(buffer) = 0;
+ PObj_bufstart(buffer) = NULL;
+ new_size = aligned_size(buffer, size);
+ mem = (char *)mem_allocate(interp, new_size,
+ interp->arena_base->memory_pool);
+ mem = aligned_mem(buffer, mem);
+ PObj_bufstart(buffer) = mem;
+ if (PObj_is_COWable_TEST(buffer))
+ new_size -= sizeof (void*);
+ PObj_buflen(buffer) = new_size;
}
/*
-=item C<void Parrot_gc_mark_and_sweep(PARROT_INTERP, UINTVAL flags)>
+=item C<void Parrot_gc_reallocate_buffer_storage(PARROT_INTERP, Buffer *buffer,
+size_t newsize)>
-Calls the configured garbage collector to find and reclaim unused
-headers. Performs a complete mark & sweep run of the GC.
+Reallocate the Buffer's buffer memory to the given size. The
+allocated buffer will not shrink. If the buffer was allocated with
+L<Parrot_allocate_aligned> the new buffer will also be aligned. As with
+all reallocation, the new buffer might have moved and the additional
+memory is not cleared.
=cut
*/
void
-Parrot_gc_mark_and_sweep(PARROT_INTERP, UINTVAL flags)
+Parrot_gc_reallocate_buffer_storage(PARROT_INTERP, ARGMOD(Buffer *buffer),
+ size_t newsize)
{
- ASSERT_ARGS(Parrot_gc_mark_and_sweep)
- interp->arena_base->do_gc_mark(interp, flags);
- parrot_gc_context(interp);
-}
-
-/*
-
-=item C<void Parrot_gc_merge_header_pools(Interp *dest_interp, Interp
-*source_interp)>
-
-Merges the header pools of C<source_interp> into those of C<dest_interp>.
-(Used to deal with shared objects left after interpreter destruction.)
-
-=cut
+ ASSERT_ARGS(Parrot_gc_reallocate_buffer_storage)
+ size_t copysize;
+ char *mem;
+ Memory_Pool * const pool = interp->arena_base->memory_pool;
+ size_t new_size, needed, old_size;
-*/
+ /*
+ * we don't shrink buffers
+ */
+ if (newsize <= PObj_buflen(buffer))
+ return;
-void
-Parrot_gc_merge_header_pools(ARGMOD(Interp *dest_interp),
- ARGIN(Interp *source_interp))
-{
- ASSERT_ARGS(Parrot_gc_merge_header_pools)
+ /*
+ * same as below but barely used and tested - only 3 list related
+ * tests do use true reallocation
+ *
+ * list.c, which does _reallocate, has 2 reallocations
+ * normally, which play ping pong with buffers.
+ * The normal case is therefore always to allocate a new block
+ */
+ new_size = aligned_size(buffer, newsize);
+ old_size = aligned_size(buffer, PObj_buflen(buffer));
+ needed = new_size - old_size;
- Arenas * const dest_arena = dest_interp->arena_base;
- Arenas * const source_arena = source_interp->arena_base;
- UINTVAL i;
+ if ((pool->top_block->free >= needed)
+ && (pool->top_block->top == (char *)PObj_bufstart(buffer) + old_size)) {
+ pool->top_block->free -= needed;
+ pool->top_block->top += needed;
+ PObj_buflen(buffer) = newsize;
+ return;
+ }
- /* heavily borrowed from forall_header_pools */
- fix_pmc_syncs(dest_interp, source_arena->constant_pmc_pool);
- Parrot_small_object_pool_merge(dest_interp, dest_arena->constant_pmc_pool,
- source_arena->constant_pmc_pool);
+ copysize = PObj_buflen(buffer);
- fix_pmc_syncs(dest_interp, source_arena->pmc_pool);
- Parrot_small_object_pool_merge(dest_interp, dest_arena->pmc_pool,
- source_arena->pmc_pool);
+ if (!PObj_COW_TEST(buffer))
+ pool->guaranteed_reclaimable += copysize;
- Parrot_small_object_pool_merge(dest_interp,
- dest_arena->constant_string_header_pool,
- source_arena->constant_string_header_pool);
+ pool->possibly_reclaimable += copysize;
+ mem = (char *)mem_allocate(interp, new_size, pool);
+ mem = aligned_mem(buffer, mem);
- Parrot_small_object_pool_merge(dest_interp,
- dest_arena->pmc_ext_pool, source_arena->pmc_ext_pool);
+ /* We shouldn't ever have a 0 from size, but we do. If we can track down
+ * those bugs, this can be removed which would make things cheaper */
+ if (copysize)
+ memcpy(mem, PObj_bufstart(buffer), copysize);
- for (i = 0; i < source_arena->num_sized; ++i) {
- if (!source_arena->sized_header_pools[i])
- continue;
+ PObj_bufstart(buffer) = mem;
- if (i >= dest_arena->num_sized
- || !dest_arena->sized_header_pools[i]) {
- Small_Object_Pool *ignored = get_bufferlike_pool(dest_interp,
- i * sizeof (void *));
- UNUSED(ignored);
- PARROT_ASSERT(dest_arena->sized_header_pools[i]);
- }
+ if (PObj_is_COWable_TEST(buffer))
+ new_size -= sizeof (void *);
- Parrot_small_object_pool_merge(dest_interp,
- dest_arena->sized_header_pools[i],
- source_arena->sized_header_pools[i]);
- }
+ PObj_buflen(buffer) = new_size;
}
/*
-=item C<static void fix_pmc_syncs(Interp *dest_interp, Small_Object_Pool *pool)>
+=item C<void Parrot_gc_allocate_string_storage(PARROT_INTERP, STRING *str,
+size_t size)>
-Walks through the given arena, looking for all live and shared PMCs,
-transferring their sync values to the destination interpreter.
+Allocate the STRING's buffer memory to the given size. The allocated
+buffer maybe slightly bigger than the given C<size>. This function
+sets also C<< str->strstart >> to the new buffer location, C<< str->bufused >>
+is B<not> changed.
=cut
*/
-static void
-fix_pmc_syncs(ARGMOD(Interp *dest_interp), ARGIN(Small_Object_Pool *pool))
+void
+Parrot_gc_allocate_string_storage(PARROT_INTERP, ARGOUT(STRING *str),
+ size_t size)
{
- ASSERT_ARGS(fix_pmc_syncs)
- Small_Object_Arena *cur_arena;
- const UINTVAL object_size = pool->object_size;
+ ASSERT_ARGS(Parrot_gc_allocate_string_storage)
+ size_t new_size;
+ Memory_Pool *pool;
+ char *mem;
- for (cur_arena = pool->last_Arena; cur_arena; cur_arena = cur_arena->prev) {
- PMC *p = (PMC *)((char*)cur_arena->start_objects + GC_HEADER_SIZE);
- size_t i;
+ PObj_buflen(str) = 0;
+ PObj_bufstart(str) = NULL;
- for (i = 0; i < cur_arena->used; i++) {
- if (!PObj_on_free_list_TEST(p) && PObj_is_PMC_TEST(p)) {
- if (PObj_is_PMC_shared_TEST(p))
- PMC_sync(p)->owner = dest_interp;
- else
- Parrot_ex_throw_from_c_args(dest_interp, NULL,
- EXCEPTION_INTERP_ERROR,
- "Unshared PMC still alive after interpreter"
- "destruction. address=%p, base_type=%d\n",
- p, p->vtable->base_type);
- }
+ /* there's no sense in allocating zero memory, when the overhead of
+ * allocating a string is one pointer; this can fill the pools in an
+ * uncompactable way. See RT #42320.
+ */
+ if (size == 0)
+ return;
- p = (PMC *)((char *)p + object_size);
- }
- }
+ pool = PObj_constant_TEST(str)
+ ? interp->arena_base->constant_string_pool
+ : interp->arena_base->memory_pool;
+
+ new_size = aligned_string_size(size);
+ mem = (char *)mem_allocate(interp, new_size, pool);
+ mem += sizeof (void*);
+
+ PObj_bufstart(str) = str->strstart = mem;
+ PObj_buflen(str) = new_size - sizeof (void*);
}
/*
-=item C<void Parrot_gc_destroy_header_pools(PARROT_INTERP)>
+=item C<void Parrot_gc_reallocate_string_storage(PARROT_INTERP, STRING *str,
+size_t newsize)>
-Performs a garbage collection sweep on all pools, then frees them. Calls
-C<Parrot_forall_header_pools> to loop over all the pools, passing
-C<sweep_cb_pmc> and C<sweep_cb_buf> callback routines. Frees the array of sized
-header pointers in the C<Arenas> structure too.
+Reallocate the STRING's buffer memory to the given size. The allocated
+buffer will not shrink. This function sets also C<str-E<gt>strstart> to the
+new buffer location, C<str-E<gt>bufused> is B<not> changed.
=cut
*/
void
-Parrot_gc_destroy_header_pools(PARROT_INTERP)
+Parrot_gc_reallocate_string_storage(PARROT_INTERP, ARGMOD(STRING *str),
+ size_t newsize)
{
- ASSERT_ARGS(Parrot_gc_destroy_header_pools)
- INTVAL pass;
+ ASSERT_ARGS(Parrot_gc_reallocate_string_storage)
+ size_t copysize;
+ char *mem, *oldmem;
+ size_t new_size, needed, old_size;
- /* const/non const COW strings life in different pools
- * so in first pass
- * COW refcount is done, in 2. refcounting
- * in 3rd freeing
- */
-#ifdef GC_IS_MALLOC
- const INTVAL start = 0;
-#else
- const INTVAL start = 2;
-#endif
+ Memory_Pool * const pool =
+ PObj_constant_TEST(str)
+ ? interp->arena_base->constant_string_pool
+ : interp->arena_base->memory_pool;
- Parrot_forall_header_pools(interp, POOL_PMC, NULL, sweep_cb_pmc);
- Parrot_forall_header_pools(interp, POOL_PMC | POOL_CONST, NULL,
- sweep_cb_pmc);
+ /* if the requested size is smaller then buflen, we are done */
+ if (newsize <= PObj_buflen(str))
+ return;
- for (pass = start; pass <= 2; pass++) {
- Parrot_forall_header_pools(interp, POOL_BUFFER | POOL_CONST,
- (void *)pass, sweep_cb_buf);
- }
+ /*
+ * first check, if we can reallocate:
+ * - if the passed strings buffer is the last string in the pool and
+ * - if there is enough size, we can just move the pool's top pointer
+ */
+ new_size = aligned_string_size(newsize);
+ old_size = aligned_string_size(PObj_buflen(str));
+ needed = new_size - old_size;
- free_pool(interp->arena_base->pmc_ext_pool);
- interp->arena_base->pmc_ext_pool = NULL;
+ if (pool->top_block->free >= needed
+ && pool->top_block->top == (char *)PObj_bufstart(str) + old_size) {
+ pool->top_block->free -= needed;
+ pool->top_block->top += needed;
+ PObj_buflen(str) = new_size - sizeof (void*);
+ return;
+ }
- mem_internal_free(interp->arena_base->sized_header_pools);
- interp->arena_base->sized_header_pools = NULL;
-}
+ PARROT_ASSERT(str->bufused <= newsize);
-/*
+ /* only copy used memory, not total string buffer */
+ copysize = str->bufused;
-=item C<static int sweep_cb_pmc(PARROT_INTERP, Small_Object_Pool *pool, int
-flag, void *arg)>
+ if (!PObj_COW_TEST(str))
+ pool->guaranteed_reclaimable += PObj_buflen(str);
-Performs a garbage collection sweep of the given pmc pool, then frees it. Calls
-C<Parrot_gc_sweep> to perform the sweep, and C<free_pool> to free the pool and
-all its arenas. Always returns C<0>.
+ pool->possibly_reclaimable += PObj_buflen(str);
-=cut
+ mem = (char *)mem_allocate(interp, new_size, pool);
+ mem += sizeof (void *);
-*/
+ /* copy mem from strstart, *not* bufstart */
+ oldmem = str->strstart;
+ PObj_bufstart(str) = (void *)mem;
+ str->strstart = mem;
+ PObj_buflen(str) = new_size - sizeof (void*);
-static int
-sweep_cb_pmc(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool),
- SHIM(int flag), SHIM(void *arg))
-{
- Parrot_gc_sweep(interp, pool);
- free_pool(pool);
- return 0;
+ /* We shouldn't ever have a 0 from size, but we do. If we can track down
+ * those bugs, this can be removed which would make things cheaper */
+ if (copysize)
+ memcpy(mem, oldmem, copysize);
}
/*
-=item C<static int sweep_cb_buf(PARROT_INTERP, Small_Object_Pool *pool, int
-flag, void *arg)>
+=item C<void Parrot_gc_mark_and_sweep(PARROT_INTERP, UINTVAL flags)>
-Performs a final garbage collection sweep, then frees the pool. Calls
-C<Parrot_gc_sweep> to perform the sweep, and C<free_pool> to free the pool and
-all its arenas.
+Calls the configured garbage collector to find and reclaim unused
+headers. Performs a complete mark & sweep run of the GC.
=cut
*/
-static int
-sweep_cb_buf(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool), SHIM(int flag),
- ARGIN(void *arg))
+void
+Parrot_gc_mark_and_sweep(PARROT_INTERP, UINTVAL flags)
{
-#ifdef GC_IS_MALLOC
- const int pass = (int)(INTVAL)arg;
-
- if (pass == 0)
- clear_cow(interp, pool, 1);
- else if (pass == 1)
- used_cow(interp, pool, 1);
- else
-#endif
-
- {
- UNUSED(arg);
- Parrot_gc_sweep(interp, pool);
- free_pool(pool);
- }
-
- return 0;
+ ASSERT_ARGS(Parrot_gc_mark_and_sweep)
+ interp->arena_base->do_gc_mark(interp, flags);
+ parrot_gc_context(interp);
}
/*
-=item C<void Parrot_gc_allocate_buffer_storage_aligned(PARROT_INTERP, Buffer
-*buffer, size_t size)>
+=item C<void Parrot_gc_compact_memory_pool(PARROT_INTERP)>
-Allocates a chunk of memory of at least size C<size> for the given Buffer.
-buffer is guaranteed to be properly aligned for things like C<FLOATVALS>,
-so the size may be rounded up or down to guarantee that this alignment holds.
+Scan the string pools and compact them. This does not perform a GC mark or
+sweep run, and does not check whether string buffers are still alive.
+Redirects to C<compact_pool>.
=cut
*/
void
-Parrot_gc_allocate_buffer_storage_aligned(PARROT_INTERP,
- ARGOUT(Buffer *buffer), size_t size)
+Parrot_gc_compact_memory_pool(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_gc_allocate_buffer_storage_aligned)
- size_t new_size;
- char *mem;
-
- PObj_buflen(buffer) = 0;
- PObj_bufstart(buffer) = NULL;
- new_size = aligned_size(buffer, size);
- mem = (char *)mem_allocate(interp, new_size,
- interp->arena_base->memory_pool);
- mem = aligned_mem(buffer, mem);
- PObj_bufstart(buffer) = mem;
- if (PObj_is_COWable_TEST(buffer))
- new_size -= sizeof (void*);
- PObj_buflen(buffer) = new_size;
+ ASSERT_ARGS(Parrot_gc_compact_memory_pool)
+ compact_pool(interp, interp->arena_base->memory_pool);
}
/*
-=item C<void Parrot_gc_allocate_string_storage(PARROT_INTERP, STRING *str,
-size_t size)>
+=item C<void Parrot_gc_merge_header_pools(Interp *dest_interp, Interp
+*source_interp)>
-Allocate the STRING's buffer memory to the given size. The allocated
-buffer maybe slightly bigger than the given C<size>. This function
-sets also C<< str->strstart >> to the new buffer location, C<< str->bufused >>
-is B<not> changed.
+Merges the header pools of C<source_interp> into those of C<dest_interp>.
+(Used to deal with shared objects left after interpreter destruction.)
=cut
*/
void
-Parrot_gc_allocate_string_storage(PARROT_INTERP, ARGOUT(STRING *str),
- size_t size)
+Parrot_gc_merge_header_pools(ARGMOD(Interp *dest_interp),
+ ARGIN(Interp *source_interp))
{
- ASSERT_ARGS(Parrot_gc_allocate_string_storage)
- size_t new_size;
- Memory_Pool *pool;
- char *mem;
+ ASSERT_ARGS(Parrot_gc_merge_header_pools)
- PObj_buflen(str) = 0;
- PObj_bufstart(str) = NULL;
+ Arenas * const dest_arena = dest_interp->arena_base;
+ Arenas * const source_arena = source_interp->arena_base;
+ UINTVAL i;
- /* there's no sense in allocating zero memory, when the overhead of
- * allocating a string is one pointer; this can fill the pools in an
- * uncompactable way. See RT #42320.
- */
- if (size == 0)
- return;
+ /* heavily borrowed from forall_header_pools */
+ fix_pmc_syncs(dest_interp, source_arena->constant_pmc_pool);
+ Parrot_small_object_pool_merge(dest_interp, dest_arena->constant_pmc_pool,
+ source_arena->constant_pmc_pool);
- pool = PObj_constant_TEST(str)
- ? interp->arena_base->constant_string_pool
- : interp->arena_base->memory_pool;
+ fix_pmc_syncs(dest_interp, source_arena->pmc_pool);
+ Parrot_small_object_pool_merge(dest_interp, dest_arena->pmc_pool,
+ source_arena->pmc_pool);
- new_size = aligned_string_size(size);
- mem = (char *)mem_allocate(interp, new_size, pool);
- mem += sizeof (void*);
+ Parrot_small_object_pool_merge(dest_interp,
+ dest_arena->constant_string_header_pool,
+ source_arena->constant_string_header_pool);
- PObj_bufstart(str) = str->strstart = mem;
- PObj_buflen(str) = new_size - sizeof (void*);
+ Parrot_small_object_pool_merge(dest_interp,
+ dest_arena->pmc_ext_pool, source_arena->pmc_ext_pool);
+
+ for (i = 0; i < source_arena->num_sized; ++i) {
+ if (!source_arena->sized_header_pools[i])
+ continue;
+
+ if (i >= dest_arena->num_sized
+ || !dest_arena->sized_header_pools[i]) {
+ Small_Object_Pool *ignored = get_bufferlike_pool(dest_interp,
+ i * sizeof (void *));
+ UNUSED(ignored);
+ PARROT_ASSERT(dest_arena->sized_header_pools[i]);
+ }
+
+ Parrot_small_object_pool_merge(dest_interp,
+ dest_arena->sized_header_pools[i],
+ source_arena->sized_header_pools[i]);
+ }
}
/*
-=item C<void Parrot_gc_reallocate_buffer_storage(PARROT_INTERP, Buffer *buffer,
-size_t newsize)>
+=item C<static void fix_pmc_syncs(Interp *dest_interp, Small_Object_Pool *pool)>
-Reallocate the Buffer's buffer memory to the given size. The
-allocated buffer will not shrink. If the buffer was allocated with
-L<Parrot_allocate_aligned> the new buffer will also be aligned. As with
-all reallocation, the new buffer might have moved and the additional
-memory is not cleared.
+Walks through the given arena, looking for all live and shared PMCs,
+transferring their sync values to the destination interpreter.
=cut
*/
-void
-Parrot_gc_reallocate_buffer_storage(PARROT_INTERP, ARGMOD(Buffer *buffer),
- size_t newsize)
+static void
+fix_pmc_syncs(ARGMOD(Interp *dest_interp), ARGIN(Small_Object_Pool *pool))
{
- ASSERT_ARGS(Parrot_gc_reallocate_buffer_storage)
- size_t copysize;
- char *mem;
- Memory_Pool * const pool = interp->arena_base->memory_pool;
- size_t new_size, needed, old_size;
+ ASSERT_ARGS(fix_pmc_syncs)
+ Small_Object_Arena *cur_arena;
+ const UINTVAL object_size = pool->object_size;
- /*
- * we don't shrink buffers
- */
- if (newsize <= PObj_buflen(buffer))
- return;
+ for (cur_arena = pool->last_Arena; cur_arena; cur_arena = cur_arena->prev) {
+ PMC *p = (PMC *)((char*)cur_arena->start_objects + GC_HEADER_SIZE);
+ size_t i;
- /*
- * same as below but barely used and tested - only 3 list related
- * tests do use true reallocation
- *
- * list.c, which does _reallocate, has 2 reallocations
- * normally, which play ping pong with buffers.
- * The normal case is therefore always to allocate a new block
- */
- new_size = aligned_size(buffer, newsize);
- old_size = aligned_size(buffer, PObj_buflen(buffer));
- needed = new_size - old_size;
+ for (i = 0; i < cur_arena->used; i++) {
+ if (!PObj_on_free_list_TEST(p) && PObj_is_PMC_TEST(p)) {
+ if (PObj_is_PMC_shared_TEST(p))
+ PMC_sync(p)->owner = dest_interp;
+ else
+ Parrot_ex_throw_from_c_args(dest_interp, NULL,
+ EXCEPTION_INTERP_ERROR,
+ "Unshared PMC still alive after interpreter"
+ "destruction. address=%p, base_type=%d\n",
+ p, p->vtable->base_type);
+ }
- if ((pool->top_block->free >= needed)
- && (pool->top_block->top == (char *)PObj_bufstart(buffer) + old_size)) {
- pool->top_block->free -= needed;
- pool->top_block->top += needed;
- PObj_buflen(buffer) = newsize;
- return;
+ p = (PMC *)((char *)p + object_size);
+ }
}
-
- copysize = PObj_buflen(buffer);
-
- if (!PObj_COW_TEST(buffer))
- pool->guaranteed_reclaimable += copysize;
-
- pool->possibly_reclaimable += copysize;
- mem = (char *)mem_allocate(interp, new_size, pool);
- mem = aligned_mem(buffer, mem);
-
- /* We shouldn't ever have a 0 from size, but we do. If we can track down
- * those bugs, this can be removed which would make things cheaper */
- if (copysize)
- memcpy(mem, PObj_bufstart(buffer), copysize);
-
- PObj_bufstart(buffer) = mem;
-
- if (PObj_is_COWable_TEST(buffer))
- new_size -= sizeof (void *);
-
- PObj_buflen(buffer) = new_size;
}
/*
-=item C<void Parrot_gc_compact_memory_pool(PARROT_INTERP)>
+=item C<void Parrot_gc_destroy_header_pools(PARROT_INTERP)>
-Scan the string pools and compact them. This does not perform a GC mark or
-sweep run, and does not check whether string buffers are still alive.
-Redirects to C<compact_pool>.
+Performs a garbage collection sweep on all pools, then frees them. Calls
+C<Parrot_forall_header_pools> to loop over all the pools, passing
+C<sweep_cb_pmc> and C<sweep_cb_buf> callback routines. Frees the array of sized
+header pointers in the C<Arenas> structure too.
=cut
*/
void
-Parrot_gc_compact_memory_pool(PARROT_INTERP)
+Parrot_gc_destroy_header_pools(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_gc_compact_memory_pool)
- compact_pool(interp, interp->arena_base->memory_pool);
+ ASSERT_ARGS(Parrot_gc_destroy_header_pools)
+ INTVAL pass;
+
+ /* const/non const COW strings life in different pools
+ * so in first pass
+ * COW refcount is done, in 2. refcounting
+ * in 3rd freeing
+ */
+#ifdef GC_IS_MALLOC
+ const INTVAL start = 0;
+#else
+ const INTVAL start = 2;
+#endif
+
+ Parrot_forall_header_pools(interp, POOL_PMC, NULL, sweep_cb_pmc);
+ Parrot_forall_header_pools(interp, POOL_PMC | POOL_CONST, NULL,
+ sweep_cb_pmc);
+
+ for (pass = start; pass <= 2; pass++) {
+ Parrot_forall_header_pools(interp, POOL_BUFFER | POOL_CONST,
+ (void *)pass, sweep_cb_buf);
+ }
+
+ free_pool(interp->arena_base->pmc_ext_pool);
+ interp->arena_base->pmc_ext_pool = NULL;
+
+ mem_internal_free(interp->arena_base->sized_header_pools);
+ interp->arena_base->sized_header_pools = NULL;
}
/*
-=item C<int Parrot_gc_ptr_in_memory_pool(PARROT_INTERP, void *bufstart)>
+=item C<static int sweep_cb_pmc(PARROT_INTERP, Small_Object_Pool *pool, int
+flag, void *arg)>
-Determines if the given C<bufstart> pointer points to a location inside the
-memory pool. Returns 1 if the pointer is in the memory pool, 0 otherwise.
+Performs a garbage collection sweep of the given pmc pool, then frees it. Calls
+C<Parrot_gc_sweep> to perform the sweep, and C<free_pool> to free the pool and
+all its arenas. Always returns C<0>.
=cut
*/
-PARROT_WARN_UNUSED_RESULT
-int
-Parrot_gc_ptr_in_memory_pool(PARROT_INTERP, ARGIN(void *bufstart))
+static int
+sweep_cb_pmc(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool),
+ SHIM(int flag), SHIM(void *arg))
{
- ASSERT_ARGS(Parrot_gc_ptr_in_memory_pool)
- Memory_Pool * const pool = interp->arena_base->memory_pool;
- Memory_Block * cur_block = pool->top_block;
-
- while (cur_block) {
- if ((char *)bufstart >= cur_block->start &&
- (char *) bufstart < cur_block->start + cur_block->size) {
- return 1;
- }
- cur_block = cur_block->prev;
- }
+ Parrot_gc_sweep(interp, pool);
+ free_pool(pool);
return 0;
}
/*
-=item C<void Parrot_gc_reallocate_string_storage(PARROT_INTERP, STRING *str,
-size_t newsize)>
+=item C<static int sweep_cb_buf(PARROT_INTERP, Small_Object_Pool *pool, int
+flag, void *arg)>
-Reallocate the STRING's buffer memory to the given size. The allocated
-buffer will not shrink. This function sets also C<str-E<gt>strstart> to the
-new buffer location, C<str-E<gt>bufused> is B<not> changed.
+Performs a final garbage collection sweep, then frees the pool. Calls
+C<Parrot_gc_sweep> to perform the sweep, and C<free_pool> to free the pool and
+all its arenas.
=cut
*/
-void
-Parrot_gc_reallocate_string_storage(PARROT_INTERP, ARGMOD(STRING *str),
- size_t newsize)
+static int
+sweep_cb_buf(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool), SHIM(int flag),
+ ARGIN(void *arg))
{
- ASSERT_ARGS(Parrot_gc_reallocate_string_storage)
- size_t copysize;
- char *mem, *oldmem;
- size_t new_size, needed, old_size;
-
- Memory_Pool * const pool =
- PObj_constant_TEST(str)
- ? interp->arena_base->constant_string_pool
- : interp->arena_base->memory_pool;
-
- /* if the requested size is smaller then buflen, we are done */
- if (newsize <= PObj_buflen(str))
- return;
+#ifdef GC_IS_MALLOC
+ const int pass = (int)(INTVAL)arg;
- /*
- * first check, if we can reallocate:
- * - if the passed strings buffer is the last string in the pool and
- * - if there is enough size, we can just move the pool's top pointer
- */
- new_size = aligned_string_size(newsize);
- old_size = aligned_string_size(PObj_buflen(str));
- needed = new_size - old_size;
+ if (pass == 0)
+ clear_cow(interp, pool, 1);
+ else if (pass == 1)
+ used_cow(interp, pool, 1);
+ else
+#endif
- if (pool->top_block->free >= needed
- && pool->top_block->top == (char *)PObj_bufstart(str) + old_size) {
- pool->top_block->free -= needed;
- pool->top_block->top += needed;
- PObj_buflen(str) = new_size - sizeof (void*);
- return;
+ {
+ UNUSED(arg);
+ Parrot_gc_sweep(interp, pool);
+ free_pool(pool);
}
- PARROT_ASSERT(str->bufused <= newsize);
-
- /* only copy used memory, not total string buffer */
- copysize = str->bufused;
-
- if (!PObj_COW_TEST(str))
- pool->guaranteed_reclaimable += PObj_buflen(str);
-
- pool->possibly_reclaimable += PObj_buflen(str);
-
- mem = (char *)mem_allocate(interp, new_size, pool);
- mem += sizeof (void *);
-
- /* copy mem from strstart, *not* bufstart */
- oldmem = str->strstart;
- PObj_bufstart(str) = (void *)mem;
- str->strstart = mem;
- PObj_buflen(str) = new_size - sizeof (void*);
-
- /* We shouldn't ever have a 0 from size, but we do. If we can track down
- * those bugs, this can be removed which would make things cheaper */
- if (copysize)
- memcpy(mem, oldmem, copysize);
+ return 0;
}
/*
@@ -1015,51 +973,31 @@
/*
-=item C<void Parrot_gc_cleanup_next_for_GC(PARROT_INTERP)>
-
-Cleans up the C<next_for_GC> pointers. Sets all of them in the PMC and Constant
-PMC pools to NULL.
-
-=cut
-
-*/
-
-void
-Parrot_gc_cleanup_next_for_GC(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_gc_cleanup_next_for_GC)
- cleanup_next_for_GC_pool(interp->arena_base->pmc_pool);
- cleanup_next_for_GC_pool(interp->arena_base->constant_pmc_pool);
-}
-
-/*
-
-=item C<static void cleanup_next_for_GC_pool(Small_Object_Pool *pool)>
+=item C<int Parrot_gc_ptr_in_memory_pool(PARROT_INTERP, void *bufstart)>
-Sets all the C<next_for_GC> pointers to C<NULL>.
+Determines if the given C<bufstart> pointer points to a location inside the
+memory pool. Returns 1 if the pointer is in the memory pool, 0 otherwise.
=cut
*/
-static void
-cleanup_next_for_GC_pool(ARGIN(Small_Object_Pool *pool))
+PARROT_WARN_UNUSED_RESULT
+int
+Parrot_gc_ptr_in_memory_pool(PARROT_INTERP, ARGIN(void *bufstart))
{
- ASSERT_ARGS(cleanup_next_for_GC_pool)
- Small_Object_Arena *arena;
-
- for (arena = pool->last_Arena; arena; arena = arena->prev) {
- PMC *p = (PMC *)arena->start_objects;
- UINTVAL i;
+ ASSERT_ARGS(Parrot_gc_ptr_in_memory_pool)
+ Memory_Pool * const pool = interp->arena_base->memory_pool;
+ Memory_Block * cur_block = pool->top_block;
- for (i = 0; i < arena->used; i++) {
- if (!PObj_on_free_list_TEST(p)) {
- if (p->pmc_ext)
- PMC_next_for_GC(p) = PMCNULL;
- }
- p++;
+ while (cur_block) {
+ if ((char *)bufstart >= cur_block->start &&
+ (char *) bufstart < cur_block->start + cur_block->size) {
+ return 1;
}
+ cur_block = cur_block->prev;
}
+ return 0;
}
/*
@@ -1129,6 +1067,55 @@
/*
+=item C<void Parrot_gc_cleanup_next_for_GC(PARROT_INTERP)>
+
+Cleans up the C<next_for_GC> pointers. Sets all of them in the PMC and Constant
+PMC pools to NULL.
+
+=cut
+
+*/
+
+void
+Parrot_gc_cleanup_next_for_GC(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_gc_cleanup_next_for_GC)
+ cleanup_next_for_GC_pool(interp->arena_base->pmc_pool);
+ cleanup_next_for_GC_pool(interp->arena_base->constant_pmc_pool);
+}
+
+/*
+
+=item C<static void cleanup_next_for_GC_pool(Small_Object_Pool *pool)>
+
+Sets all the C<next_for_GC> pointers to C<NULL>.
+
+=cut
+
+*/
+
+static void
+cleanup_next_for_GC_pool(ARGIN(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(cleanup_next_for_GC_pool)
+ Small_Object_Arena *arena;
+
+ for (arena = pool->last_Arena; arena; arena = arena->prev) {
+ PMC *p = (PMC *)arena->start_objects;
+ UINTVAL i;
+
+ for (i = 0; i < arena->used; i++) {
+ if (!PObj_on_free_list_TEST(p)) {
+ if (p->pmc_ext)
+ PMC_next_for_GC(p) = PMCNULL;
+ }
+ p++;
+ }
+ }
+}
+
+/*
+
=item C<int Parrot_gc_active_sized_buffers(PARROT_INTERP)>
Returns the number of actively used sized buffers.
@@ -1422,24 +1409,6 @@
/*
-=item C<void Parrot_gc_finalize(PARROT_INTERP)>
-
-Finalize the GC system, if the current GC core has defined a finalization
-routine.
-
-=cut
-
-*/
-
-void
-Parrot_gc_finalize(PARROT_INTERP)
-{
- if (interp->arena_base->finalize_gc_system)
- interp->arena_base->finalize_gc_system(interp);
-}
-
-/*
-
=back
=head1 SEE ALSO
More information about the parrot-commits
mailing list