--- parrot/classes/scalar.pmc Mon May 19 15:07:50 2003 +++ parrot-leo/classes/scalar.pmc Fri May 23 14:06:21 2003 @@ -18,7 +18,6 @@ void clone (PMC *dest) { VTABLE_init(INTERP, dest); memcpy(&dest->cache, &SELF->cache, sizeof(UnionVal)); - dest->data = 0; } INTVAL get_integer () { --- parrot/dod.c Wed May 21 16:59:10 2003 +++ parrot-leo/dod.c Fri May 23 14:00:26 2003 @@ -45,17 +45,22 @@ if (CONSERVATIVE_POINTER_CHASING) { fprintf(stderr, "GC Warning! Unanchored %s %p version " INTVAL_FMT " found in system areas \n", - PObj_is_PMC_TEST(obj) ? "PMC" : "Buffer", + PObj_is_any_PMC_TESTALL(obj) ? "PMC" : "Buffer", obj, obj->version); } # endif #endif /* mark it live */ PObj_live_SET(obj); + /* a small PMC might have a custom mark routine */ + if (PObj_is_SPMC_TEST(obj)) { + if (PObj_custom_mark_TEST(obj)) + VTABLE_mark(interpreter, (PMC *)obj); + } /* if object is a PMC and contains buffers or PMCs, then attach * the PMC to the chained mark list */ - if (PObj_is_PMC_TEST(obj)) { + else if (PObj_is_PMC_TEST(obj)) { UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG | PObj_custom_mark_FLAG; if ( (PObj_get_FLAGS(obj) & mask) || ((PMC*)obj)->metadata) { @@ -349,7 +354,7 @@ b, b->bufstart); #endif /* if object is a PMC and needs destroying */ - if (PObj_is_PMC_TEST(b)) { + if (PObj_is_any_PMC_TESTALL(b)) { /* then destroy it here, add_free_pmc is called from * more_objects too */ @@ -528,6 +533,11 @@ header_pool = interpreter->arena_base->pmc_pool; free_unused_pobjects(interpreter, header_pool); total_free += header_pool->num_free_objects; + + header_pool = interpreter->arena_base->spmc_pool; + free_unused_pobjects(interpreter, header_pool); + total_free += header_pool->num_free_objects; + /* And unused buffers on the free list */ for (j = 0; j < (INTVAL)interpreter->arena_base->num_sized; j++) { --- parrot/headers.c Mon Jan 13 18:05:14 2003 +++ parrot-leo/headers.c Fri May 23 14:31:59 2003 @@ -16,14 +16,17 @@ #include "parrot/parrot.h" #define GC_DEBUG_PMC_HEADERS_PER_ALLOC 1 +#define GC_DEBUG_SPMC_HEADERS_PER_ALLOC 1 #define GC_DEBUG_BUFFER_HEADERS_PER_ALLOC 1 #define GC_DEBUG_STRING_HEADERS_PER_ALLOC 1 #ifndef GC_IS_MALLOC # define PMC_HEADERS_PER_ALLOC 512 +# define SPMC_HEADERS_PER_ALLOC 512 # define BUFFER_HEADERS_PER_ALLOC 256 # define STRING_HEADERS_PER_ALLOC 256 #else /* GC_IS_MALLOC */ # define PMC_HEADERS_PER_ALLOC 512 +# define SPMC_HEADERS_PER_ALLOC 512 # define BUFFER_HEADERS_PER_ALLOC 512 # define STRING_HEADERS_PER_ALLOC 512 #endif /* GC_IS_MALLOC */ @@ -44,6 +47,15 @@ return pmc; } +void * +get_free_spmc(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool) +{ + SPMC *pmc = get_free_object(interpreter, pool); + + /* clear flags, set is_SPMC_FLAG */ + PObj_flags_SETTO(pmc, PObj_is_SPMC_FLAG); + return pmc; +} /** Buffer Header Functions for small-object lookup table **/ void * @@ -76,6 +88,20 @@ return pmc_pool; } +struct Small_Object_Pool * +new_spmc_pool(struct Parrot_Interp *interpreter) +{ + int num_headers = GC_DEBUG(interpreter) ? + GC_DEBUG_SPMC_HEADERS_PER_ALLOC : SPMC_HEADERS_PER_ALLOC; + struct Small_Object_Pool *pmc_pool = + new_small_object_pool(interpreter, sizeof(SPMC), num_headers); + + pmc_pool->more_objects = more_traceable_objects; + pmc_pool->get_free_object = get_free_spmc; + pmc_pool->mem_pool = NULL; + return pmc_pool; +} + /* Creates a new pool for buffer-like structures. * Usually you would need make_bufferlike_pool. */ @@ -169,6 +195,12 @@ return get_free_pmc(interpreter, interpreter->arena_base->pmc_pool); } +PMC * +new_spmc_header(struct Parrot_Interp *interpreter) +{ + return get_free_spmc(interpreter, interpreter->arena_base->spmc_pool); +} + STRING * new_string_header(struct Parrot_Interp *interpreter, UINTVAL flags) { @@ -324,6 +356,7 @@ /* Init the PMC header pool */ interpreter->arena_base->pmc_pool = new_pmc_pool(interpreter); + interpreter->arena_base->spmc_pool = new_spmc_pool(interpreter); interpreter->arena_base->constant_pmc_pool = new_pmc_pool(interpreter); interpreter->arena_base->constant_pmc_pool->objects_per_alloc = CONSTANT_PMC_HEADERS_PER_ALLOC; @@ -344,9 +377,11 @@ start = 2; #endif for (i = start; i <= 2; i++) { - for (j = -3; j < (INTVAL)interpreter->arena_base->num_sized; j++) { - if (j == -3) + for (j = -4; j < (INTVAL)interpreter->arena_base->num_sized; j++) { + if (j == -4) pool = interpreter->arena_base->constant_pmc_pool; + else if (j == -3) + pool = interpreter->arena_base->spmc_pool; else if (j == -2) pool = interpreter->arena_base->pmc_pool; else if (j == -1) --- parrot/include/parrot/headers.h Mon Dec 30 11:47:26 2002 +++ parrot-leo/include/parrot/headers.h Fri May 23 13:34:54 2003 @@ -27,6 +27,10 @@ struct Small_Object_Pool *pool, void *pmc); void *get_free_pmc(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool); +void *get_free_spmc(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool); +void *get_free_spmc(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool); void alloc_pmcs(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool); @@ -38,6 +42,7 @@ /* pool creation and access functions */ struct Small_Object_Pool *new_pmc_pool(struct Parrot_Interp *interpreter); +struct Small_Object_Pool *new_spmc_pool(struct Parrot_Interp *interpreter); struct Small_Object_Pool *new_bufferlike_pool(struct Parrot_Interp *interpreter, size_t unit_size); struct Small_Object_Pool *new_buffer_pool(struct Parrot_Interp *interpreter); struct Small_Object_Pool *new_string_pool(struct Parrot_Interp *interpreter, INTVAL constant); @@ -46,6 +51,7 @@ struct Small_Object_Pool *make_bufferlike_pool(struct Parrot_Interp *interpreter, size_t unit_size); /* header creation functions */ PMC *new_pmc_header(struct Parrot_Interp *interpreter); +PMC *new_spmc_header(struct Parrot_Interp *interpreter); STRING *new_string_header(struct Parrot_Interp *interpreter, UINTVAL flags); Buffer *new_buffer_header(struct Parrot_Interp *interpreter); void *new_bufferlike_header(struct Parrot_Interp *interpreter, size_t size); --- parrot/include/parrot/parrot.h Wed May 14 10:06:39 2003 +++ parrot-leo/include/parrot/parrot.h Fri May 23 14:10:23 2003 @@ -176,6 +176,7 @@ * turning on GC_DEBUG should help make the problem appear with smaller data * samples by reducing various numbers, and causing DOD and allocation runs * to occur more frequently. It does significantly reduce performance. */ +#define DISABLE_GC_DEBUG 1 #ifndef DISABLE_GC_DEBUG # define DISABLE_GC_DEBUG 0 #endif --- parrot/include/parrot/pmc.h Sat Jan 11 12:01:03 2003 +++ parrot-leo/include/parrot/pmc.h Fri May 23 13:26:55 2003 @@ -25,6 +25,7 @@ PMC *pmc_new_init(struct Parrot_Interp *interpreter, INTVAL base_type, PMC *p); PMC *constant_pmc_new_noinit(struct Parrot_Interp *, INTVAL base_type); +SPMC *spmc_new_noinit(struct Parrot_Interp *interpreter, INTVAL base_type); #endif --- parrot/include/parrot/pobj.h Fri May 23 10:02:42 2003 +++ parrot-leo/include/parrot/pobj.h Fri May 23 14:01:44 2003 @@ -60,6 +60,10 @@ INTVAL language; }; +typedef struct SPMC { + pobj_t obj; + VTABLE *vtable; +} SPMC; /* cache.* is intended to just be *shortcuts* to*/ /* commonly-accessed data, *not* pointers to */ /* completely different data. That's why it's */ @@ -117,8 +121,8 @@ PObj_is_string_FLAG = 1 << 8, /* PObj is a PMC */ PObj_is_PMC_FLAG = 1 << 9, - PObj_is_reserved1_FLAG = 1 << 10, - PObj_is_reserved2_FLAG = 1 << 11, + PObj_is_SPMC_FLAG = 1 << 10, + PObj_is_reserved_FLAG = 1 << 11, /* Memory management FLAGs */ @@ -258,6 +262,7 @@ #define PObj_is_buffer_ptr_CLEAR(o) PObj_special_CLEAR(is_buffer_ptr, o) #define PObj_custom_mark_SET(o) PObj_special_SET(custom_mark, o) +#define PObj_custom_mark_TEST(o) PObj_flag_TEST(custom_mark, o) #define PObj_custom_mark_CLEAR(o) PObj_special_CLEAR(custom_mark, o) #define PObj_active_destroy_SET(o) PObj_flag_SET(active_destroy, o) --- parrot/include/parrot/resources.h Sat Jan 11 12:01:03 2003 +++ parrot-leo/include/parrot/resources.h Fri May 23 13:07:09 2003 @@ -56,6 +56,7 @@ struct Memory_Pool *constant_string_pool; struct Small_Object_Pool *string_header_pool; struct Small_Object_Pool *pmc_pool; + struct Small_Object_Pool *spmc_pool; struct Small_Object_Pool *constant_pmc_pool; struct Small_Object_Pool *buffer_header_pool; struct Small_Object_Pool *constant_string_header_pool; --- parrot/interpreter.c Sun May 18 12:04:43 2003 +++ parrot-leo/interpreter.c Fri May 23 13:12:38 2003 @@ -732,6 +732,8 @@ case ACTIVE_PMCS: ret = interpreter->arena_base->pmc_pool->total_objects - interpreter->arena_base->pmc_pool->num_free_objects; + ret += interpreter->arena_base->spmc_pool->total_objects - + interpreter->arena_base->spmc_pool->num_free_objects; break; case ACTIVE_BUFFERS: ret = 0; @@ -744,6 +746,7 @@ break; case TOTAL_PMCS: ret = interpreter->arena_base->pmc_pool->total_objects; + ret += interpreter->arena_base->spmc_pool->total_objects; break; case TOTAL_BUFFERS: ret = 0; --- parrot/pmc.c Mon May 19 15:07:49 2003 +++ parrot-leo/pmc.c Fri May 23 13:48:51 2003 @@ -29,8 +29,20 @@ PMC * pmc_new(struct Parrot_Interp *interpreter, INTVAL base_type) { - PMC *pmc = pmc_new_noinit(interpreter, base_type); + SPMC *spmc; + PMC *pmc; + switch (base_type) { + case enum_class_PerlInt: + case enum_class_PerlString: + case enum_class_PerlNum: + case enum_class_PerlUndef: + spmc = spmc_new_noinit(interpreter, base_type); + VTABLE_init(interpreter, (PMC*) spmc); + return (PMC *) spmc; + default: + pmc = pmc_new_noinit(interpreter, base_type); VTABLE_init(interpreter, pmc); + } return pmc; } @@ -59,6 +71,30 @@ return pmc; } +static SPMC* +get_new_spmc_header(struct Parrot_Interp *interpreter, INTVAL base_type, + struct Small_Object_Pool *pool) +{ + SPMC *pmc = get_free_spmc(interpreter, pool); + + if (!pmc) { + internal_exception(ALLOCATION_ERROR, + "Parrot VM: PMC allocation failed!\n"); + return NULL; + } + + pmc->vtable = &(Parrot_base_vtables[base_type]); + + if (!pmc->vtable || !pmc->vtable->init) { + /* This is usually because you either didn't call init_world early + * enough or you added a new PMC class without adding + * Parrot_(classname)_class_init to init_world. */ + PANIC("Null vtable used"); + return NULL; + } + + return pmc; +} /*=for api pmc pmc_new_noinit Creates a new PMC of type C (which is an index into the @@ -73,10 +109,24 @@ PMC * pmc_new_noinit(struct Parrot_Interp *interpreter, INTVAL base_type) { + switch (base_type) { + case enum_class_PerlInt: + case enum_class_PerlString: + case enum_class_PerlNum: + case enum_class_PerlUndef: + return (PMC *) get_new_spmc_header(interpreter, base_type, + interpreter->arena_base->spmc_pool); + } return get_new_pmc_header(interpreter, base_type, interpreter->arena_base->pmc_pool); } +SPMC * +spmc_new_noinit(struct Parrot_Interp *interpreter, INTVAL base_type) +{ + return get_new_spmc_header(interpreter, base_type, + interpreter->arena_base->spmc_pool); +} /*=for api pmc constant_pmc_new_noinit Creates a new constant PMC of type C