--- parrot/classes/default.pmc Mon May 19 15:07:49 2003 +++ parrot-leo/classes/default.pmc Sat May 24 11:09:12 2003 @@ -48,7 +48,7 @@ PMC* getprop(STRING* key) { PMC* p_key = key_new_string(interpreter, key); - if (SELF->metadata) { + if (SELF->pmc_ext && SELF->metadata) { return (VTABLE_get_pmc_keyed(interpreter, SELF->metadata, p_key)); } else { PMC* undef = pmc_new(INTERP, enum_class_PerlUndef); @@ -59,11 +59,13 @@ void setprop(STRING* key, PMC* value) { PMC* p_key; - if (SELF->metadata) { + if (SELF->pmc_ext && SELF->metadata) { p_key = key_new_string(interpreter, key); VTABLE_set_pmc_keyed(interpreter, SELF->metadata, p_key, value, NULL); } else { + if (!SELF->pmc_ext) + SELF->pmc_ext = new_pmc_ext(INTERP); /* first make new hash */ SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash); VTABLE_init(interpreter, SELF->metadata); @@ -76,7 +78,7 @@ } void delprop(STRING* key) { - if (SELF->metadata) { + if (SELF->pmc_ext && SELF->metadata) { PMC* p_key = key_new_string(interpreter, key); VTABLE_delete_keyed(interpreter, SELF->metadata, p_key); } @@ -84,6 +86,8 @@ } PMC* getprops() { + if (!SELF->pmc_ext) + SELF->pmc_ext = new_pmc_ext(INTERP); if (!SELF->metadata) { SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash); VTABLE_init(interpreter, SELF->metadata); --- parrot/dod.c Wed May 21 16:59:10 2003 +++ parrot-leo/dod.c Sat May 24 11:33:29 2003 @@ -55,16 +55,16 @@ /* 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)) { - 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) { + if (PObj_is_special_PMC_TEST(obj)) { + if (((PMC*)obj)->pmc_ext) { /* put it on the end of the list */ interpreter->mark_ptr->next_for_GC = (PMC *)obj; /* Explicitly make the tail of the linked list be * self-referential */ interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj; } + else if (PObj_custom_mark_TEST(obj)) + VTABLE_mark(interpreter, (PMC *) obj); return; } #if GC_VERBOSE @@ -355,6 +355,12 @@ */ if (PObj_active_destroy_TEST(b)) VTABLE_destroy(interpreter, (PMC *)b); + if (((PMC *) b)->pmc_ext) { + struct Small_Object_Pool *ext_pool = + interpreter->arena_base->pmc_ext_pool; + ext_pool->add_free_object(interpreter, ext_pool, + ((PMC *)b)->pmc_ext); + } } /* else object is a buffer(like) */ else if (PObj_sysmem_TEST(b) && b->bufstart) { --- parrot/headers.c Mon Jan 13 18:05:14 2003 +++ parrot-leo/headers.c Sat May 24 11:36:34 2003 @@ -39,8 +39,7 @@ /* clear flags, set is_PMC_FLAG */ PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG); ((PMC *)pmc)->data = NULL; - ((PMC *)pmc)->metadata = NULL; - ((PMC *)pmc)->synchronize = NULL; + ((PMC *)pmc)->pmc_ext = NULL; return pmc; } @@ -169,6 +168,29 @@ return get_free_pmc(interpreter, interpreter->arena_base->pmc_pool); } + +PMC_EXT * +new_pmc_ext(struct Parrot_Interp *interpreter) +{ + struct Small_Object_Pool *pool = interpreter->arena_base->pmc_ext_pool; + void *ptr; + if (!pool->free_list) + (*pool->alloc_objects) (interpreter, pool); + + ptr = pool->free_list; + pool->free_list = *(void **)ptr; + memset(ptr, 0, sizeof(PMC_EXT)); + return ptr; +} + +static void +add_free_ext(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool, void *to_add) +{ + *(void **)to_add = pool->free_list; + pool->free_list = to_add; +} + STRING * new_string_header(struct Parrot_Interp *interpreter, UINTVAL flags) { @@ -324,6 +346,9 @@ /* Init the PMC header pool */ interpreter->arena_base->pmc_pool = new_pmc_pool(interpreter); + interpreter->arena_base->pmc_ext_pool = + new_small_object_pool(interpreter, sizeof(struct PMC_EXT), 1024); + interpreter->arena_base->pmc_ext_pool->add_free_object = add_free_ext; interpreter->arena_base->constant_pmc_pool = new_pmc_pool(interpreter); interpreter->arena_base->constant_pmc_pool->objects_per_alloc = CONSTANT_PMC_HEADERS_PER_ALLOC; @@ -381,6 +406,14 @@ } } + pool = interpreter->arena_base->pmc_ext_pool; + for (cur_arena = pool->last_Arena; cur_arena;) { + next = cur_arena->prev; + mem_sys_free(cur_arena->start_objects); + mem_sys_free(cur_arena); + cur_arena = next; + } + mem_sys_free(interpreter->arena_base->pmc_ext_pool); mem_sys_free(interpreter->arena_base->sized_header_pools); } --- parrot/include/parrot/headers.h Mon Dec 30 11:47:26 2002 +++ parrot-leo/include/parrot/headers.h Sat May 24 10:13:48 2003 @@ -46,6 +46,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_EXT *new_pmc_ext(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/pobj.h Fri May 23 10:02:42 2003 +++ parrot-leo/include/parrot/pobj.h Sat May 24 10:54:07 2003 @@ -68,7 +68,11 @@ pobj_t obj; VTABLE *vtable; DPOINTER *data; - PMC *metadata; + struct PMC_EXT *pmc_ext; +}; + +struct PMC_EXT { + PMC *metadata; /* properties */ SYNC *synchronize; /* This flag determines the next PMC in the 'used' list during @@ -77,24 +81,26 @@ guaranteed to have the tail element's next_for_GC point to itself, which makes much of the logic and checks simpler. We then have to check for PMC->next_for_GC == PMC to find the end of list. */ - PMC *next_for_GC; /* Yeah, the GC data should be out of - band, but that makes things really - slow when actually marking things for - the GC runs. Unfortunately putting - this here makes marking things clear - for the GC pre-run slow as well, as - we need to touch all the PMC - structs. (Though we will for flag - setting anyway) We can potentially - make this a pointer to the real GC - stuff, which'd merit an extra - dereference when setting, but let us - memset the actual GC data in a big - block */ + PMC *next_for_GC; + + /* Yeah, the GC data should be out of + band, but that makes things really slow when actually marking + things for the GC runs. Unfortunately putting this here makes + marking things clear for the GC pre-run slow as well, as we need + to touch all the PMC structs. (Though we will for flag setting + anyway) We can potentially make this a pointer to the real GC + stuff, which'd merit an extra dereference when setting, but let + us memset the actual GC data in a big block + */ }; +typedef struct PMC_EXT PMC_EXT; + /* macro for accessing union data */ #define cache obj.u +#define metadata pmc_ext->metadata +#define next_for_GC pmc_ext->next_for_GC +#define synchronize pmc_ext->synchronize /* PObj flags */ typedef enum PObj_enum { @@ -244,9 +250,12 @@ } while(0) #define PObj_special_CLEAR(flag, o) do { \ PObj_flag_CLEAR(flag, o); \ - if ((PObj_get_FLAGS(o) & (PObj_active_destroy_FLAG | PObj_is_PMC_ptr_FLAG | \ + if ((PObj_get_FLAGS(o) & \ + (PObj_active_destroy_FLAG | PObj_is_PMC_ptr_FLAG | \ PObj_is_buffer_ptr_FLAG)) || \ - (PObj_is_PMC_TEST(o) && ((struct PMC*)(o))->metadata)) \ + (PObj_is_PMC_TEST(o) && \ + ((struct PMC*)(o))->pmc_ext && \ + ((struct PMC*)(o))->metadata)) \ PObj_flag_SET(is_special_PMC, o); \ else \ PObj_flag_CLEAR(is_special_PMC, o); \ @@ -259,6 +268,7 @@ #define PObj_custom_mark_SET(o) PObj_special_SET(custom_mark, o) #define PObj_custom_mark_CLEAR(o) PObj_special_CLEAR(custom_mark, o) +#define PObj_custom_mark_TEST(o) PObj_flag_TEST(custom_mark, o) #define PObj_active_destroy_SET(o) PObj_flag_SET(active_destroy, o) #define PObj_active_destroy_TEST(o) PObj_flag_TEST(active_destroy, o) --- parrot/include/parrot/resources.h Sat Jan 11 12:01:03 2003 +++ parrot-leo/include/parrot/resources.h Sat May 24 10:17:10 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 *pmc_ext_pool; struct Small_Object_Pool *constant_pmc_pool; struct Small_Object_Pool *buffer_header_pool; struct Small_Object_Pool *constant_string_header_pool; --- parrot/include/parrot/smallobject.h Sat Dec 21 11:08:08 2002 +++ parrot-leo/include/parrot/smallobject.h Fri May 23 16:21:51 2003 @@ -18,6 +18,8 @@ size_t objects_per_alloc; size_t total_objects; size_t num_free_objects; /* number of resources in the free pool */ + size_t last_free_objects; /* number of previous free */ + int skip; size_t replenish_level; void *free_list; UINTVAL align_1; /* alignment (must be power of 2) minus one */ --- parrot/jit_debug.c Thu May 1 10:06:05 2003 +++ parrot-leo/jit_debug.c Sat May 24 11:40:44 2003 @@ -148,8 +148,10 @@ i + 3, BIT_OFFSET(PMC, vtable), BIT_SIZE(void*)); fprintf(stabs, "data:(0,14),%d,%d;", BIT_OFFSET(PMC, data), BIT_SIZE(void*)); +#if 0 fprintf(stabs, "metadata:*(0,%d),%d,%d;", i, BIT_OFFSET(PMC, metadata), BIT_SIZE(void*)); +#endif fprintf(stabs, ";\""); fprintf(stabs, "," N_LSYM ",0,0,0\n"); --- parrot/languages/imcc/cfg.c Thu May 22 15:49:51 2003 +++ parrot-leo/languages/imcc/cfg.c Fri May 23 18:46:21 2003 @@ -554,20 +554,51 @@ */ void compute_dominators () { +#define USE_BFS 1 + +#if !USE_BFS int i, change, pred_index; +#else + int i, cur, len, succ_index; + int *q; + Set *visited; +#endif + Edge *edge; info(2, "compute_dominators\n"); dominators = malloc(sizeof(Set*) * n_basic_blocks); + dominators[0] = set_make (n_basic_blocks); set_add(dominators[0], 0); for (i=1; i < n_basic_blocks; i++) { dominators[i] = set_make_full (n_basic_blocks); } +#if USE_BFS + q = calloc(n_basic_blocks, sizeof(int)); + visited = set_make (n_basic_blocks); + set_add(visited, 0); + len=1; + cur=0; + + while(cur < len) { + for(edge = bb_list[q[cur]]->succ_list; edge; edge = edge->succ_next) { + succ_index = edge->to->index; + set_intersec_inplace(dominators[succ_index], dominators[q[cur]]); + set_add(dominators[succ_index],succ_index); + + if(!set_contains(visited, succ_index)) { + set_add(visited, succ_index); + q[len++] = succ_index; + } + } + cur++; + } +#else change = 1; - while (change) { + while(change) { change = 0; /* TODO: This 'for' should be a breadth-first search for speed */ @@ -576,7 +607,6 @@ for (edge=bb_list[i]->pred_list; edge; edge=edge->pred_next) { pred_index = edge->from->index; - set_intersec_inplace(s, dominators[pred_index]); } @@ -591,10 +621,13 @@ set_free(s); } } - +#endif if (IMCC_DEBUG & DEBUG_CFG) dump_dominators(); - +#if USE_BFS + free(q); + set_free(visited); +#endif } static void free_dominators(void) --- parrot/list.c Mon May 19 15:07:49 2003 +++ parrot-leo/list.c Fri May 23 18:44:59 2003 @@ -50,7 +50,7 @@ * - Error checking for out of bounds access is minimal, caller knows * better, what should be done. * - * - List structure itself is ifferent from List_chunk, implying: + * - List structure itself is different from List_chunk, implying: * - end of list is not list->prev but list->end * - start of list is list->first * - the list of chunks is not closed, detecting the end is more simple @@ -311,8 +311,25 @@ /* two adjacent irregular chunks */ if (prev && (prev->flags & no_power_2) && (chunk->flags & no_power_2)) { - /* TODO don't make chunks bigger then MAX_ITEMS, no - make then - * but: if bigger, split them in a next pass */ + /* DONE don't make chunks bigger then MAX_ITEMS, no - make then + * but: if bigger, split them in a next pass + * TODO test the logic that solves the above problem */ + if(prev->items + chunk->items > MAX_ITEMS) { + Parrot_reallocate(interpreter, (Buffer *)prev, + MAX_ITEMS * list->item_size); + mem_sys_memmove( + (char *)prev->data.bufstart + + prev->items * list->item_size, + (char *)chunk->data.bufstart, + (MAX_ITEMS - prev->items) * list->item_size); + mem_sys_memmove( + (char *)chunk->data.bufstart, + (char *)chunk->data.bufstart + + (MAX_ITEMS - prev->items) * list->item_size, + (chunk->items - (MAX_ITEMS - prev->items)) * list->item_size); + chunk->items = chunk->items - (MAX_ITEMS - prev->items); + prev->items = MAX_ITEMS; + } else { Parrot_reallocate(interpreter, (Buffer *)prev, (prev->items + chunk->items) * list->item_size); mem_sys_memmove( @@ -322,6 +339,7 @@ chunk->items * list->item_size); prev->items += chunk->items; chunk->items = 0; + } changes++; continue; } --- parrot/pmc.c Mon May 19 15:07:49 2003 +++ parrot-leo/pmc.c Sat May 24 10:21:22 2003 @@ -73,8 +73,22 @@ PMC * pmc_new_noinit(struct Parrot_Interp *interpreter, INTVAL base_type) { - return get_new_pmc_header(interpreter, base_type, + PMC *pmc = get_new_pmc_header(interpreter, base_type, interpreter->arena_base->pmc_pool); + switch (base_type) { + case enum_class_PerlInt: + case enum_class_PerlNum: + case enum_class_PerlString: + case enum_class_PerlUndef: + break; + default: + /* TODO optimize this, mainly only aggregates need + * the extra header part + */ + pmc->pmc_ext = new_pmc_ext(interpreter); + break; + } + return pmc; } /*=for api pmc constant_pmc_new_noinit --- parrot/smallobject.c Mon Jan 13 18:05:14 2003 +++ parrot-leo/smallobject.c Sat May 24 11:44:54 2003 @@ -45,10 +45,19 @@ more_traceable_objects(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool) { + if (pool->skip) + pool->skip = 0; + else { Parrot_do_dod_run(interpreter); + if (pool->num_free_objects <= pool->replenish_level) + pool->skip = 1; + /* pool->last_free_objects = pool->num_free_objects; */ + } + /* requires that num_free_objects be updated in Parrot_do_dod_run. If dod * is disabled, then we must check the free list directly. */ - if (!pool->free_list || pool->num_free_objects <= pool->replenish_level) { + if (!pool->free_list) { + /* pool->last_free_objects += pool->objects_per_alloc; */ (*pool->alloc_objects) (interpreter, pool); } } @@ -133,7 +142,7 @@ /* Move all the new objects into the free list */ object = new_arena->start_objects; for (i = 0; i < pool->objects_per_alloc; i++) { - add_free_object (interpreter, pool, object); + pool->add_free_object (interpreter, pool, object); object = (void *)((char *)object + pool->object_size); } pool->total_objects += pool->objects_per_alloc;