[svn:parrot] r39022 - in branches/gc_internals: config/gen/makefiles src/gc
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Thu May 21 22:03:50 UTC 2009
Author: whiteknight
Date: Thu May 21 22:03:49 2009
New Revision: 39022
URL: https://trac.parrot.org/parrot/changeset/39022
Log:
[gc_internals] gut pools.c (nee smallobject.c) and move most of the remainders into mark_sweep.c
Modified:
branches/gc_internals/config/gen/makefiles/root.in
branches/gc_internals/src/gc/gc_private.h
branches/gc_internals/src/gc/mark_sweep.c
branches/gc_internals/src/gc/pools.c
Modified: branches/gc_internals/config/gen/makefiles/root.in
==============================================================================
--- branches/gc_internals/config/gen/makefiles/root.in Thu May 21 21:54:08 2009 (r39021)
+++ branches/gc_internals/config/gen/makefiles/root.in Thu May 21 22:03:49 2009 (r39022)
@@ -411,7 +411,6 @@
$(SRC_DIR)/gc/generational_ms$(O) \
$(SRC_DIR)/gc/incremental_ms$(O) \
$(SRC_DIR)/gc/gc_ms$(O) \
- $(SRC_DIR)/gc/pools$(O) \
$(SRC_DIR)/gc/mark_sweep$(O) \
$(SRC_DIR)/gc/system$(O) \
$(SRC_DIR)/global$(O) \
@@ -1096,8 +1095,6 @@
$(SRC_DIR)/gc/incremental_ms$(O) : $(GENERAL_H_FILES)
-$(SRC_DIR)/gc/pools$(O) : $(GENERAL_H_FILES)
-
$(SRC_DIR)/gc/alloc_resources$(O) : $(GENERAL_H_FILES)
$(SRC_DIR)/gc/res_lea$(O) : $(GENERAL_H_FILES)
Modified: branches/gc_internals/src/gc/gc_private.h
==============================================================================
--- branches/gc_internals/src/gc/gc_private.h Thu May 21 21:54:08 2009 (r39021)
+++ branches/gc_internals/src/gc/gc_private.h Thu May 21 22:03:49 2009 (r39022)
@@ -313,6 +313,23 @@
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
+ __attribute__nonnull__(1);
+
+PARROT_IGNORABLE_RESULT
+int /*@alt void@*/
+header_pools_iterate_callback(PARROT_INTERP,
+ int flag,
+ ARGIN_NULLOK(void *arg),
+ NOTNULL(pool_iter_fn func))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(4);
+
+void initialize_header_pools(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
void mark_special(PARROT_INTERP, ARGIN(PMC *obj))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -364,6 +381,13 @@
#define ASSERT_ARGS_contained_in_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(pool) \
|| PARROT_ASSERT_ARG(ptr)
+#define ASSERT_ARGS_get_bufferlike_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_header_pools_iterate_callback __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(func)
+#define ASSERT_ARGS_initialize_header_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_mark_special __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(obj)
Modified: branches/gc_internals/src/gc/mark_sweep.c
==============================================================================
--- branches/gc_internals/src/gc/mark_sweep.c Thu May 21 21:54:08 2009 (r39021)
+++ branches/gc_internals/src/gc/mark_sweep.c Thu May 21 22:03:49 2009 (r39022)
@@ -31,6 +31,72 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+static void free_pmc_in_pool(PARROT_INTERP,
+ SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *p))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*p);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_buffer_pool(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP,
+ size_t actual_buffer_size)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_pmc_pool(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_small_object_pool(
+ size_t object_size,
+ size_t objects_per_alloc);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL constant)
+ __attribute__nonnull__(1);
+
+static void Parrot_gc_free_buffer(SHIM_INTERP,
+ ARGMOD(Small_Object_Pool *pool),
+ ARGMOD(PObj *b))
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*pool)
+ FUNC_MODIFIES(*b);
+
+static void Parrot_gc_free_buffer_malloc(SHIM_INTERP,
+ SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *b))
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*b);
+
+#define ASSERT_ARGS_free_pmc_in_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(p)
+#define ASSERT_ARGS_new_buffer_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_bufferlike_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_pmc_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_small_object_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
+#define ASSERT_ARGS_new_string_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_gc_free_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pool) \
+ || PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_Parrot_gc_free_buffer_malloc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(b)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/* Set when walking the system stack */
@@ -635,6 +701,484 @@
}
}
+#ifndef GC_IS_MALLOC
+# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
+# define BUFFER_HEADERS_PER_ALLOC 5120 / sizeof (Buffer)
+# define STRING_HEADERS_PER_ALLOC 5120 / sizeof (STRING)
+#else /* GC_IS_MALLOC */
+# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
+# define BUFFER_HEADERS_PER_ALLOC 10240 / sizeof (Buffer)
+# define STRING_HEADERS_PER_ALLOC 10240 / sizeof (STRING)
+#endif /* GC_IS_MALLOC */
+
+#define CONSTANT_PMC_HEADERS_PER_ALLOC 64
+#define GET_SIZED_POOL_IDX(x) ((x) / sizeof (void *))
+
+
+
+/*
+
+=back
+
+=head2 Header Pool Creation Functions
+
+=over 4
+
+=item C<static Small_Object_Pool * new_pmc_pool(PARROT_INTERP)>
+
+Creates and initializes a new pool for PMCs and returns it.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_pmc_pool(PARROT_INTERP)
+{
+ ASSERT_ARGS(new_pmc_pool)
+ const int num_headers = PMC_HEADERS_PER_ALLOC;
+ Small_Object_Pool * const pmc_pool =
+ new_small_object_pool(sizeof (PMC), num_headers);
+
+ pmc_pool->mem_pool = NULL;
+ pmc_pool->gc_object = free_pmc_in_pool;
+
+ (interp->arena_base->init_pool)(interp, pmc_pool);
+ return pmc_pool;
+}
+
+/*
+
+=item C<static void free_pmc_in_pool(PARROT_INTERP, Small_Object_Pool *pool,
+PObj *p)>
+
+Frees a PMC that is no longer being used. Calls a custom C<destroy> VTABLE
+method if one is available. If the PMC uses a PMC_EXT structure, that is freed
+as well.
+
+=cut
+
+*/
+
+static void
+free_pmc_in_pool(PARROT_INTERP, SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *p))
+{
+ ASSERT_ARGS(free_pmc_in_pool)
+ PMC * const pmc = (PMC *)p;
+ Arenas * const arena_base = interp->arena_base;
+
+ /* TODO collect objects with finalizers */
+ if (PObj_needs_early_gc_TEST(p))
+ --arena_base->num_early_gc_PMCs;
+
+ if (PObj_active_destroy_TEST(p))
+ VTABLE_destroy(interp, pmc);
+
+ if (PObj_is_PMC_EXT_TEST(p))
+ Parrot_gc_free_pmc_ext(interp, pmc);
+
+#ifndef NDEBUG
+
+ pmc->pmc_ext = (PMC_EXT *)0xdeadbeef;
+ pmc->vtable = (VTABLE *)0xdeadbeef;
+
+#endif
+
+}
+
+
+/*
+
+=item C<static Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP, size_t
+actual_buffer_size)>
+
+Creates a new pool for buffer-like structures. This is called from
+C<get_bufferlike_pool()>, and should probably not be called directly.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_bufferlike_pool(PARROT_INTERP, size_t actual_buffer_size)
+{
+ ASSERT_ARGS(new_bufferlike_pool)
+ const int num_headers = BUFFER_HEADERS_PER_ALLOC;
+ const size_t buffer_size =
+ (actual_buffer_size + sizeof (void *) - 1) & ~(sizeof (void *) - 1);
+ Small_Object_Pool * const pool =
+ new_small_object_pool(buffer_size, num_headers);
+
+ pool->gc_object = NULL;
+ pool->mem_pool = interp->arena_base->memory_pool;
+ (interp->arena_base->init_pool)(interp, pool);
+ return pool;
+}
+
+/*
+
+=item C<static Small_Object_Pool * new_small_object_pool(size_t object_size,
+size_t objects_per_alloc)>
+
+Creates a new C<Small_Object_Pool> and returns a pointer to it.
+Initializes the pool structure based on the size of objects in the
+pool and the number of items to allocate in each arena.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_small_object_pool(size_t object_size, size_t objects_per_alloc)
+{
+ ASSERT_ARGS(new_small_object_pool)
+ Small_Object_Pool * const pool =
+ mem_internal_allocate_zeroed_typed(Small_Object_Pool);
+
+ pool->last_Arena = NULL;
+ pool->free_list = NULL;
+ pool->mem_pool = NULL;
+ pool->object_size = object_size;
+ pool->objects_per_alloc = objects_per_alloc;
+
+ return pool;
+}
+
+
+
+/*
+
+=item C<static Small_Object_Pool * new_buffer_pool(PARROT_INTERP)>
+
+Creates a new C<Small_Object_Pool> structure for managing buffer objects.
+
+Non-constant strings and plain Buffers are stored in the sized header pools.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_buffer_pool(PARROT_INTERP)
+{
+ ASSERT_ARGS(new_buffer_pool)
+ Small_Object_Pool * const pool = get_bufferlike_pool(interp, sizeof (Buffer));
+
+#ifdef GC_IS_MALLOC
+ pool->gc_object = Parrot_gc_free_buffer_malloc;
+#else
+ pool->gc_object = Parrot_gc_free_buffer;
+#endif
+
+ return pool;
+}
+
+/*
+
+=item C<static void Parrot_gc_free_buffer_malloc(PARROT_INTERP,
+Small_Object_Pool *pool, PObj *b)>
+
+Frees the given buffer, returning the storage space to the operating system
+and removing it from Parrot's memory management system. If the buffer is COW,
+The buffer is not freed if the reference count is greater then 1.
+
+=cut
+
+*/
+
+static void
+Parrot_gc_free_buffer_malloc(SHIM_INTERP, SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *b))
+{
+ ASSERT_ARGS(Parrot_gc_free_buffer_malloc)
+ /* free allocated space at (int *)bufstart - 1, but not if it used COW or is
+ * external */
+ PObj_buflen(b) = 0;
+
+ if (!PObj_bufstart(b) || PObj_is_external_or_free_TESTALL(b))
+ return;
+
+ if (PObj_COW_TEST(b)) {
+ INTVAL * const refcount = PObj_bufrefcountptr(b);
+
+ if (--(*refcount) == 0) {
+ mem_sys_free(refcount); /* the actual bufstart */
+ }
+ }
+ else
+ mem_sys_free(PObj_bufrefcountptr(b));
+}
+
+/*
+
+=item C<static void Parrot_gc_free_buffer(PARROT_INTERP, Small_Object_Pool
+*pool, PObj *b)>
+
+Frees a buffer, returning it to the memory pool for Parrot to possibly
+reuse later.
+
+=cut
+
+*/
+
+static void
+Parrot_gc_free_buffer(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGMOD(PObj *b))
+{
+ ASSERT_ARGS(Parrot_gc_free_buffer)
+ Memory_Pool * const mem_pool = (Memory_Pool *)pool->mem_pool;
+
+ /* XXX Jarkko reported that on irix pool->mem_pool was NULL, which really
+ * shouldn't happen */
+ if (mem_pool) {
+ if (!PObj_COW_TEST(b))
+ mem_pool->guaranteed_reclaimable += PObj_buflen(b);
+
+ mem_pool->possibly_reclaimable += PObj_buflen(b);
+ }
+
+ PObj_buflen(b) = 0;
+}
+
+
+/*
+
+=item C<static Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL
+constant)>
+
+Creates a new pool for C<STRING>s and returns it. This calls
+C<get_bufferlike_pool> internally, which in turn calls C<new_bufferlike_pool>.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_string_pool(PARROT_INTERP, INTVAL constant)
+{
+ ASSERT_ARGS(new_string_pool)
+ Small_Object_Pool *pool;
+ if (constant) {
+ pool = new_bufferlike_pool(interp, sizeof (STRING));
+ pool->mem_pool = interp->arena_base->constant_string_pool;
+ }
+ else
+ pool = get_bufferlike_pool(interp, sizeof (STRING));
+
+ pool->objects_per_alloc = STRING_HEADERS_PER_ALLOC;
+
+ return pool;
+}
+
+
+/*
+
+=item C<Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t
+buffer_size)>
+
+Makes and return a bufferlike header pool for objects of a given size. If a
+pool for objects of that size already exists, no new pool will be created and
+the pointer to the existing pool is returned.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+Small_Object_Pool *
+get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
+{
+ ASSERT_ARGS(get_bufferlike_pool)
+ Small_Object_Pool **sized_pools = interp->arena_base->sized_header_pools;
+ const UINTVAL num_old = interp->arena_base->num_sized;
+ const UINTVAL idx = GET_SIZED_POOL_IDX(buffer_size);
+
+ /* Expands the array of sized resource pools, if necessary */
+ if (num_old <= idx) {
+ const UINTVAL num_new = idx + 1;
+ /* XXX: use mem_sys_realloc_zeroed to do this easier? If we want the
+ same debugging behavior as mem_internal_realloc, we would
+ need to add a new function/macro for
+ mem_internal_realloc_zeroed, to mirror mem_sys_realloc_zeroed. */
+ sized_pools = (Small_Object_Pool **)mem_internal_realloc(sized_pools,
+ num_new * sizeof (void *));
+ memset(sized_pools + num_old, 0, sizeof (void *) * (num_new - num_old));
+
+ interp->arena_base->sized_header_pools = sized_pools;
+ interp->arena_base->num_sized = num_new;
+ }
+
+ if (sized_pools[idx] == NULL)
+ sized_pools[idx] = new_bufferlike_pool(interp, buffer_size);
+
+ return sized_pools[idx];
+}
+
+/*
+
+=item C<void initialize_header_pools(PARROT_INTERP)>
+
+The initialization routine for the interpreter's header pools. Initializes
+pools for string headers, constant string headers, buffers, PMCs, PMC_EXTs, and
+constant PMCs.
+
+The C<string_header_pool> and C<buffer_header_pool> are actually both in the
+sized pools, although no other sized pools are created here.
+
+=cut
+
+*/
+
+void
+initialize_header_pools(PARROT_INTERP)
+{
+ ASSERT_ARGS(initialize_header_pools)
+ Arenas * const arena_base = interp->arena_base;
+
+ /* Init the constant string header pool */
+ arena_base->constant_string_header_pool = new_string_pool(interp, 1);
+ arena_base->constant_string_header_pool->name = "constant_string_header";
+
+ /* Init the buffer header pool
+ *
+ * The buffer_header_pool and the string_header_pool actually live in the
+ * sized_header_pools. These pool pointers only provide faster access in
+ * new_*_header */
+ arena_base->buffer_header_pool = new_buffer_pool(interp);
+ arena_base->buffer_header_pool->name = "buffer_header";
+
+ /* Init the string header pool */
+ arena_base->string_header_pool = new_string_pool(interp, 0);
+ arena_base->string_header_pool->name = "string_header";
+
+ /* Init the PMC header pool */
+ arena_base->pmc_pool = new_pmc_pool(interp);
+ arena_base->pmc_pool->name = "pmc";
+
+ /* pmc extension buffer */
+ arena_base->pmc_ext_pool =
+ new_small_object_pool(sizeof (PMC_EXT), 1024);
+
+#if PARROT_GC_MS
+ /*
+ * pmc_ext isn't a managed item. If a PMC has a pmc_ext structure
+ * it is returned to the pool instantly - the structure is never
+ * marked.
+ * Use GS MS pool functions
+ */
+ gc_ms_pmc_ext_pool_init(arena_base->pmc_ext_pool);
+#else
+ /* rational, consistant behavior (as yet unwritten) */
+#endif
+
+ arena_base->pmc_ext_pool->name = "pmc_ext";
+
+ /* constant PMCs */
+ arena_base->constant_pmc_pool = new_pmc_pool(interp);
+ arena_base->constant_pmc_pool->name = "constant_pmc";
+ arena_base->constant_pmc_pool->objects_per_alloc =
+ CONSTANT_PMC_HEADERS_PER_ALLOC;
+}
+
+
+/*
+
+=item C<int header_pools_iterate_callback(PARROT_INTERP, int flag, void *arg,
+pool_iter_fn func)>
+
+Iterates through header pools, invoking the given callback function on each
+pool in the list matching the given criteria. Determines which pools to iterate
+over depending on flags passed to the function. Returns the callback's return
+value, if non-zero. A non-zero return value from the callback function will
+terminate the iteration prematurely.
+
+=over 4
+
+=item flag is one of
+
+ POOL_PMC
+ POOL_BUFFER
+ POOL_CONST
+ POOL_ALL
+
+Only matching pools will be used. Notice that it is not possible to iterate
+over certain sets of pools using the provided flags in the single pass. For
+instance, both the PMC pool and the constant PMC pool cannot be iterated over
+in a single pass.
+
+=item arg
+
+This argument is passed on to the iteration function.
+
+=item pool_iter_fn
+
+Called with C<(Parrot_Interp, Small_Object_Pool *, int flag, void *arg)>. If
+the function returns a non-zero value, iteration will stop.
+
+=back
+
+=cut
+
+*/
+
+PARROT_IGNORABLE_RESULT
+int
+header_pools_iterate_callback(PARROT_INTERP, int flag, ARGIN_NULLOK(void *arg),
+ NOTNULL(pool_iter_fn func))
+{
+ ASSERT_ARGS(header_pools_iterate_callback)
+ Arenas * const arena_base = interp->arena_base;
+
+ if (flag & POOL_PMC) {
+ Small_Object_Pool *pool = flag & POOL_CONST
+ ? arena_base->constant_pmc_pool
+ : arena_base->pmc_pool;
+
+ const int ret_val = (func)(interp, pool,
+ flag & (POOL_PMC | POOL_CONST) , arg);
+
+ if (ret_val)
+ return ret_val;
+ }
+
+ if (flag & POOL_BUFFER) {
+ INTVAL i;
+
+ if (flag & POOL_CONST) {
+ const int ret_val = (func)(interp,
+ arena_base->constant_string_header_pool,
+ POOL_BUFFER | POOL_CONST, arg);
+
+ if (ret_val)
+ return ret_val;
+ }
+
+ for (i = interp->arena_base->num_sized - 1; i >= 0; --i) {
+ Small_Object_Pool * const pool = arena_base->sized_header_pools[i];
+
+ if (pool) {
+ const int ret_val = (func)(interp, pool, POOL_BUFFER, arg);
+ if (ret_val)
+ return ret_val;
+ }
+ }
+ }
+
+ return 0;
+}
+
+
/*
Modified: branches/gc_internals/src/gc/pools.c
==============================================================================
--- branches/gc_internals/src/gc/pools.c Thu May 21 21:54:08 2009 (r39021)
+++ branches/gc_internals/src/gc/pools.c Thu May 21 22:03:49 2009 (r39022)
@@ -91,482 +91,6 @@
/* HEADERIZER END: static */
-#ifndef GC_IS_MALLOC
-# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
-# define BUFFER_HEADERS_PER_ALLOC 5120 / sizeof (Buffer)
-# define STRING_HEADERS_PER_ALLOC 5120 / sizeof (STRING)
-#else /* GC_IS_MALLOC */
-# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
-# define BUFFER_HEADERS_PER_ALLOC 10240 / sizeof (Buffer)
-# define STRING_HEADERS_PER_ALLOC 10240 / sizeof (STRING)
-#endif /* GC_IS_MALLOC */
-
-#define CONSTANT_PMC_HEADERS_PER_ALLOC 64
-#define GET_SIZED_POOL_IDX(x) ((x) / sizeof (void *))
-
-
-
-/*
-
-=back
-
-=head2 Header Pool Creation Functions
-
-=over 4
-
-=item C<static Small_Object_Pool * new_pmc_pool(PARROT_INTERP)>
-
-Creates and initializes a new pool for PMCs and returns it.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static Small_Object_Pool *
-new_pmc_pool(PARROT_INTERP)
-{
- ASSERT_ARGS(new_pmc_pool)
- const int num_headers = PMC_HEADERS_PER_ALLOC;
- Small_Object_Pool * const pmc_pool =
- new_small_object_pool(sizeof (PMC), num_headers);
-
- pmc_pool->mem_pool = NULL;
- pmc_pool->gc_object = free_pmc_in_pool;
-
- (interp->arena_base->init_pool)(interp, pmc_pool);
- return pmc_pool;
-}
-
-/*
-
-=item C<static void free_pmc_in_pool(PARROT_INTERP, Small_Object_Pool *pool,
-PObj *p)>
-
-Frees a PMC that is no longer being used. Calls a custom C<destroy> VTABLE
-method if one is available. If the PMC uses a PMC_EXT structure, that is freed
-as well.
-
-=cut
-
-*/
-
-static void
-free_pmc_in_pool(PARROT_INTERP, SHIM(Small_Object_Pool *pool),
- ARGMOD(PObj *p))
-{
- ASSERT_ARGS(free_pmc_in_pool)
- PMC * const pmc = (PMC *)p;
- Arenas * const arena_base = interp->arena_base;
-
- /* TODO collect objects with finalizers */
- if (PObj_needs_early_gc_TEST(p))
- --arena_base->num_early_gc_PMCs;
-
- if (PObj_active_destroy_TEST(p))
- VTABLE_destroy(interp, pmc);
-
- if (PObj_is_PMC_EXT_TEST(p))
- Parrot_gc_free_pmc_ext(interp, pmc);
-
-#ifndef NDEBUG
-
- pmc->pmc_ext = (PMC_EXT *)0xdeadbeef;
- pmc->vtable = (VTABLE *)0xdeadbeef;
-
-#endif
-
-}
-
-
-/*
-
-=item C<static Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP, size_t
-actual_buffer_size)>
-
-Creates a new pool for buffer-like structures. This is called from
-C<get_bufferlike_pool()>, and should probably not be called directly.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static Small_Object_Pool *
-new_bufferlike_pool(PARROT_INTERP, size_t actual_buffer_size)
-{
- ASSERT_ARGS(new_bufferlike_pool)
- const int num_headers = BUFFER_HEADERS_PER_ALLOC;
- const size_t buffer_size =
- (actual_buffer_size + sizeof (void *) - 1) & ~(sizeof (void *) - 1);
- Small_Object_Pool * const pool =
- new_small_object_pool(buffer_size, num_headers);
-
- pool->gc_object = NULL;
- pool->mem_pool = interp->arena_base->memory_pool;
- (interp->arena_base->init_pool)(interp, pool);
- return pool;
-}
-
-/*
-
-=item C<static Small_Object_Pool * new_small_object_pool(size_t object_size,
-size_t objects_per_alloc)>
-
-Creates a new C<Small_Object_Pool> and returns a pointer to it.
-Initializes the pool structure based on the size of objects in the
-pool and the number of items to allocate in each arena.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-static Small_Object_Pool *
-new_small_object_pool(size_t object_size, size_t objects_per_alloc)
-{
- ASSERT_ARGS(new_small_object_pool)
- Small_Object_Pool * const pool =
- mem_internal_allocate_zeroed_typed(Small_Object_Pool);
-
- pool->last_Arena = NULL;
- pool->free_list = NULL;
- pool->mem_pool = NULL;
- pool->object_size = object_size;
- pool->objects_per_alloc = objects_per_alloc;
-
- return pool;
-}
-
-
-
-/*
-
-=item C<static Small_Object_Pool * new_buffer_pool(PARROT_INTERP)>
-
-Creates a new C<Small_Object_Pool> structure for managing buffer objects.
-
-Non-constant strings and plain Buffers are stored in the sized header pools.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static Small_Object_Pool *
-new_buffer_pool(PARROT_INTERP)
-{
- ASSERT_ARGS(new_buffer_pool)
- Small_Object_Pool * const pool = get_bufferlike_pool(interp, sizeof (Buffer));
-
-#ifdef GC_IS_MALLOC
- pool->gc_object = Parrot_gc_free_buffer_malloc;
-#else
- pool->gc_object = Parrot_gc_free_buffer;
-#endif
-
- return pool;
-}
-
-/*
-
-=item C<static void Parrot_gc_free_buffer_malloc(PARROT_INTERP,
-Small_Object_Pool *pool, PObj *b)>
-
-Frees the given buffer, returning the storage space to the operating system
-and removing it from Parrot's memory management system. If the buffer is COW,
-The buffer is not freed if the reference count is greater then 1.
-
-=cut
-
-*/
-
-static void
-Parrot_gc_free_buffer_malloc(SHIM_INTERP, SHIM(Small_Object_Pool *pool),
- ARGMOD(PObj *b))
-{
- ASSERT_ARGS(Parrot_gc_free_buffer_malloc)
- /* free allocated space at (int *)bufstart - 1, but not if it used COW or is
- * external */
- PObj_buflen(b) = 0;
-
- if (!PObj_bufstart(b) || PObj_is_external_or_free_TESTALL(b))
- return;
-
- if (PObj_COW_TEST(b)) {
- INTVAL * const refcount = PObj_bufrefcountptr(b);
-
- if (--(*refcount) == 0) {
- mem_sys_free(refcount); /* the actual bufstart */
- }
- }
- else
- mem_sys_free(PObj_bufrefcountptr(b));
-}
-
-/*
-
-=item C<static void Parrot_gc_free_buffer(PARROT_INTERP, Small_Object_Pool
-*pool, PObj *b)>
-
-Frees a buffer, returning it to the memory pool for Parrot to possibly
-reuse later.
-
-=cut
-
-*/
-
-static void
-Parrot_gc_free_buffer(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGMOD(PObj *b))
-{
- ASSERT_ARGS(Parrot_gc_free_buffer)
- Memory_Pool * const mem_pool = (Memory_Pool *)pool->mem_pool;
-
- /* XXX Jarkko reported that on irix pool->mem_pool was NULL, which really
- * shouldn't happen */
- if (mem_pool) {
- if (!PObj_COW_TEST(b))
- mem_pool->guaranteed_reclaimable += PObj_buflen(b);
-
- mem_pool->possibly_reclaimable += PObj_buflen(b);
- }
-
- PObj_buflen(b) = 0;
-}
-
-
-/*
-
-=item C<static Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL
-constant)>
-
-Creates a new pool for C<STRING>s and returns it. This calls
-C<get_bufferlike_pool> internally, which in turn calls C<new_bufferlike_pool>.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static Small_Object_Pool *
-new_string_pool(PARROT_INTERP, INTVAL constant)
-{
- ASSERT_ARGS(new_string_pool)
- Small_Object_Pool *pool;
- if (constant) {
- pool = new_bufferlike_pool(interp, sizeof (STRING));
- pool->mem_pool = interp->arena_base->constant_string_pool;
- }
- else
- pool = get_bufferlike_pool(interp, sizeof (STRING));
-
- pool->objects_per_alloc = STRING_HEADERS_PER_ALLOC;
-
- return pool;
-}
-
-
-/*
-
-=item C<Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t
-buffer_size)>
-
-Makes and return a bufferlike header pool for objects of a given size. If a
-pool for objects of that size already exists, no new pool will be created and
-the pointer to the existing pool is returned.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
-get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
-{
- ASSERT_ARGS(get_bufferlike_pool)
- Small_Object_Pool **sized_pools = interp->arena_base->sized_header_pools;
- const UINTVAL num_old = interp->arena_base->num_sized;
- const UINTVAL idx = GET_SIZED_POOL_IDX(buffer_size);
-
- /* Expands the array of sized resource pools, if necessary */
- if (num_old <= idx) {
- const UINTVAL num_new = idx + 1;
- /* XXX: use mem_sys_realloc_zeroed to do this easier? If we want the
- same debugging behavior as mem_internal_realloc, we would
- need to add a new function/macro for
- mem_internal_realloc_zeroed, to mirror mem_sys_realloc_zeroed. */
- sized_pools = (Small_Object_Pool **)mem_internal_realloc(sized_pools,
- num_new * sizeof (void *));
- memset(sized_pools + num_old, 0, sizeof (void *) * (num_new - num_old));
-
- interp->arena_base->sized_header_pools = sized_pools;
- interp->arena_base->num_sized = num_new;
- }
-
- if (sized_pools[idx] == NULL)
- sized_pools[idx] = new_bufferlike_pool(interp, buffer_size);
-
- return sized_pools[idx];
-}
-
-/*
-
-=item C<void initialize_header_pools(PARROT_INTERP)>
-
-The initialization routine for the interpreter's header pools. Initializes
-pools for string headers, constant string headers, buffers, PMCs, PMC_EXTs, and
-constant PMCs.
-
-The C<string_header_pool> and C<buffer_header_pool> are actually both in the
-sized pools, although no other sized pools are created here.
-
-=cut
-
-*/
-
-void
-initialize_header_pools(PARROT_INTERP)
-{
- ASSERT_ARGS(initialize_header_pools)
- Arenas * const arena_base = interp->arena_base;
-
- /* Init the constant string header pool */
- arena_base->constant_string_header_pool = new_string_pool(interp, 1);
- arena_base->constant_string_header_pool->name = "constant_string_header";
-
- /* Init the buffer header pool
- *
- * The buffer_header_pool and the string_header_pool actually live in the
- * sized_header_pools. These pool pointers only provide faster access in
- * new_*_header */
- arena_base->buffer_header_pool = new_buffer_pool(interp);
- arena_base->buffer_header_pool->name = "buffer_header";
-
- /* Init the string header pool */
- arena_base->string_header_pool = new_string_pool(interp, 0);
- arena_base->string_header_pool->name = "string_header";
-
- /* Init the PMC header pool */
- arena_base->pmc_pool = new_pmc_pool(interp);
- arena_base->pmc_pool->name = "pmc";
-
- /* pmc extension buffer */
- arena_base->pmc_ext_pool =
- new_small_object_pool(sizeof (PMC_EXT), 1024);
-
-#if PARROT_GC_MS
- /*
- * pmc_ext isn't a managed item. If a PMC has a pmc_ext structure
- * it is returned to the pool instantly - the structure is never
- * marked.
- * Use GS MS pool functions
- */
- gc_ms_pmc_ext_pool_init(arena_base->pmc_ext_pool);
-#else
- /* rational, consistant behavior (as yet unwritten) */
-#endif
-
- arena_base->pmc_ext_pool->name = "pmc_ext";
-
- /* constant PMCs */
- arena_base->constant_pmc_pool = new_pmc_pool(interp);
- arena_base->constant_pmc_pool->name = "constant_pmc";
- arena_base->constant_pmc_pool->objects_per_alloc =
- CONSTANT_PMC_HEADERS_PER_ALLOC;
-}
-
-
-/*
-
-=item C<int header_pools_iterate_callback(PARROT_INTERP, int flag, void *arg,
-pool_iter_fn func)>
-
-Iterates through header pools, invoking the given callback function on each
-pool in the list matching the given criteria. Determines which pools to iterate
-over depending on flags passed to the function. Returns the callback's return
-value, if non-zero. A non-zero return value from the callback function will
-terminate the iteration prematurely.
-
-=over 4
-
-=item flag is one of
-
- POOL_PMC
- POOL_BUFFER
- POOL_CONST
- POOL_ALL
-
-Only matching pools will be used. Notice that it is not possible to iterate
-over certain sets of pools using the provided flags in the single pass. For
-instance, both the PMC pool and the constant PMC pool cannot be iterated over
-in a single pass.
-
-=item arg
-
-This argument is passed on to the iteration function.
-
-=item pool_iter_fn
-
-Called with C<(Parrot_Interp, Small_Object_Pool *, int flag, void *arg)>. If
-the function returns a non-zero value, iteration will stop.
-
-=back
-
-=cut
-
-*/
-
-PARROT_IGNORABLE_RESULT
-int
-header_pools_iterate_callback(PARROT_INTERP, int flag, ARGIN_NULLOK(void *arg),
- NOTNULL(pool_iter_fn func))
-{
- ASSERT_ARGS(header_pools_iterate_callback)
- Arenas * const arena_base = interp->arena_base;
-
- if (flag & POOL_PMC) {
- Small_Object_Pool *pool = flag & POOL_CONST
- ? arena_base->constant_pmc_pool
- : arena_base->pmc_pool;
-
- const int ret_val = (func)(interp, pool,
- flag & (POOL_PMC | POOL_CONST) , arg);
-
- if (ret_val)
- return ret_val;
- }
-
- if (flag & POOL_BUFFER) {
- INTVAL i;
-
- if (flag & POOL_CONST) {
- const int ret_val = (func)(interp,
- arena_base->constant_string_header_pool,
- POOL_BUFFER | POOL_CONST, arg);
-
- if (ret_val)
- return ret_val;
- }
-
- for (i = interp->arena_base->num_sized - 1; i >= 0; --i) {
- Small_Object_Pool * const pool = arena_base->sized_header_pools[i];
-
- if (pool) {
- const int ret_val = (func)(interp, pool, POOL_BUFFER, arg);
- if (ret_val)
- return ret_val;
- }
- }
- }
-
- return 0;
-}
/*
More information about the parrot-commits
mailing list