cvsuser 05/01/25 07:59:30
Modified: include/parrot headers.h
src headers.c smallobject.c
Log:
GMS generational MS 2 - pmc_ext is special
Revision Changes Path
1.25 +2 -1 parrot/include/parrot/headers.h
Index: headers.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/headers.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- headers.h 20 Jan 2005 14:48:23 -0000 1.24
+++ headers.h 25 Jan 2005 15:59:29 -0000 1.25
@@ -1,7 +1,7 @@
/* headers.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: headers.h,v 1.24 2005/01/20 14:48:23 leo Exp $
+ * $Id: headers.h,v 1.25 2005/01/25 15:59:29 leo Exp $
* Overview:
* Header management functions. Handles getting of various headers,
* and pool creation
@@ -46,6 +46,7 @@
int is_buffer_ptr(Interp *, void *);
int is_pmc_ptr(Interp *, void *);
+void gc_pmc_ext_pool_init(Interp *, struct Small_Object_Pool *pool);
/* pool iteration */
typedef enum {
1.65 +9 -7 parrot/src/headers.c
Index: headers.c
===================================================================
RCS file: /cvs/public/parrot/src/headers.c,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -r1.64 -r1.65
--- headers.c 25 Jan 2005 14:47:33 -0000 1.64
+++ headers.c 25 Jan 2005 15:59:30 -0000 1.65
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: headers.c,v 1.64 2005/01/25 14:47:33 leo Exp $
+$Id: headers.c,v 1.65 2005/01/25 15:59:30 leo Exp $
=head1 NAME
@@ -295,17 +295,13 @@
struct Small_Object_Pool *pool = interpreter->arena_base->pmc_ext_pool;
void *ptr;
/*
- * can't use normall get_free_object--PMC_EXT doesn't have flags
+ * can't use normal get_free_object--PMC_EXT doesn't have flags
* it isn't a Buffer
*/
-#if PARROT_GC_GMS
- ptr = pool->get_free_object(interpreter, pool);
-#else
if (!pool->free_list)
(*pool->more_objects) (interpreter, pool);
ptr = pool->free_list;
pool->free_list = *(void **)ptr;
-#endif
memset(ptr, 0, sizeof(PMC_EXT));
return ptr;
}
@@ -586,7 +582,13 @@
/* pmc extension buffer */
arena_base->pmc_ext_pool =
new_small_object_pool(interpreter, sizeof(struct PMC_EXT), 1024);
- (arena_base->init_pool)(interpreter, arena_base->pmc_ext_pool);
+ /*
+ * 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_pmc_ext_pool_init(interpreter, arena_base->pmc_ext_pool);
arena_base->pmc_ext_pool->name = "pmc_ext";
/* constant PMCs */
1.55 +11 -3 parrot/src/smallobject.c
Index: smallobject.c
===================================================================
RCS file: /cvs/public/parrot/src/smallobject.c,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -r1.54 -r1.55
--- smallobject.c 18 Jan 2005 14:05:19 -0000 1.54
+++ smallobject.c 25 Jan 2005 15:59:30 -0000 1.55
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: smallobject.c,v 1.54 2005/01/18 14:05:19 leo Exp $
+$Id: smallobject.c,v 1.55 2005/01/25 15:59:30 leo Exp $
=head1 NAME
@@ -442,6 +442,7 @@
*/
+
struct Small_Object_Pool *
new_small_object_pool(Interp *interpreter,
size_t object_size, size_t objects_per_alloc)
@@ -457,6 +458,15 @@
return pool;
}
+void
+gc_pmc_ext_pool_init(Interp *interpreter, struct Small_Object_Pool *pool)
+{
+ pool->add_free_object = gc_ms_add_free_object;
+ pool->get_free_object = gc_ms_get_free_object;
+ pool->alloc_objects = gc_ms_alloc_objects;
+ pool->more_objects = gc_ms_alloc_objects;
+}
+
static void
gc_ms_pool_init(Interp *interpreter, struct Small_Object_Pool *pool)
{
@@ -468,8 +478,6 @@
if (pool->object_size >= sizeof(Dead_PObj))
pool->get_free_object = get_free_object_df;
#endif
- if (pool == interpreter->arena_base->pmc_ext_pool)
- pool->more_objects = pool->alloc_objects;
}
/*
