As already posted I incorparated the allocator from
http://gee.cs.oswego.edu/dl/html/malloc.html
in parrot.
Some remarks:
- it's totally stable now, runs all tests (parrot and perl6)
- memory consumption is like CVS or much less ...
- ... if resources.c is unpatched (#17702)
- runs almost[1] everything in almost the same time
[1]
Remarkable exceptions, where CVS behaves significantly worse compared to
LEA:
languages/perl6/examples/life-ar.p6:
LEA 200 gens/sec vs CVS 174 gens/sec
examples/benchmarks/gc_waves_sizeable_data.pasm
LEA 0.7 s vs CVS 1.2 s (CVS copies ~66MB during collections)
The latter seems to indicate, that current copying GC has problems with
massive live data, where significant amounts of memory must be copied
around, i.e. bigger real life apps ;-)
The only test I found, where LEA is somewhat slower is
examples/assembly/life.pasm
LEA 412 gens/s, CVS 423 gens/s
And last but not least, LEA allocator doesn't invalidate pointers due to
copying data around (except realloc of course) - so e.g. hash.c or
others could be optimized.
Please have a closer look at it.
leo
--- parrot/res.c Wed Oct 2 13:31:37 2002
+++ parrot-leo/res.c Wed Oct 2 13:28:30 2002
@@ -0,0 +1,85 @@
+/* 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;
+ return p;
+}
+
+void *
+Parrot_allocate(struct Parrot_Interp *interpreter, void *buffer, size_t size)
+{
+ Buffer * b = buffer;
+ b->bufstart = calloc(1, size);
+ b->buflen = size;
+ return b;
+}
+
+void *
+Parrot_reallocate_string(struct Parrot_Interp *interpreter, STRING *str,
+ size_t size)
+{
+ void *p;
+ size_t pad, rsize;
+ pad = STRING_ALIGNMENT - 1;
+ /* 2 chars string tail, first seems to be clobbered */
+ size = ((size + pad + 2) & ~pad) - 2;
+ p = realloc(str->bufstart, size + 2);
+ str->strstart = str->bufstart = p;
+ ((char*)str->bufstart)[size+1] = 0;
+ str->buflen = size;
+ return p;
+}
+
+void *
+Parrot_allocate_string(struct Parrot_Interp *interpreter, STRING *str,
+ size_t size)
+{
+ void *p = 0;
+ size_t pad;
+#if 0
+ if (size)
+#endif
+ {
+#if 0
+ pad = STRING_ALIGNMENT - 1;
+ size = ((size + pad + 2) & ~pad) - 2;
+#endif
+ p = calloc(1, size + 2);
+ }
+ str->strstart = str->bufstart = p;
+ str->buflen = size;
+ return str;
+}
+
+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 Oct 2 13:31:28 2002
@@ -82,7 +82,7 @@
O_DIRS = classes
-CLASS_O_FILES = classes/array$(O) classes/boolean$(O) classes/continuation$(O)
classes/coroutine$(O) classes/csub$(O) classes/default$(O) classes/intlist$(O)
classes/intqueue$(O) classes/key$(O) classes/multiarray$(O) classes/perlarray$(O)
classes/perlhash$(O) classes/perlint$(O) classes/perlnum$(O) classes/perlstring$(O)
classes/perlundef$(O) classes/pointer$(O) classes/sub$(O)
+CLASS_O_FILES = classes/array$(O) classes/boolean$(O) classes/continuation$(O)
+classes/coroutine$(O) classes/csub$(O) classes/default$(O) classes/intlist$(O)
+classes/intqueue$(O) classes/key$(O) classes/multiarray$(O) classes/perlarray$(O)
+classes/perlhash$(O) classes/perlint$(O) classes/perlnum$(O) classes/perlstring$(O)
+classes/perlundef$(O) classes/pointer$(O) classes/scalar$(O) classes/sub$(O)
ENCODING_O_FILES = encodings/singlebyte$(O) encodings/utf8$(O) \
encodings/utf16$(O) \
@@ -98,10 +98,11 @@
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 +426,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 Oct 2 13:31:28 2002
@@ -20,9 +20,9 @@
# define BUFFER_HEADERS_PER_ALLOC 1
# define STRING_HEADERS_PER_ALLOC 1
#else
-# define PMC_HEADERS_PER_ALLOC 256
-# define BUFFER_HEADERS_PER_ALLOC 256
-# define STRING_HEADERS_PER_ALLOC 256
+# define PMC_HEADERS_PER_ALLOC 512
+# define BUFFER_HEADERS_PER_ALLOC 512
+# define STRING_HEADERS_PER_ALLOC 512
#endif
/** PMC Header Functions for small-object lookup table **/
@@ -33,6 +33,7 @@
{
((PMC *)pmc)->flags = PMC_on_free_list_FLAG;
/* Don't let it point to garbage memory */
+ /* XXX custom destroy ?! */
((PMC *)pmc)->data = NULL;
/* Copied from add_free_object */
@@ -73,11 +74,17 @@
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 (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;
--- parrot/string.c Sun Sep 15 15:30:59 2002
+++ parrot-leo/string.c Tue Oct 1 17:05:02 2002
@@ -18,32 +18,31 @@
#define EXTRA_SIZE 4
/* String COW support */
+
+/* make a copy of string's data:
+ * copy used string data from strstart to a newly
+ * allocated string
+ * the header stays the same
+ */
static void
unmake_COW(struct Parrot_Interp *interpreter, STRING *s)
{
-#if 0
- if (s->flags & BUFFER_constant_FLAG) {
- /* this happens when we call string_to_cstring on
- * a constant string in order to print it
- */
- internal_exception(INVALID_OPERATION,
- "Cannot unmake COW on a constant header");
- }
- else
-#endif
if (s->flags & (BUFFER_COW_FLAG|BUFFER_constant_FLAG)) {
+ void *p;
+ UINTVAL size;
interpreter->GC_block_level++;
interpreter->DOD_block_level++;
/* Make the copy point to only the portion of the string that
* we are actually using. */
- s->bufstart = s->strstart;
- s->buflen = s->bufused;
-
+ p = s->strstart;
+ size = s->bufused;
/* Create new pool data for this header to use,
* independant of the original COW data */
- Parrot_reallocate_string(interpreter, s, s->buflen);
- s->flags &= ~(UINTVAL)(BUFFER_COW_FLAG | BUFFER_constant_FLAG);
+ s->flags &= ~BUFFER_constant_FLAG;
+ Parrot_allocate_string(interpreter, s, size);
+ mem_sys_memcopy(s->bufstart, p, size);
+ s->flags &= ~(UINTVAL)(BUFFER_COW_FLAG | BUFFER_external_FLAG);
interpreter->GC_block_level--;
interpreter->DOD_block_level--;
}
@@ -399,8 +398,7 @@
INTVAL
string_compute_strlen(STRING *s)
{
- s->strlen = s->encoding->characters(s->bufstart, s->bufused) -
- ((UINTVAL)s->strstart - (UINTVAL)s->bufstart);
+ s->strlen = s->encoding->characters(s->strstart, s->bufused);
return s->strlen;
}
@@ -972,13 +970,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) {
- s = make_COW_reference(interpreter,s);
- }
unmake_COW(interpreter, s);
@@ -986,11 +977,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/dod.c Fri Aug 23 11:37:00 2002
+++ parrot-leo/dod.c Wed Oct 2 13:31:28 2002
@@ -308,6 +308,55 @@
interpreter->arena_base->pmc_pool->total_objects - total_used;
}
+
+/* find other users of COW's bufstart */
+static void
+used_cow(struct Parrot_Interp *interpreter, struct Small_Object_Pool *pool)
+{
+ UINTVAL object_size = pool->object_size;
+ struct Small_Object_Arena *cur_arena;
+ UINTVAL i;
+ Buffer *b;
+ char *tail;
+
+#ifdef LEA_DEBUG
+ /* check/clear tail, e.g. on changes in string.c or res.c */
+ for (cur_arena = pool->last_Arena;
+ NULL != cur_arena;
+ cur_arena = cur_arena->prev) {
+ b = cur_arena->start_objects;
+ for (i = 0; i < cur_arena->used; i++) {
+ if ((b->flags & BUFFER_COW_FLAG) && b->bufstart &&
+ !(b->flags & BUFFER_external_FLAG)) {
+ tail = (char*)b->bufstart + b->buflen + 1;
+ assert(*tail == 0);
+ *tail = 0;
+ }
+ b = (Buffer *)((char *)b + object_size);
+ }
+ }
+#endif
+
+ for (cur_arena = pool->last_Arena;
+ NULL != cur_arena;
+ cur_arena = cur_arena->prev) {
+ b = cur_arena->start_objects;
+ for (i = 0; i < cur_arena->used; i++) {
+ if ((b->flags & BUFFER_COW_FLAG) &&
+ !(b->flags & BUFFER_external_FLAG)) {
+ tail = (char*)b->bufstart + b->buflen + 1;
+ /* mark living and dead users of this bufstart
+ * tail is cleared in *allocate_string */
+ if (b->flags & BUFFER_live_FLAG)
+ *tail |= 0x2;
+ else
+ *tail |= 0x1;
+ }
+ b = (Buffer *)((char *)b + object_size);
+ }
+ }
+}
+
/* Put any buffers that are now unused, on to the free list
* Avoid buffers that are immune from collection (ie, constant) */
static void
@@ -317,13 +366,20 @@
struct Small_Object_Arena *cur_arena;
UINTVAL i, total_used = 0;
UINTVAL object_size = pool->object_size;
+ char *tail;
+ used_cow(interpreter, pool);
/* Run through all the buffer header pools and mark */
for (cur_arena = pool->last_Arena;
NULL != cur_arena;
cur_arena = cur_arena->prev) {
Buffer *b = cur_arena->start_objects;
for (i = 0; i < cur_arena->used; i++) {
+ if ((b->flags & BUFFER_COW_FLAG) &&
+ !(b->flags & BUFFER_external_FLAG))
+ tail = (char*)b->bufstart + b->buflen + 1;
+ else
+ tail = 0;
/* If it's not live or on the free list, put it on the free list.
* Note that it is technically possible to have a Buffer be both
* on_free_list and live, because of our conservative stack-walk
@@ -332,19 +388,23 @@
| BUFFER_constant_FLAG
| BUFFER_live_FLAG )))
{
- if (pool->mem_pool) {
- if (!(b->flags & BUFFER_COW_FLAG)) {
- ((struct Memory_Pool *)
- pool->mem_pool)->guaranteed_reclaimable +=
- b->buflen;
- }
- ((struct Memory_Pool *)
- pool->mem_pool)->possibly_reclaimable += b->buflen;
- }
+ /* if only dead users, this one may be freed */
+ if (tail && *tail == 0x1)
+ b->flags &= ~BUFFER_COW_FLAG;
+ /* don't free this bufstart this time, because
+ * tail will be invalid then -
+ * if we want to free immediately, we need extended
+ * bookkeeping to free exactly the last user
+ */
+ else
add_free_buffer(interpreter, pool, b);
} else if (!(b->flags & BUFFER_on_free_list_FLAG)) {
total_used++;
}
+ /* clear tail for next dod run and
+ * don't unset COW on other possbily dead users */
+ if (tail)
+ *tail = 0;
b->flags &= ~BUFFER_live_FLAG;
b = (Buffer *)((char *)b + object_size);
}
@@ -429,11 +489,27 @@
}
#endif
+struct mallinfo {
+ int arena; /* non-mmapped space allocated from system */
+ int ordblks; /* number of free chunks */
+ int smblks; /* number of fastbin blocks */
+ int hblks; /* number of mmapped regions */
+ int hblkhd; /* space in mmapped regions */
+ int usmblks; /* maximum total allocated space */
+ int fsmblks; /* space available in freed fastbin blocks */
+ int uordblks; /* total allocated space */
+ int fordblks; /* total free space */
+ int keepcost; /* top-most, releasable (via malloc_trim) space */
+};
+extern struct mallinfo mallinfo(void);
/* 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,11 +528,21 @@
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 && j < 0) {
+ free_unused_buffers(interpreter, header_pool);
+ }
+ }
+ /* update mem stats */
+#if 0
+ interpreter->memory_allocated = mallinfo().uordblks;
+#endif
/* Note it */
interpreter->dod_runs++;
