? .swp ? gmon.out ? life.pbc ? life5k.pbc ? patch ? patch2 ? test ? z1 ? z2 ? z3 ? zcompile.sh ? languages/perl6/a.warn ? languages/perl6/perl6-config ? languages/perl6/z.pl ? t/src/basic_1. ? t/src/basic_1.c ? t/src/basic_2. ? t/src/basic_2.c Index: dod.c =================================================================== RCS file: /cvs/public/parrot/dod.c,v retrieving revision 1.21 diff -u -r1.21 dod.c --- dod.c 23 Aug 2002 07:53:35 -0000 1.21 +++ dod.c 26 Aug 2002 20:19:12 -0000 @@ -21,21 +21,34 @@ static size_t find_common_mask(size_t val1, size_t val2); +#ifdef African_Grey +PMC * +mark_used(struct Parrot_Interp *interpreter, + PMC *used_pmc, PMC *current_end_of_list) +#else PMC * mark_used(PMC *used_pmc, PMC *current_end_of_list) +#endif { /* If the PMC we've been handed has already been marked as live * (ie we put it on the list already) we just return. Otherwise we * could get in some nasty loops */ +#ifdef African_Grey + if (used_pmc->next_for_GC && used_pmc->last_seen == interpreter->cycle) { +#else /* Also, be sure to check that we don't mark PMCs that are already * part of the free list. This can happen with a conservative marking * routine which marks dead PMCs as live, such as a C stack walk */ if (used_pmc->next_for_GC || used_pmc->flags & PMC_on_free_list_FLAG) { +#endif return current_end_of_list; } /* First, mark the PMC itself as used */ used_pmc->flags |= PMC_live_FLAG; +#ifdef African_Grey + used_pmc->last_seen = interpreter->cycle; +#endif /* Now put it on the end of the list */ current_end_of_list->next_for_GC = used_pmc; @@ -69,9 +82,10 @@ last = current = interpreter->perl_stash->stash_hash; /* mark it as used and get an updated end of list */ - last = mark_used(current, last); + last = mark_used(GREY_INTERP current, last); /* Find important stuff on the system stack */ +#ifndef African_Grey #if GC_DEBUG CONSERVATIVE_POINTER_CHASING = 1; last = trace_system_stack(interpreter,last); @@ -79,19 +93,20 @@ #else last = trace_system_stack(interpreter,last); #endif +#endif /* Now, go run through the PMC registers and mark them as live */ /* First mark the current set. */ for (i = 0; i < NUM_REGISTERS; i++) { if (interpreter->ctx.pmc_reg.registers[i]) { - last = mark_used(interpreter->ctx.pmc_reg.registers[i], last); + last = mark_used(GREY_INTERP interpreter->ctx.pmc_reg.registers[i], last); } } /* Walk through the stashes */ stash = interpreter->perl_stash; while (stash) { - last = mark_used(stash->stash_hash, last); + last = mark_used(GREY_INTERP stash->stash_hash, last); stash = stash->parent_stash; } @@ -102,7 +117,7 @@ for (j = 0; j < cur_chunk->used; j++) { for (i = 0; i < NUM_REGISTERS; i++) { if (cur_chunk->PReg[j].registers[i]) { - last = mark_used(cur_chunk->PReg[j].registers[i], last); + last = mark_used(GREY_INTERP cur_chunk->PReg[j].registers[i], last); } } } @@ -112,12 +127,12 @@ cur_stack = interpreter->ctx.pad_stack; while (cur_stack) { if (cur_stack->buffer) { - buffer_lives(cur_stack->buffer); + buffer_lives(GREY_INTERP cur_stack->buffer); entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart); for (i = 0; i < cur_stack->used; i++) { if (STACK_ENTRY_PMC == entry[i].entry_type && entry[i].entry.pmc_val) { - last = mark_used(entry[i].entry.pmc_val, last); + last = mark_used(GREY_INTERP entry[i].entry.pmc_val, last); } } } @@ -129,13 +144,13 @@ while (cur_stack) { if(cur_stack->buffer){ - buffer_lives(cur_stack->buffer); + buffer_lives(GREY_INTERP cur_stack->buffer); entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart); for (i = 0; i < cur_stack->used; i++) { if (STACK_ENTRY_PMC == entry[i].entry_type && entry[i].entry.pmc_val) { - last = mark_used(entry[i].entry.pmc_val, last); + last = mark_used(GREY_INTERP entry[i].entry.pmc_val, last); } } } @@ -147,13 +162,13 @@ while (cur_stack) { if(cur_stack->buffer){ - buffer_lives(cur_stack->buffer); + buffer_lives(GREY_INTERP cur_stack->buffer); entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart); for (i = 0; i < cur_stack->used; i++) { if (STACK_ENTRY_PMC == entry[i].entry_type && entry[i].entry.pmc_val) { - last = mark_used(entry[i].entry.pmc_val, last); + last = mark_used(GREY_INTERP entry[i].entry.pmc_val, last); } } } @@ -175,12 +190,12 @@ if (bits) { if (bits == PMC_is_PMC_ptr_FLAG) { if (current->data) { - last = mark_used(current->data, last); + last = mark_used(GREY_INTERP current->data, last); } } else if (bits == PMC_is_buffer_ptr_FLAG) { if (current->data) { - buffer_lives(current->data); + buffer_lives(GREY_INTERP current->data); } } else if (bits == (PMC_is_buffer_ptr_FLAG | PMC_is_PMC_ptr_FLAG)) { @@ -189,10 +204,10 @@ if (trace_buf) { PMC **cur_pmc = trace_buf->bufstart; /* Mark the damn buffer as used! */ - buffer_lives(trace_buf); - for (i = 0; i < trace_buf->buflen / sizeof(*cur_pmc); i++){ + buffer_lives(GREY_INTERP trace_buf); + for (i = 0; i < trace_buf->buflen / sizeof(*cur_pmc); i++) { if (cur_pmc[i]) { - last = mark_used(cur_pmc[i], last); + last = mark_used(GREY_INTERP cur_pmc[i], last); } } } @@ -222,15 +237,15 @@ * assumption, but it'll do for now */ for (i = 0; i < NUM_REGISTERS; i++) { if (interpreter->ctx.string_reg.registers[i]) { - buffer_lives((Buffer *)interpreter->ctx.string_reg.registers[i]); + buffer_lives(GREY_INTERP (Buffer *)interpreter->ctx.string_reg.registers[i]); } } /* The interpreter has a few strings of its own */ if (interpreter->current_file) - buffer_lives((Buffer*)interpreter->current_file); + buffer_lives(GREY_INTERP (Buffer*)interpreter->current_file); if (interpreter->current_package) - buffer_lives((Buffer*)interpreter->current_package); + buffer_lives(GREY_INTERP (Buffer*)interpreter->current_package); /* Now walk the string stack. Make sure to walk from top down * since stack may have segments above top that we shouldn't walk. */ @@ -239,7 +254,7 @@ for (j = 0; j < cur_chunk->used; j++) { for (i = 0; i < NUM_REGISTERS; i++) { if (cur_chunk->SReg[j].registers[i]) { - buffer_lives((Buffer *)cur_chunk->SReg[j].registers[i]); + buffer_lives(GREY_INTERP (Buffer *)cur_chunk->SReg[j].registers[i]); } } } @@ -250,12 +265,12 @@ /* The general stack's circular, so we need to be careful */ while (cur_stack) { if(cur_stack->buffer){ - buffer_lives(cur_stack->buffer); + buffer_lives(GREY_INTERP cur_stack->buffer); entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart); for (i = 0; i < cur_stack->used; i++) { if (STACK_ENTRY_STRING == entry[i].entry_type && entry[i].entry.string_val) { - buffer_lives((Buffer *)entry[i].entry.string_val); + buffer_lives(GREY_INTERP (Buffer *)entry[i].entry.string_val); } } } @@ -267,7 +282,7 @@ cur_stack = interpreter->ctx.control_stack; while (cur_stack) { if(cur_stack->buffer){ - buffer_lives(cur_stack->buffer); + buffer_lives(GREY_INTERP cur_stack->buffer); } cur_stack = cur_stack->prev; @@ -275,14 +290,29 @@ } /* Free up any PMCs that aren't in use */ +#ifdef African_Grey +void +free_unused_PMCs(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool) +#else static void free_unused_PMCs(struct Parrot_Interp *interpreter) +#endif { struct Small_Object_Arena *cur_arena; UINTVAL i, total_used = 0; +#ifndef African_Grey + struct Small_Object_Pool *pool = interpreter->arena_base->pmc_pool; +#endif +#ifdef African_Grey + if (pool->last_free_run >= interpreter->last_dod_run) { + Parrot_do_dod_run(interpreter); + } +#endif + /* Run through all the buffer header pools and mark */ - for (cur_arena = interpreter->arena_base->pmc_pool->last_Arena; + for (cur_arena = /*interpreter->arena_base->pmc_*/pool->last_Arena; NULL != cur_arena; cur_arena = cur_arena->prev) { PMC *pmc_array = cur_arena->start_objects; @@ -292,9 +322,13 @@ * on_free_list and live, because of our conservative stack-walk * collection. We must be wary of this case. */ if (!(pmc_array[i].flags & (PMC_live_FLAG | PMC_on_free_list_FLAG | - PMC_constant_FLAG))) { + PMC_constant_FLAG)) +#ifdef African_Grey + && pmc_array[i].last_seen < interpreter->last_dod_run +#endif + ) { add_free_pmc(interpreter, - interpreter->arena_base->pmc_pool, + /*interpreter->arena_base->pmc_*/pool, &pmc_array[i]); } else if(!(pmc_array[i].flags & PMC_on_free_list_FLAG)) { total_used++; @@ -304,13 +338,21 @@ } } interpreter->active_PMCs += total_used; +#ifndef African_Grey interpreter->arena_base->pmc_pool->num_free_objects = interpreter->arena_base->pmc_pool->total_objects - total_used; +#endif +#ifdef African_Grey + pool->last_free_run = interpreter->cycle; +#endif } /* Put any buffers that are now unused, on to the free list * Avoid buffers that are immune from collection (ie, constant) */ -static void +#ifndef African_Grey +static +#endif +void free_unused_buffers(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool) { @@ -318,6 +360,12 @@ UINTVAL i, total_used = 0; UINTVAL object_size = pool->object_size; +#ifdef African_Grey + if (pool->last_free_run >= interpreter->last_dod_run) { + Parrot_do_dod_run(interpreter); + } +#endif + /* Run through all the buffer header pools and mark */ for (cur_arena = pool->last_Arena; NULL != cur_arena; @@ -330,8 +378,11 @@ * collection. We must be wary of this case. */ if (!(b->flags & ( BUFFER_on_free_list_FLAG | BUFFER_constant_FLAG - | BUFFER_live_FLAG ))) - { + | BUFFER_live_FLAG )) +#ifdef African_Grey + && b->last_seen < interpreter->last_dod_run +#endif + ) { if (pool->mem_pool) { if (!(b->flags & BUFFER_COW_FLAG)) { ((struct Memory_Pool *) @@ -341,6 +392,14 @@ ((struct Memory_Pool *) pool->mem_pool)->possibly_reclaimable += b->buflen; } +#ifdef African_Grey + /* unlink from list */ + if (b->prev || b->next) { + b->prev->next = b->next; + b->next->prev = b->prev; + } + interpreter->active_Buffers--; +#endif add_free_buffer(interpreter, pool, b); } else if (!(b->flags & BUFFER_on_free_list_FLAG)) { total_used++; @@ -349,8 +408,13 @@ b = (Buffer *)((char *)b + object_size); } } +#ifndef African_Grey interpreter->active_Buffers += total_used; pool->num_free_objects = pool->total_objects - total_used; +#endif +#ifdef African_Grey + pool->last_free_run = interpreter->cycle; +#endif } #ifndef PLATFORM_STACK_WALK @@ -415,13 +479,13 @@ /* ...so ensure that mark_used checks PMC_on_free_list_FLAG * before adding it to the next_for_GC list, to have * vtable->mark() called. */ - last = mark_used((PMC *)ptr, last); + last = mark_used(GREY_INTERP (PMC *)ptr, last); } else if (buffer_min <= ptr && ptr < buffer_max && is_buffer_ptr(interpreter,(void *)ptr)) { /* ...and since buffer_lives doesn't care about bufstart, * it doesn't really matter if it sets a flag */ - buffer_lives((Buffer *)ptr); + buffer_lives(GREY_INTERP (Buffer *)ptr); } } } @@ -429,7 +493,6 @@ } #endif - /* See if we can find some unused headers */ void Parrot_do_dod_run(struct Parrot_Interp *interpreter) @@ -438,9 +501,18 @@ return; } interpreter->DOD_block_level++; + +#ifdef African_Grey + /* Don't do consecutive DOD runs without an intervening free_unused */ + if (interpreter->last_dod_run == interpreter->cycle) { + free_unused_PMCs(interpreter, interpreter->arena_base->pmc_pool); + } +#endif interpreter->active_PMCs = 0; +#ifndef African_Grey interpreter->active_Buffers = 0; +#endif /* Now go trace the PMCs */ trace_active_PMCs(interpreter); @@ -448,17 +520,24 @@ /* And the buffers */ trace_active_buffers(interpreter); +#ifndef African_Grey /* Now put unused PMCs on the free list */ free_unused_PMCs(interpreter); +#endif +#ifndef African_Grey /* And unused buffers on the free list */ free_unused_buffers(interpreter, interpreter->arena_base->string_header_pool); free_unused_buffers(interpreter, interpreter->arena_base->buffer_header_pool); +#endif /* Note it */ interpreter->dod_runs++; +#ifdef African_Grey + interpreter->last_dod_run = interpreter->cycle; +#endif interpreter->DOD_block_level--; return; Index: hash.c =================================================================== RCS file: /cvs/public/parrot/hash.c,v retrieving revision 1.26 diff -u -r1.26 hash.c --- hash.c 21 Aug 2002 08:00:10 -0000 1.26 +++ hash.c 26 Aug 2002 20:19:13 -0000 @@ -130,10 +130,10 @@ { HashIndex i; - buffer_lives((Buffer *)hash); + buffer_lives(GREY_INTERP (Buffer *)hash); if(hash->bucket_pool) { - buffer_lives(hash->bucket_pool); + buffer_lives(GREY_INTERP hash->bucket_pool); } if (hash->buffer.bufstart == NULL || hash->bucket_pool->bufstart == NULL) { @@ -143,11 +143,11 @@ for (i = 0; i <= hash->max_chain; i++) { HASHBUCKET *bucket = lookupBucket(hash, i); while (bucket) { - buffer_lives((Buffer *)bucket->key); + buffer_lives(GREY_INTERP (Buffer *)bucket->key); if (bucket->value.type == enum_hash_string) - buffer_lives((Buffer *)bucket->value.val.string_val); + buffer_lives(GREY_INTERP (Buffer *)bucket->value.val.string_val); else if (bucket->value.type == enum_hash_pmc) - end_of_used_list = mark_used(bucket->value.val.pmc_val, + end_of_used_list = mark_used(GREY_INTERP bucket->value.val.pmc_val, end_of_used_list); bucket = getBucket(hash, bucket->next); } Index: headers.c =================================================================== RCS file: /cvs/public/parrot/headers.c,v retrieving revision 1.9 diff -u -r1.9 headers.c --- headers.c 23 Aug 2002 07:53:35 -0000 1.9 +++ headers.c 26 Aug 2002 20:19:23 -0000 @@ -56,6 +56,9 @@ pmc->flags = 0; /* Make sure it doesn't seem to be on the GC list */ pmc->next_for_GC = NULL; +#ifdef African_Grey + pmc->last_seen = interpreter->cycle; +#endif return pmc; } @@ -82,6 +85,9 @@ /* Copied from add_free_object */ *(void **)buffer = pool->free_list; pool->free_list = buffer; +#ifdef African_Grey + pool->num_free_objects++; +#endif } void * get_free_buffer(struct Parrot_Interp *interpreter, @@ -89,8 +95,10 @@ { /* Copied from get_free_object */ Buffer *buffer; - if (!pool->free_list) + + if (!pool->free_list) { (*pool->more_objects)(interpreter, pool); + } #if GC_DEBUG else (*pool->more_objects)(interpreter, pool); @@ -101,6 +109,14 @@ /* Don't let it point to garbage memory */ buffer->bufstart = NULL; buffer->flags = BUFFER_selfpoolptr_FLAG; +#ifdef African_Grey + buffer->pool = pool; + buffer->next = buffer->prev = NULL; + buffer->last_seen = interpreter->cycle; + interpreter->active_Buffers++; + pool->num_free_objects--; +#endif + #if GC_DEBUG buffer->version++; #endif @@ -138,6 +154,9 @@ pmc_pool->get_free_object = get_free_pmc; pmc_pool->alloc_objects = alloc_pmcs; pmc_pool->more_objects = more_traceable_objects; +#ifdef African_Grey + pmc_pool->free_unused = free_unused_PMCs; +#endif pmc_pool->mem_pool = interpreter->arena_base->memory_pool; return pmc_pool; } @@ -157,6 +176,9 @@ pool->get_free_object = get_free_buffer; pool->alloc_objects = alloc_buffers; pool->more_objects = more_traceable_objects; +#ifdef African_Grey + pool->free_unused = free_unused_buffers; +#endif pool->mem_pool = interpreter->arena_base->memory_pool; pool->align_1 = BUFFER_ALIGNMENT-1; return pool; @@ -285,6 +307,30 @@ return buffer; } +#ifdef African_Grey +/* Create a new buffer header sharing data with an existing buffer + * Unchecked precondition: offset+length must be within the source buffer */ +Buffer * +new_shared_header(struct Parrot_Interp *interpreter, Buffer *src, + struct Small_Object_Pool *pool, UINTVAL offset, + UINTVAL length) +{ + Buffer *b; + + /* get buffer header from the free pool */ + b = get_free_buffer(interpreter, pool); + /* Point to the right place */ + b->buflen = length; + b->bufstart = (char *)src->bufstart + offset; + /* Link it in bufstart sequence */ + b->prev = src; + b->next = src->next; + b->next->prev = b; + b->prev->next = b; + /* Return it */ + return b; +} +#endif size_t get_max_buffer_address(struct Parrot_Interp *interpreter) Index: interpreter.c =================================================================== RCS file: /cvs/public/parrot/interpreter.c,v retrieving revision 1.98 diff -u -r1.98 interpreter.c --- interpreter.c 23 Aug 2002 07:53:35 -0000 1.98 +++ interpreter.c 26 Aug 2002 20:19:24 -0000 @@ -504,6 +504,9 @@ interpreter->memory_collected = 0; interpreter->DOD_block_level = 1; interpreter->GC_block_level = 1; +#ifdef African_Grey + interpreter->cycle = 0; +#endif /* Set up the memory allocation system */ mem_setup_allocator(interpreter); Index: key.c =================================================================== RCS file: /cvs/public/parrot/key.c,v retrieving revision 1.30 diff -u -r1.30 key.c --- key.c 24 Aug 2002 05:31:20 -0000 1.30 +++ key.c 26 Aug 2002 20:19:24 -0000 @@ -219,12 +219,12 @@ key_mark(struct Parrot_Interp *interpreter, PMC *key, PMC *end_of_used_list) { if ((key->flags & KEY_type_FLAGS) == KEY_string_FLAG) - buffer_lives((Buffer *)key->cache.string_val); + buffer_lives(GREY_INTERP (Buffer *)key->cache.string_val); else if ((key->flags & KEY_type_FLAGS) == KEY_pmc_FLAG) - end_of_used_list = mark_used(key->cache.pmc_val, end_of_used_list); + end_of_used_list = mark_used(GREY_INTERP key->cache.pmc_val, end_of_used_list); if (key->data) - end_of_used_list = mark_used(key->data, end_of_used_list); + end_of_used_list = mark_used(GREY_INTERP key->data, end_of_used_list); return end_of_used_list; } Index: method_util.c =================================================================== RCS file: /cvs/public/parrot/method_util.c,v retrieving revision 1.4 diff -u -r1.4 method_util.c --- method_util.c 22 Aug 2002 17:22:12 -0000 1.4 +++ method_util.c 26 Aug 2002 20:19:24 -0000 @@ -143,23 +143,28 @@ * Mark entries in a stack structure during GC. */ PMC * +#ifdef African_Grey +mark_stack(struct Parrot_Interp *interpreter, + Stack_Chunk_t * cur_stack, PMC * end_of_used_list) +#else mark_stack(Stack_Chunk_t * cur_stack, PMC * end_of_used_list) +#endif { Stack_Entry_t *entry; size_t i; while (cur_stack) { if(cur_stack->buffer){ - buffer_lives(cur_stack->buffer); + buffer_lives(GREY_INTERP cur_stack->buffer); entry = (Stack_Entry_t *)(cur_stack->buffer->bufstart); for (i = 0; i < cur_stack->used; i++) { if (STACK_ENTRY_PMC == entry[i].entry_type && entry[i].entry.pmc_val) { - end_of_used_list = mark_used(entry[i].entry.pmc_val, + end_of_used_list = mark_used(GREY_INTERP entry[i].entry.pmc_val, end_of_used_list); } else if (STACK_ENTRY_STRING == entry[i].entry_type && entry[i].entry.string_val) { - buffer_lives((Buffer *)entry[i].entry.string_val); + buffer_lives(GREY_INTERP (Buffer *)entry[i].entry.string_val); } } } Index: resources.c =================================================================== RCS file: /cvs/public/parrot/resources.c,v retrieving revision 1.84 diff -u -r1.84 resources.c --- resources.c 24 Aug 2002 05:31:20 -0000 1.84 +++ resources.c 26 Aug 2002 20:19:26 -0000 @@ -22,8 +22,37 @@ /** Parrot Memory Management Code **/ +#ifdef African_Grey +static struct Memory_Block * +find_free_page(struct Parrot_Interp *interpreter, size_t size) +{ + struct Memory_Block *page; + + for (page = interpreter->arena_base->free_page_list; + page; + page = page->prev) { + if (page->size >= size) { + /* unlink the block from the free list */ + if (page == interpreter->arena_base->free_page_list) { + interpreter->arena_base->free_page_list = page->prev; + } + if (page->next) { + page->next->prev = page->prev; + } + if (page->prev) { + page->prev->next = page->next; + } + break; + } + } + /* page will be null if the for loop ended without finding anything */ + return page; +} +#endif + /* Allocate a new memory block. We allocate the larger of however much * was asked for or the default size, whichever's larger */ +#ifndef African_Grey static void * alloc_new_block(struct Parrot_Interp *interpreter, size_t size, struct Memory_Pool *pool) @@ -31,6 +60,7 @@ size_t alloc_size; struct Memory_Block *new_block; + if (pool) { alloc_size = (size > pool->minimum_block_size) ? size : pool->minimum_block_size; @@ -68,15 +98,94 @@ return new_block; } +#else +static void * +alloc_new_block(struct Parrot_Interp *interpreter, + size_t size, struct Memory_Pool *pool) +{ + struct Memory_Block *page; + + /* Increase block size if required to accomodate a large request */ + if (size > pool->minimum_block_size) { + int n = 0; + size -= 1; + while (size > 1) { + size >>= 1; + n++; + } + pool->minimum_block_size = 1 << (n+1); + } + + /* First look for a suitable block on the free list + * Currently this means anything equal to or bigger than requested size */ + page = find_free_page(interpreter, pool->minimum_block_size); + + /* Finally, allocate a new page */ + if (!page) { + page = mem_sys_allocate(sizeof(struct Memory_Block) + + pool->minimum_block_size); + if (!page) { + return NULL; + } + page->size = pool->minimum_block_size; + /* Note that we've allocated it */ + interpreter->memory_allocated += pool->minimum_block_size; + } + + page->free = page->size; + page->start = (char *)page + sizeof(struct Memory_Block); + page->top = page->start; + page->header_list.next = page->header_list.prev = + (Buffer *)&page->header_list; + + /* Put page on the end of the memory pool's list */ + page->next = NULL; + page->prev = pool->top_block; + if (pool->top_block) { + pool->top_block->next = page; + } + else { + /* pool->first_block = page; */ + } + pool->top_block = page; + pool->total_allocated += page->size; + + return page; +} +#endif + +#ifdef African_Grey +/* Link buffer to specified list */ +inline static void +link_buffer(Buffer *buffer, struct Buffer_List *list) +{ + buffer->prev = list->prev; + list->prev->next = buffer; + buffer->next = (Buffer *)list; + list->prev = buffer; +} + +/* Unlink buffer from current list */ +inline static void +unlink_buffer(Buffer *buffer) +{ + buffer->prev->next = buffer->next; + buffer->next->prev = buffer->prev; +} +#endif /* Allocates memory for headers */ static void * -mem_allocate(struct Parrot_Interp *interpreter, size_t *req_size, - struct Memory_Pool *pool, size_t align_1) +mem_allocate(struct Parrot_Interp *interpreter, +#ifdef African_Grey + Buffer *buffer, +#endif + size_t *req_size, struct Memory_Pool *pool, size_t align_1) { char *return_val; size_t size = *req_size; +#ifndef African_Grey /* Ensure that our minimum size requirements are met, * so that we have room for a forwarding COW pointer */ if( size < sizeof(void*) ) @@ -85,6 +194,7 @@ /* Make sure we have room for the buffer's tail flags, * also used by the COW logic to detect moved buffers */ size += sizeof(struct Buffer_Tail); +#endif /* Round up to requested alignment */ size = (size + align_1) & ~align_1; @@ -120,7 +230,6 @@ else { Parrot_do_dod_run(interpreter); } - } if (pool->top_block->free < size) { alloc_new_block(interpreter, size, pool); @@ -134,8 +243,20 @@ return_val = pool->top_block->top; pool->top_block->top += size; pool->top_block->free -= size; +#ifdef African_Grey + *req_size = size; +#else *req_size = size - sizeof(struct Buffer_Tail); ((struct Buffer_Tail*)((char *)return_val + size - 1))->flags = 0; +#endif + +#ifdef African_Grey + /* Unlink buffer from previous list */ + if (buffer->prev) unlink_buffer(buffer); + /* Link buffer to current memory page */ + link_buffer(buffer, &pool->top_block->header_list); +#endif + return (void *)return_val; } @@ -143,6 +264,7 @@ /** Compaction Code **/ +#ifndef African_Grey /* Compact the buffer pool */ static void compact_pool(struct Parrot_Interp *interpreter, struct Memory_Pool *pool) @@ -155,6 +277,7 @@ struct Small_Object_Pool *header_pool; INTVAL j; UINTVAL object_size; + /* Bail if we're blocked */ if (interpreter->GC_block_level) { return; @@ -351,6 +474,149 @@ interpreter->GC_block_level--; } +#endif + +#ifdef African_Grey +/* Compact the buffer pool */ +static void compact_pool(struct Parrot_Interp *interpreter, + struct Memory_Pool *pool) +{ + UINTVAL cur_size; /* How big our chunk is going to be */ + struct Memory_Block *page; + struct Memory_Block *next_page; + Buffer *b; + Buffer *next_buffer; + struct Memory_Block *old_top; /* top block before collection */ + Buffer* last_header; + char* last_start; + char* last_end; + char* new_start; + char* new_end; + + /* Bail if we're blocked */ + if (interpreter->GC_block_level) { + return; + } + interpreter->GC_block_level++; + + /* Do a new dod sweep if we have wrapped */ + if (interpreter->cycle < interpreter->last_dod_run) { + Parrot_do_dod_run(interpreter); + } + + /* We're collecting */ + interpreter->mem_allocs_since_last_collect = 0; + interpreter->header_allocs_since_last_collect = 0; + interpreter->collect_runs++; + + /* Store the current top of pool */ + old_top = pool->top_block; + + /* Force allocation of a new block */ + if (pool->total_allocated >= pool->minimum_block_size * 6) { + pool->minimum_block_size *= 2; + } + alloc_new_block(interpreter, pool->minimum_block_size, pool); + + /* Run through all the Buffer pools and copy */ + for (page = old_top; page; page = next_page) + { + next_page = page->prev; + last_start = NULL; + last_end = NULL; + last_header = NULL; + for (b = page->header_list.next; b != (Buffer *)&page->header_list; + b = next_buffer) + { + /* Get link to next buffer before we move the current one */ + next_buffer = b->next; + /* Is the buffer dead? */ + if (!(b->flags & BUFFER_constant_FLAG) && + (b->last_seen < interpreter->last_dod_run)) + { + struct Small_Object_Pool *res_pool = b->pool; + b->bufstart = NULL; /* do we need this?? */ + b->pool = NULL; + /* unlink from current list */ + unlink_buffer(b); + /* return to the free pool */ + interpreter->active_Buffers--; + if (res_pool) add_free_buffer(interpreter, res_pool, b); + } + /* Is the buffer live, and can we move it? */ + else if (!(b->flags & (BUFFER_on_free_list_FLAG | + BUFFER_constant_FLAG | + BUFFER_immobile_FLAG))) + { + /* Keep sharing if possible */ + if ((char *)b->bufstart >= last_start && + (char *)b->bufstart + b->buflen <= last_end) { + size_t offset = (char *)b->bufstart - last_start; + b->bufstart = new_start + offset; + b->flags |= BUFFER_COW_FLAG; + last_header->flags |= BUFFER_COW_FLAG; + unlink_buffer(b); + link_buffer(b, &pool->top_block->header_list); + } + else { + last_start = b->bufstart; + last_end = last_start + b->buflen; + last_header = b; + + cur_size = b->buflen; + if (b->pool) + cur_size = (cur_size + b->pool->align_1) & ~b->pool->align_1; + else + cur_size = (cur_size + 3) & ~3; + /* Allocate a new page of memory if required */ + if (pool->top_block->free < cur_size) { + alloc_new_block(interpreter, cur_size, pool); + /* TODO: handle out of memory */ + } + new_start = pool->top_block->top; + pool->top_block->top += cur_size; + pool->top_block->free -= cur_size; + unlink_buffer(b); + link_buffer(b, &pool->top_block->header_list); + + new_end = new_start + b->buflen; + memcpy(new_start, b->bufstart, b->buflen); + b->bufstart = new_start; + b->flags &= ~(UINTVAL)BUFFER_COW_FLAG; + interpreter->memory_collected += b->buflen; + } + } + } + /* We don't own this page any more */ + pool->total_allocated -= page->size; + /* Currently never give memory back */ + /* interpreter->memory_allocated -= page->size; */ + /* Unlink it from the list */ + if (page->prev) { + page->prev->next = page->next; + } + page->next->prev = page->prev; + /* Add the page to the free list */ + page->prev = interpreter->arena_base->free_page_list; + if (interpreter->arena_base->free_page_list) { + interpreter->arena_base->free_page_list->next = page; + } + interpreter->arena_base->free_page_list = page; + page->next = NULL; + /* Call it quits if the current block is more than 70% empty */ + if (pool->top_block->free > pool->top_block->size * 0.7) { + break; + } + } + + pool->guaranteed_reclaimable = 0; + pool->possibly_reclaimable = 0; + + interpreter->GC_block_level--; + +} +#endif + /* Go do a GC run. This only scans the string pools and compacts them, * it doesn't check for string liveness */ @@ -385,11 +651,19 @@ } interpreter->arena_base->memory_pool->possibly_reclaimable += buffer->buflen; - mem = mem_allocate(interpreter, &alloc_size, + mem = mem_allocate(interpreter, +#ifdef African_Grey + buffer, +#endif + &alloc_size, interpreter->arena_base->memory_pool, BUFFER_ALIGNMENT-1); } else { - mem = mem_allocate(NULL, &alloc_size, NULL, BUFFER_ALIGNMENT-1); + mem = mem_allocate(NULL, +#ifdef African_Grey + buffer, +#endif + &alloc_size, NULL, BUFFER_ALIGNMENT-1); } if (!mem) { @@ -427,7 +701,11 @@ } pool->possibly_reclaimable += str->buflen; - mem = mem_allocate(interpreter, &alloc_size, pool, STRING_ALIGNMENT-1); + mem = mem_allocate(interpreter, +#ifdef African_Grey + (Buffer*)str, +#endif + &alloc_size, pool, STRING_ALIGNMENT-1); if (!mem) { return NULL; } @@ -451,7 +729,11 @@ size_t req_size = size; ((Buffer *)buffer)->buflen = 0; ((Buffer *)buffer)->bufstart = NULL; - ((Buffer *)buffer)->bufstart = mem_allocate(interpreter, &req_size, + ((Buffer *)buffer)->bufstart = mem_allocate(interpreter, +#ifdef African_Grey + (Buffer*)buffer, +#endif + &req_size, interpreter->arena_base->memory_pool, BUFFER_ALIGNMENT-1); ((Buffer *)buffer)->buflen = size; ((Buffer *)buffer)->flags |= BUFFER_selfpoolptr_FLAG; @@ -472,14 +754,21 @@ str->strstart = NULL; if (!interpreter) { - str->bufstart = mem_allocate(NULL, &req_size, NULL,STRING_ALIGNMENT-1); + str->bufstart = mem_allocate(NULL, +#ifdef African_Grey + (Buffer*)str, +#endif + &req_size, NULL, STRING_ALIGNMENT-1); } else { pool = (str->flags & BUFFER_constant_FLAG) ? interpreter->arena_base->constant_string_pool : interpreter->arena_base->memory_pool; - str->bufstart = mem_allocate(interpreter, &req_size, pool, - STRING_ALIGNMENT-1); + str->bufstart = mem_allocate(interpreter, +#ifdef African_Grey + (Buffer*)str, +#endif + &req_size, pool, STRING_ALIGNMENT-1); } str->buflen = req_size; str->strstart = str->bufstart; @@ -515,11 +804,19 @@ Parrot_initialize_memory_pools(struct Parrot_Interp *interpreter) { /* Buffers */ +#ifdef African_Grey + interpreter->arena_base->memory_pool = + new_memory_pool(8192, + &compact_pool); + alloc_new_block(interpreter, 8192, + interpreter->arena_base->memory_pool); +#else interpreter->arena_base->memory_pool = new_memory_pool(16384, &compact_pool); alloc_new_block(interpreter, 32768, interpreter->arena_base->memory_pool); +#endif /* Constant strings - not compacted */ interpreter->arena_base->constant_string_pool = Index: smallobject.c =================================================================== RCS file: /cvs/public/parrot/smallobject.c,v retrieving revision 1.10 diff -u -r1.10 smallobject.c --- smallobject.c 21 Aug 2002 08:00:10 -0000 1.10 +++ smallobject.c 26 Aug 2002 20:19:26 -0000 @@ -42,7 +42,11 @@ more_traceable_objects(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool) { +#ifdef African_Grey + (*pool->free_unused)(interpreter, pool); +#else Parrot_do_dod_run(interpreter); +#endif /* 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) { @@ -66,6 +70,9 @@ /* This code is copied to add_free_pmc and add_free_buffer */ *(void **)to_add = pool->free_list; pool->free_list = to_add; +#ifdef African_Grey + pool->num_free_objects++; +#endif } /* Get a new object from the free pool and return it */ @@ -86,6 +93,9 @@ ptr = pool->free_list; pool->free_list = *(void **)ptr; +#ifdef African_Grey + pool->num_free_objects--; +#endif return ptr; } @@ -107,6 +117,7 @@ memset(new_arena->start_objects, 0, pool->object_size * pool->objects_per_alloc); +#ifndef African_Grey /* Maintain the *_arena_memory invariant for stack walking code. * Set it regardless if we're the first pool to be added. */ @@ -117,6 +128,7 @@ + pool->object_size * pool->objects_per_alloc)) pool->end_arena_memory = (size_t)new_arena->start_objects + pool->object_size * pool->objects_per_alloc; +#endif /* Hook up the new object block into the object pool */ new_arena->used = pool->objects_per_alloc; Index: string.c =================================================================== RCS file: /cvs/public/parrot/string.c,v retrieving revision 1.90 diff -u -r1.90 string.c --- string.c 23 Aug 2002 07:53:35 -0000 1.90 +++ string.c 26 Aug 2002 20:19:38 -0000 @@ -17,6 +17,7 @@ #define EXTRA_SIZE 4 +#ifndef African_Grey /* String COW support */ static void unmake_COW(struct Parrot_Interp *interpreter, STRING *s) @@ -81,6 +82,7 @@ } return d; } +#endif /* Basic string stuff - creation, enlargement, destruction, etc. */ @@ -94,6 +96,19 @@ string_unicode_type = chartype_lookup("unicode"); } +#ifdef African_Grey +inline static UINTVAL +free_space(const STRING *s) +{ + if (s->flags & BUFFER_constant_FLAG || s->flags & BUFFER_COW_FLAG) { + return 0; + } + else { + return s->buflen - s->bufused; + } +} +#endif + /*=for api string string_append * Take in two strings and append the second string to the first */ @@ -122,11 +137,18 @@ NULL); } /* make sure A's big enough for both */ +#ifdef African_Grey + if (free_space(a) < b->bufused) { + a = string_grow(interpreter, a, ((a->bufused + b->bufused) + - a->buflen) + EXTRA_SIZE); + } +#else if (a->buflen < a->bufused + b->bufused) { a = string_grow(interpreter, a, ((a->bufused + b->bufused) - a->buflen) + EXTRA_SIZE); } unmake_COW(interpreter, a); +#endif /* Tack B on the end of A */ mem_sys_memcopy((void *)((ptrcast_t)a->strstart + a->bufused), @@ -203,7 +225,9 @@ */ STRING * string_grow(struct Parrot_Interp * interpreter, STRING * s, INTVAL addlen) { +#ifndef African_Grey unmake_COW(interpreter,s); +#endif /* Don't check buflen, if we are here, we already checked. */ Parrot_reallocate_string(interpreter, s, s->buflen + addlen); @@ -297,11 +321,41 @@ /*=for api string string_copy * create a copy of the argument passed in */ +#ifdef African_Grey +STRING * +string_copy(struct Parrot_Interp *interpreter, STRING *s) +{ + STRING *d; + + if (s->flags & BUFFER_constant_FLAG || !s->pool) { + d = (STRING *)new_shared_header(interpreter, (Buffer *)s, + interpreter->arena_base->string_header_pool, + 0, s->bufused); + d->flags = s->flags & ~(UINTVAL)BUFFER_constant_FLAG; + d->flags |= BUFFER_COW_FLAG; + } + else { + d = (STRING *)new_shared_header(interpreter, (Buffer *)s, s->pool, 0, + s->bufused); + s->flags |= BUFFER_COW_FLAG; + d->flags = s->flags & ~(UINTVAL)BUFFER_constant_FLAG; + } + + d->bufused = s->bufused; + d->strlen = s->strlen; + d->encoding = s->encoding; + d->type = s->type; + d->language = s->language; + + return d; +} +#else STRING * string_copy(struct Parrot_Interp *interpreter, STRING *s) { return make_COW_reference(interpreter, s); } +#endif /*=for api string string_transcode * create a transcoded copy of the argument passed in @@ -521,9 +575,29 @@ "subend somehow is less than substart"); } +#ifdef African_Grey + if (src->flags & BUFFER_constant_FLAG) { + dest = (STRING *)new_shared_header(interpreter, (Buffer *)src, + interpreter->arena_base->string_header_pool, + substart_off, true_length); + dest->flags = src->flags & ~(UINTVAL)BUFFER_constant_FLAG; + dest->flags |= BUFFER_COW_FLAG; + } + else { + dest = (STRING *)new_shared_header(interpreter, (Buffer *)src, + src->pool, + substart_off, true_length); + src->flags |= BUFFER_COW_FLAG; + dest->flags = src->flags & ~(UINTVAL)BUFFER_constant_FLAG; + } + dest->encoding = src->encoding; + dest->type = src->type; + dest->language = src->language; +#else /* do in-place if possible */ dest = make_COW_reference(interpreter, src); dest->strstart = (char *)dest->strstart + substart_off; +#endif dest->bufused = subend_off - substart_off; dest->strlen = true_length; @@ -555,6 +629,13 @@ UINTVAL true_offset; UINTVAL true_length; INTVAL diff; + +#ifdef African_Grey + /* TODO do this only when required */ + if (src->flags & BUFFER_COW_FLAG) { + src = string_grow(interpreter, src, 0); + } +#endif true_offset = (UINTVAL)offset; true_length = (UINTVAL)length; @@ -620,7 +701,9 @@ if(diff >= 0 || ((INTVAL)src->bufused - (INTVAL)src->buflen) <= diff) { +#ifndef African_Grey unmake_COW(interpreter, src); +#endif if(diff != 0) { mem_sys_memmove((char*)src->strstart + substart_off + rep->bufused, @@ -954,6 +1037,10 @@ { char *cstring; +#ifdef African_Grey + if (s->buflen == s->bufused || s->flags & BUFFER_COW_FLAG) + string_grow(interpreter, s, 1); +#else /* We shouldn't modify a constant string, * so instead create a new copy of it */ if (s->flags & BUFFER_constant_FLAG) { @@ -961,6 +1048,7 @@ } unmake_COW(interpreter, s); +#endif if (s->buflen == s->bufused) { string_grow(interpreter, s, 1); Index: classes/continuation.pmc =================================================================== RCS file: /cvs/public/parrot/classes/continuation.pmc,v retrieving revision 1.1 diff -u -r1.1 continuation.pmc --- classes/continuation.pmc 4 Aug 2002 22:55:03 -0000 1.1 +++ classes/continuation.pmc 26 Aug 2002 20:19:38 -0000 @@ -33,7 +33,7 @@ } PMC* mark (PMC* end_of_used_list) { - return mark_stack( + return mark_stack(GREY_INTERP ((struct Parrot_Continuation *)SELF->data)->ctx.user_stack, end_of_used_list ); Index: classes/coroutine.pmc =================================================================== RCS file: /cvs/public/parrot/classes/coroutine.pmc,v retrieving revision 1.6 diff -u -r1.6 coroutine.pmc --- classes/coroutine.pmc 4 Aug 2002 22:55:03 -0000 1.6 +++ classes/coroutine.pmc 26 Aug 2002 20:19:38 -0000 @@ -38,7 +38,7 @@ PMC* mark (PMC* end_of_used_list) { /* XXX: need to do pads as well. */ - return mark_stack( + return mark_stack(GREY_INTERP ((struct Parrot_Coroutine *)SELF->data)->ctx.user_stack, end_of_used_list ); Index: include/parrot/dod.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/dod.h,v retrieving revision 1.2 diff -u -r1.2 dod.h --- include/parrot/dod.h 23 Aug 2002 07:55:22 -0000 1.2 +++ include/parrot/dod.h 26 Aug 2002 20:19:51 -0000 @@ -20,11 +20,31 @@ void Parrot_do_dod_run(struct Parrot_Interp *); PMC *trace_system_stack(struct Parrot_Interp *, PMC *); +#ifdef African_Grey +void free_unused_buffers(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool); +void free_unused_PMCs(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool); +#endif /* Functions needed for custom DOD routines */ +#ifdef African_Grey +PMC * mark_used(struct Parrot_Interp *interpreter, + PMC *used_pmc, PMC *current_end_of_list); +#else PMC * mark_used(PMC *used_pmc, PMC *current_end_of_list); +#endif +#ifdef African_Grey +static void +buffer_lives(struct Parrot_Interp *interpreter, Buffer *buffer) +{ + buffer->last_seen = interpreter->cycle; + buffer->flags |= BUFFER_live_FLAG; +} +#define GREY_INTERP interpreter, +#else #if GC_DEBUG /* Set when walking the system stack */ extern int CONSERVATIVE_POINTER_CHASING; @@ -53,6 +73,7 @@ #endif buffer->flags |= BUFFER_live_FLAG; } +#endif #endif /* PARROT_DOD_H */ Index: include/parrot/headers.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/headers.h,v retrieving revision 1.6 diff -u -r1.6 headers.h --- include/parrot/headers.h 23 Aug 2002 07:55:22 -0000 1.6 +++ include/parrot/headers.h 26 Aug 2002 20:19:51 -0000 @@ -63,6 +63,8 @@ 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); +Buffer *new_shared_header(struct Parrot_Interp *interpreter, Buffer *src, + struct Small_Object_Pool *pool, UINTVAL offset, UINTVAL length); size_t get_max_buffer_address(struct Parrot_Interp *interpreter); size_t get_min_buffer_address(struct Parrot_Interp *interpreter); Index: include/parrot/interpreter.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v retrieving revision 1.53 diff -u -r1.53 interpreter.h --- include/parrot/interpreter.h 23 Aug 2002 07:55:22 -0000 1.53 +++ include/parrot/interpreter.h 26 Aug 2002 20:19:51 -0000 @@ -173,6 +173,10 @@ requests are there? */ UINTVAL GC_block_level; /* How many outstanding GC block requests are there? */ +#ifdef African_Grey + UINTVAL cycle; /* opcode counter for GC system */ + UINTVAL last_dod_run; /* cycle counter at last DOD run */ +#endif PDB_t *pdb; /* Debug system */ void *lo_var_ptr; /* Pointer to memory on runops system stack */ Index: include/parrot/method_util.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/method_util.h,v retrieving revision 1.2 diff -u -r1.2 method_util.h --- include/parrot/method_util.h 19 Aug 2002 23:15:52 -0000 1.2 +++ include/parrot/method_util.h 26 Aug 2002 20:19:51 -0000 @@ -17,6 +17,10 @@ #include "parrot/pmc.h" #include "parrot/config.h" +#ifdef African_Grey +#define GREY_interpreter interpreter, +#endif + void Parrot_push_argv(struct Parrot_Interp * interp, INTVAL argc, PMC * argv[]); INTVAL Parrot_pop_argv(struct Parrot_Interp * interp, PMC *** argv); void Parrot_push_proto(struct Parrot_Interp * interp, @@ -39,6 +43,11 @@ PMC * Parrot_find_method(struct Parrot_Interp * interp, struct Stash * stash, PMC * key); +#ifdef African_Grey +PMC * mark_stack(struct Parrot_Interp *, + Stack_Chunk_t * cur_stack, PMC * end_of_used_list); +#else PMC * mark_stack(Stack_Chunk_t * cur_stack, PMC * end_of_used_list); +#endif #endif /* PARROT_METHOD_UTIL_H_GUARD */ Index: include/parrot/parrot.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/parrot.h,v retrieving revision 1.48 diff -u -r1.48 parrot.h --- include/parrot/parrot.h 23 Aug 2002 13:46:21 -0000 1.48 +++ include/parrot/parrot.h 26 Aug 2002 20:19:52 -0000 @@ -155,6 +155,9 @@ * to occur more frequently. It does significantly reduce performance. */ #define GC_DEBUG 0 +/* Peter's pirate parrot */ +#define African_Grey 1 + #include "parrot/platform.h" #include "parrot/global_setup.h" #include "parrot/interpreter.h" Index: include/parrot/pmc.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/pmc.h,v retrieving revision 1.38 diff -u -r1.38 pmc.h --- include/parrot/pmc.h 19 Aug 2002 23:15:52 -0000 1.38 +++ include/parrot/pmc.h 26 Aug 2002 20:19:52 -0000 @@ -67,6 +67,9 @@ dereference when setting, but let us memset the actual GC data in a big block */ +#ifdef African_Grey + UINTVAL last_seen; +#endif }; /* PMC flag bits */ Index: include/parrot/resources.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/resources.h,v retrieving revision 1.38 diff -u -r1.38 resources.h --- include/parrot/resources.h 21 Aug 2002 08:02:25 -0000 1.38 +++ include/parrot/resources.h 26 Aug 2002 20:19:52 -0000 @@ -15,6 +15,14 @@ #include "parrot/parrot.h" +#ifdef African_Grey +/* Must be the same fields as at the start of a buffer */ +struct Buffer_List { + Buffer *next; + Buffer *prev; +}; +#endif + struct Memory_Block { size_t free; size_t size; @@ -22,6 +30,9 @@ struct Memory_Block *next; char *start; char *top; +#ifdef African_Grey + struct Buffer_List header_list; +#endif }; struct Memory_Pool { @@ -59,6 +70,7 @@ struct Small_Object_Pool **sized_header_pools; size_t num_sized; Buffer extra_buffer_headers; + struct Memory_Block *free_page_list; }; struct Stash { Index: include/parrot/smallobject.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/smallobject.h,v retrieving revision 1.6 diff -u -r1.6 smallobject.h --- include/parrot/smallobject.h 21 Aug 2002 08:02:25 -0000 1.6 +++ include/parrot/smallobject.h 26 Aug 2002 20:19:52 -0000 @@ -33,10 +33,18 @@ /* makes more objects available. can call alloc_objects */ void (*more_objects)(struct Parrot_Interp *, struct Small_Object_Pool *); +#ifdef African_Grey + /* returns dead objects to the free list */ + void (*free_unused)(struct Parrot_Interp *, + struct Small_Object_Pool *); +#endif void *mem_pool; size_t start_arena_memory; size_t end_arena_memory; STRING* name; +#ifdef African_Grey + UINTVAL last_free_run; +#endif }; INTVAL contained_in_pool(struct Parrot_Interp *, Index: include/parrot/string.h =================================================================== RCS file: /cvs/public/parrot/include/parrot/string.h,v retrieving revision 1.46 diff -u -r1.46 string.h --- include/parrot/string.h 23 Aug 2002 07:55:22 -0000 1.46 +++ include/parrot/string.h 26 Aug 2002 20:19:52 -0000 @@ -22,29 +22,52 @@ #ifdef PARROT_IN_CORE struct parrot_string_t { +#ifdef African_Grey + struct parrot_string_t *next; + struct parrot_string_t *prev; + struct Small_Object_Pool *pool; +#endif void *bufstart; UINTVAL buflen; UINTVAL flags; +#ifdef African_Grey + UINTVAL last_seen; +#endif #if GC_DEBUG UINTVAL version; #endif UINTVAL bufused; +#ifndef African_Grey void *strstart; +#endif UINTVAL strlen; const ENCODING *encoding; const CHARTYPE *type; INTVAL language; }; +#ifdef African_Grey + #define strstart bufstart +#endif #define Parrot_String struct parrot_string_t * #include "parrot/parrot.h" /* Generic buffer header. Enough to GC */ +#ifdef African_Grey +typedef struct parrot_buffer_t { + struct parrot_buffer_t *next; + struct parrot_buffer_t *prev; + struct Small_Object_Pool *pool; +#else typedef struct { +#endif void *bufstart; UINTVAL buflen; UINTVAL flags; +#ifdef African_Grey + UINTVAL last_seen; +#endif #if GC_DEBUG UINTVAL version; #endif Index: lib/Parrot/OpsFile.pm =================================================================== RCS file: /cvs/public/parrot/lib/Parrot/OpsFile.pm,v retrieving revision 1.26 diff -u -r1.26 OpsFile.pm --- lib/Parrot/OpsFile.pm 19 Aug 2002 23:16:23 -0000 1.26 +++ lib/Parrot/OpsFile.pm 26 Aug 2002 20:19:54 -0000 @@ -267,6 +267,12 @@ my $next = 0; my $jumps = 0; +#ifdef African_Grey + if ($body =~ m/[0-z]\(+[0-z]/) { + $body = " interpreter->cycle++;\n{\n" . $body . "}"; + } +#endif + foreach my $variant (expand_args(@$args)) { my(@fixedargs)=split(/,/,$variant); my $op = Parrot::Op->new($code++, $type, $short_name,