As already announced, I used the memory allocator from http://gee.cs.oswego.edu/dl/html/malloc.html and tossed the collect system.
Description of changes: - DOD is the same incl, stack_walk and so on - resources.c is gone, no copying of memory, no string tails ... - dead objects are free'd, the allocator takes care of object space coalescing/reusing - COW strings are freed as well, wenn there is a single user only - buffer allocation/management is all hidden in the allocator, it's a simple calloc/realloc call. Changes per file: - res.c: Parrot*alloc* => calloc/realloc, some empty functions bodies - Makefile s/resources/res/, add malloc$(O) - header.c: add_free_buffer returns memory to the allocator by free - string.c unmake_COW did a non realloc-compatible manipulation of bufstart string_to_cstring seemes to return heap values - embed.c statistic call - dod.c add code to detect single COW users and free them free all objects, not only strings/buffers. Additionally needed is malloc.c from above. Status: It runs all tests (parrot and perl6 [1]) successfully as well as some examples I tested e.g. life.pasm/.p6. Speed (parrot examples/assembly/life.pbc): LEA: 5000 generations in 12.916113 seconds. 387.113371 generations/sec CVS: 5000 generations in 16.145204 seconds. 309.689491 generations/sec Memory usage for above test (top RSS): LEA 784 constant CVS ~800 - ~1300, high limit ever increasing for longer runs Memory defragmentation is reported to be ~4% and lower. [1] one perl test currently fails, when SLOW_BUT_SAVE in headers.c is 1. It seems, that there is some memory corruption due do DOD runs and early returning freshly allocated objects. This is IMHO a general problem and not too much related to my patch. With SLOW_BUT_SAVE life perfomance drops to ~240 generations, probably due to very bad cache coherency caused by late freeing of objects. As CVS-GC is run rarely compared to freeing immediately, this is not too much impact for CVS, but we had this problem already, that variables got collected during allocation. Attached are my changes to parrot. Plese give it a try, Have fun, leo
--- parrot/res.c Wed Sep 25 20:17:05 2002 +++ parrot-leo/res.c Wed Sep 25 14:58:15 2002 @@ -0,0 +1,69 @@ +/* resources */ +#include <assert.h> +#include "parrot/parrot.h" +void +Parrot_go_collect(struct Parrot_Interp *interpreter) +{ + if (interpreter->GC_block_level) { + return; + } + interpreter->collect_runs++; /* fake it */ +} +void * +Parrot_reallocate(struct Parrot_Interp *interpreter, void *from, size_t size) +{ + Buffer * buffer = from; + void *p; + size_t oldlen = buffer->buflen; + p = realloc(buffer->bufstart, size); + if (size > buffer->buflen) + memset((char*)p + oldlen, 0, size - oldlen); + buffer->buflen = size; + buffer->bufstart = p; + /* s. headers.c for this */ + buffer->flags |= BUFFER_generation_FLAG ; + return buffer; +} +void * +Parrot_reallocate_string(struct Parrot_Interp *interpreter, STRING *str, + size_t size) +{ + void *p; + str->flags |= BUFFER_generation_FLAG ; + str->flags &= ~(BUFFER_COW_FLAG|BUFFER_external_FLAG|BUFFER_constant_FLAG) ; + p = realloc(str->bufstart, size); + str->strstart = str->bufstart = p; + str->buflen = size; + return p; +} +void * +Parrot_allocate_string(struct Parrot_Interp *interpreter, STRING *str, + size_t size) +{ + str->bufstart = 0; + return Parrot_reallocate_string(interpreter, str, size); +} +void * +Parrot_allocate(struct Parrot_Interp *interpreter, void *buffer, size_t size) +{ + Buffer * b = buffer; + b->bufstart = calloc(1, size); + b->buflen = size; + b->flags |= BUFFER_generation_FLAG ; + return b; +} + +void +Parrot_initialize_memory_pools(struct Parrot_Interp *interpreter) +{ +} + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: nil + * End: + * + * vim: expandtab shiftwidth=4: +*/ --- parrot/Makefile Sat Sep 21 14:26:55 2002 +++ parrot-leo/Makefile Wed Sep 25 19:29:27 2002 @@ -98,10 +98,10 @@ packfile$(O) stacks$(O) string$(O) sub$(O) encoding$(O) \ chartype$(O) runops_cores$(O) trace$(O) pmc$(O) key$(O) hash$(O) \ core_pmcs$(O) platform$(O) jit$(O) jit_cpu$(O) \ - resources$(O) rx$(O) rxstacks$(O) intlist$(O) \ + res$(O) rx$(O) rxstacks$(O) intlist$(O) \ embed$(O) warnings$(O) misc$(O) core_ops_cg$(O) \ packout$(O) byteorder$(O) debug$(O) smallobject$(O) \ - headers$(O) dod$(O) method_util$(O) + headers$(O) dod$(O) method_util$(O) malloc$(O) O_FILES = $(INTERP_O_FILES) \ $(IO_O_FILES) \ @@ -425,8 +425,8 @@ misc$(O) : $(H_FILES) -$(STICKY_FILES) : Configure.pl - $(PERL) Configure.pl +# $(STICKY_FILES) : Configure.pl +# $(PERL) Configure.pl $(INC)/vtable.h : vtable.tbl vtable_h.pl $(PERL) vtable_h.pl --- parrot/headers.c Mon Sep 9 11:42:19 2002 +++ parrot-leo/headers.c Wed Sep 25 20:16:39 2002 @@ -73,11 +73,39 @@ void add_free_buffer(struct Parrot_Interp *interpreter, - struct Small_Object_Pool *pool, void *buffer) + struct Small_Object_Pool *pool, void *buff) { - ((Buffer *)buffer)->flags = BUFFER_on_free_list_FLAG; + Buffer * buffer = buff; + /* if generation_FLAG is set, the buffer was either + * - freshly return be get_free_buffer + * - realloced + * - alloced + * reset the flag and return, next DOD will free this buffer + * again + * + * So pmc constructors like PerlArray clone should have not + * to worry, that the freshly allocated buffers are killed + * while constructing the new array list + * + * turning this off, makes currently on perl6 test fail (compiler/3_7), + * a string constant is changed + * + * + */ +#define SLOW_BUT_SAVE 0 + + if (SLOW_BUT_SAVE && (buffer->flags & BUFFER_generation_FLAG)) { + buffer->flags &= ~BUFFER_generation_FLAG; + return; + } + if (buffer->bufstart && !(buffer->flags & + (BUFFER_COW_FLAG|BUFFER_external_FLAG))) { + free(buffer->bufstart); + } + buffer->bufstart = 0; + buffer->flags = BUFFER_on_free_list_FLAG; /* Use the right length */ - ((Buffer *)buffer)->buflen = 0; + buffer->buflen = 0; /* Copied from add_free_object */ *(void **)buffer = pool->free_list; @@ -101,7 +129,7 @@ /* Don't let it point to garbage memory */ buffer->bufstart = NULL; /* Clear the flagpole (especially BUFFER_on_free_list_FLAG) */ - buffer->flags = 0; + buffer->flags = 0 ; #if GC_DEBUG buffer->version++; #endif --- parrot/string.c Sun Sep 15 15:30:59 2002 +++ parrot-leo/string.c Wed Sep 25 16:53:58 2002 @@ -32,17 +32,28 @@ else #endif if (s->flags & (BUFFER_COW_FLAG|BUFFER_constant_FLAG)) { + STRING *p; interpreter->GC_block_level++; interpreter->DOD_block_level++; /* Make the copy point to only the portion of the string that * we are actually using. */ +#if 1 + /* manipulating s->bufstart is a bad thing for a real + * realloc, CVS's reallocate_string is alloc/copy + */ + p = mem_sys_allocate(s->bufused); + mem_sys_memcopy(p, s->strstart, s->bufused); + s->strstart = s->bufstart = p; + s->buflen = s->bufused; +#else s->bufstart = s->strstart; s->buflen = s->bufused; /* Create new pool data for this header to use, * independant of the original COW data */ Parrot_reallocate_string(interpreter, s, s->buflen); +#endif s->flags &= ~(UINTVAL)(BUFFER_COW_FLAG | BUFFER_constant_FLAG); interpreter->GC_block_level--; interpreter->DOD_block_level--; @@ -972,8 +983,6 @@ const char * string_to_cstring(struct Parrot_Interp * interpreter, STRING * s) { - char *cstring; - /* We shouldn't modify a constant string, * so instead create a new copy of it */ if (s->flags & BUFFER_constant_FLAG) { @@ -986,11 +995,9 @@ string_grow(interpreter, s, 1); } - cstring = s->strstart; - - cstring[s->bufused] = 0; - - return cstring; + ((char *)s->strstart)[s->bufused] = 0; + /* don't return local vars, return the right thing */ + return (char*)s->strstart; } --- parrot/embed.c Mon Aug 26 19:09:46 2002 +++ parrot-leo/embed.c Wed Sep 25 15:31:15 2002 @@ -357,6 +357,7 @@ \tTotal memory allocated: %u\n\ \tTotal DOD runs: %u\n\ \tTotal collector runs: %u\n\ +\tMemory collected: %u\n\ \tActive PMCs: %u\n\ \tActive buffers: %u\n\ \tTotal PMCs: %u\n\ @@ -368,6 +369,7 @@ interpreter->memory_allocated, interpreter->dod_runs, interpreter->collect_runs, + interpreter->memory_collected, interpreter->active_PMCs, interpreter->active_Buffers, interpreter->total_PMCs, @@ -375,6 +377,7 @@ interpreter->header_allocs_since_last_collect, interpreter->mem_allocs_since_last_collect ); + malloc_stats(); } } @@ -449,6 +452,8 @@ /* If it has a label print it */ if (line->label) printf("L%li:\t", line->label->number); + else + printf("\t"); c = pdb->file->source + line->source_offset; while (*c != '\n' && c) printf("%c", *(c++)); --- parrot/dod.c Fri Aug 23 11:37:00 2002 +++ parrot-leo/dod.c Wed Sep 25 17:51:41 2002 @@ -308,6 +308,30 @@ interpreter->arena_base->pmc_pool->total_objects - total_used; } +static int +used_cow(struct Parrot_Interp *interpreter, + struct Small_Object_Pool *pool, + Buffer * buf) +{ + UINTVAL object_size = pool->object_size; + struct Small_Object_Arena *arena; + UINTVAL j; + + /* check if COW used only once */ + /* find other users of bufstart + */ + for (arena = pool->last_Arena; arena; arena = arena->prev) { + Buffer *b2 = (Buffer*) ((char*)arena->start_objects); + for (j = 0; j < arena->used; j++) { + if (b2->bufstart == buf->bufstart && b2 != buf) { + return 1; + } + b2 = (Buffer *)((char *)b2 + object_size); + } + } + return 0; +} + /* Put any buffers that are now unused, on to the free list * Avoid buffers that are immune from collection (ie, constant) */ static void @@ -341,6 +365,10 @@ ((struct Memory_Pool *) pool->mem_pool)->possibly_reclaimable += b->buflen; } + if ((b->flags & BUFFER_COW_FLAG) && b->bufstart) { + if (!used_cow(interpreter, pool, b)) + b->flags &= ~BUFFER_COW_FLAG; + } add_free_buffer(interpreter, pool, b); } else if (!(b->flags & BUFFER_on_free_list_FLAG)) { total_used++; @@ -429,11 +457,13 @@ } #endif - /* See if we can find some unused headers */ void Parrot_do_dod_run(struct Parrot_Interp *interpreter) { + struct Small_Object_Pool *header_pool; + int j; + if (interpreter->DOD_block_level) { return; } @@ -452,10 +482,17 @@ free_unused_PMCs(interpreter); /* 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); + for (j = -2; j < (INTVAL) interpreter->arena_base->num_sized; j++) { + if (j == -2) + header_pool = interpreter->arena_base->string_header_pool; + else if (j == -1) + header_pool = interpreter->arena_base->buffer_header_pool; + else + header_pool = interpreter->arena_base->sized_header_pools[j]; + if (header_pool) { + free_unused_buffers(interpreter, header_pool); + } + } /* Note it */ interpreter->dod_runs++;