This is a patch that clears up all of the GC_DEBUG-revealed bugs, at
least on my machine. As I enumerated in my previous email, there are a
lot of different ways to fix these sorts of problems, and this just
kinda picks one for each problem encountered. This patch includes the
stuff done by Jason {Gloudon,Greene}.
In summary, this patch
- Adds a parameter to Parrot_init() to allow setting the stack top.
- Fixes a bug in dod.c where the first PMC might be skipped (changed < to <=)
- Adds some NULL checks in mark_hash()
- Adds an OUT parameter to new_hash() so the hash is anchored to the root set
while it is being constructed.
- Adds an OUT parameter to hash_clone() for early anchoring.
- Repeatedly calls lookupBucket() while cloning a hash in case things moved
- In interpreter.c, asserts that a few of the early buffer creations do not
return the same buffer (provides early warning of GC mischief)
- Adds an OUT parameter to rx_allocate_info() for early anchoring.
- Makes a major change to the Pointer PMC: the previously unused ->cache area
is now used to hold a pointer to a custom mark routine that will get fired
during PMC traversal. Previously, Pointers had the PMC_private_GC_FLAG set,
but nothing ever looked at it. With this change, Pointers behave as they
always did unless something externally sets the ->cache.struct_val field
(in other words, there is no vtable entry for setting the mark routine,
and the PMC's custom mark routine does nothing if that field is NULL.)
- Reorders the rx_allocinfo opcode to assign things in the correct order and
fill in the ->cache.struct_val field of the Pointer PMC it creates.
- Briefly disables DOD while a stack is being created so allocating the contents
of the stack buffer doesn't destroy the unanchored buffer header.
- Sets the PMC_custom_mark_FLAG on a cloned PerlHash PMC.
- Fixes a comment in the cloning test case in t/pmc/perlhash.t
Somebody gimme a cookie.
If the rx info object is going away, then obviously those parts of the
patch need not be applied. But in the meantime, it's nice to have a
Parrot that doesn't crash.
I'm not going to apply this patch yet because I'm sure someone will
disagree with how it fixes some or all of these bugs. So would that
someone please speak up? Thanks.
Index: disassemble.c
===================================================================
RCS file: /cvs/public/parrot/disassemble.c,v
retrieving revision 1.2
diff -p -u -r1.2 disassemble.c
--- disassemble.c 7 Jun 2002 01:31:57 -0000 1.2
+++ disassemble.c 14 Aug 2002 01:50:28 -0000
@@ -33,7 +33,7 @@ main(int argc, char *argv[])
return 1;
}
- Parrot_init(interpreter);
+ Parrot_init(interpreter, (void*) &interpreter);
if (argc != 2) {
fprintf(stderr, "Usage: disassemble programfile \n");
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/dod.c,v
retrieving revision 1.12
diff -p -u -r1.12 dod.c
--- dod.c 14 Aug 2002 00:10:48 -0000 1.12
+++ dod.c 14 Aug 2002 01:50:29 -0000
@@ -350,9 +350,9 @@ trace_system_stack(struct Parrot_Interp
cur_var_ptr = (size_t)( (ptrdiff_t)cur_var_ptr + direction *
PARROT_PTR_ALIGNMENT )
) {
size_t ptr = *(size_t *)cur_var_ptr;
- if (pmc_min < ptr && ptr < pmc_max && is_pmc_ptr(interpreter,(void *)ptr)) {
+ if (pmc_min <= ptr && ptr < pmc_max && is_pmc_ptr(interpreter,(void *)ptr)) {
last = mark_used((PMC *)ptr, last);
- } else if (buffer_min < ptr && ptr < buffer_max &&
is_buffer_ptr(interpreter,(void *)ptr)) {
+ } else if (buffer_min <= ptr && ptr < buffer_max &&
+is_buffer_ptr(interpreter,(void *)ptr)) {
buffer_lives((Buffer *)ptr);
}
}
Index: embed.c
===================================================================
RCS file: /cvs/public/parrot/embed.c,v
retrieving revision 1.35
diff -p -u -r1.35 embed.c
--- embed.c 12 Aug 2002 07:23:14 -0000 1.35
+++ embed.c 14 Aug 2002 01:50:30 -0000
@@ -35,7 +35,7 @@ Parrot_new(void)
}
void
-Parrot_init(struct Parrot_Interp *interpreter)
+Parrot_init(struct Parrot_Interp *interpreter, void* stacktop)
{
/* This function currently unused, but is here in case we need it later. */
@@ -44,6 +44,8 @@ Parrot_init(struct Parrot_Interp *interp
world_inited = 1;
init_world();
}
+
+ if (stacktop) interpreter->lo_var_ptr = stacktop;
}
void
@@ -237,11 +239,9 @@ Parrot_loadbc(struct Parrot_Interp *inte
void
Parrot_runcode(struct Parrot_Interp *interpreter, int argc, char *argv[])
{
- void *dummy_ptr;
INTVAL i;
PMC *userargv;
KEY key;
- interpreter->lo_var_ptr = &dummy_ptr;
/* Debugging mode nonsense. */
if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG)) {
@@ -289,6 +289,7 @@ Parrot_runcode(struct Parrot_Interp *int
key.atom.type = enum_key_int;
key.next = NULL;
+ userargv->vtable->set_integer_native(interpreter, userargv, (INTVAL) argc);
for (i = 0; i < argc; i++) {
/* Run through argv, adding everything to @ARGS. */
STRING *arg = string_make(interpreter, argv[i], strlen(argv[i]),
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/hash.c,v
retrieving revision 1.19
diff -p -u -r1.19 hash.c
--- hash.c 7 Aug 2002 20:27:53 -0000 1.19
+++ hash.c 14 Aug 2002 01:50:31 -0000
@@ -126,7 +126,14 @@ mark_hash(Interp *interpreter, HASH *has
HashIndex i;
buffer_lives((Buffer *)hash);
- buffer_lives(hash->bucket_pool);
+
+ if(hash->bucket_pool){
+ buffer_lives(hash->bucket_pool);
+ }
+
+ if (hash->buffer.bufstart == NULL || hash->bucket_pool->bufstart == NULL) {
+ return end_of_used_list;
+ }
for (i = 0; i <= hash->max_chain; i++) {
HASHBUCKET *bucket = lookupBucket(hash, i);
@@ -281,10 +288,12 @@ find_bucket(Interp *interpreter, HASH* h
return NULL;
}
-HASH *
-new_hash(Interp *interpreter)
+void
+new_hash(Interp *interpreter, HASH **hash_ptr)
{
HASH *hash = (HASH *)new_bufferlike_header(interpreter, sizeof(*hash));
+ *hash_ptr = hash;
+
/* hash->buffer.flags |= BUFFER_report_FLAG; */
/* We rely on the fact that expand_hash() will be called before
@@ -295,11 +304,13 @@ new_hash(Interp *interpreter)
hash->max_chain = (HashIndex) -1;
hash->entries = 0;
+
+ /* Ensure mark_hash doesn't try to mark the buffer live */
+ hash->bucket_pool = NULL;
hash->bucket_pool = new_buffer_header(interpreter);
/* hash->bucket_pool->flags |= BUFFER_report_FLAG; */
hash->free_list = NULLBucketIndex;
expand_hash(interpreter, hash);
- return hash;
}
/*=for api key hash_size
@@ -410,11 +421,10 @@ hash_delete(Interp *interpreter, HASH *h
PANIC("hash_delete given nonexistent key");
}
-HASH *
-hash_clone(struct Parrot_Interp * interp, HASH * hash) {
- HASH * ret = new_hash(interp);
- BucketIndex* table = (BucketIndex*) hash->buffer.bufstart;
+void
+hash_clone(struct Parrot_Interp * interp, HASH * hash, HASH ** clone) {
BucketIndex i;
+ new_hash(interp, clone);
for (i = 0; i <= hash->max_chain; i++) {
HASHBUCKET * b = lookupBucket(hash, i);
while (b) {
@@ -430,23 +440,24 @@ hash_clone(struct Parrot_Interp * interp
valtmp.type = enum_key_string;
valtmp.val.string_val
= string_copy(interp, b->value.val.string_val);
+ b = lookupBucket(hash, i);
break;
case enum_key_pmc:
valtmp.type = enum_key_pmc;
valtmp.val.pmc_val = b->value.val.pmc_val->vtable->clone(
interp, b->value.val.pmc_val);
+ b = lookupBucket(hash, i);
break;
default:
internal_exception(-1, "hash corruption: type = %d\n",
b->value.type);
};
- hash_put(interp, ret, b->key, &valtmp);
+ hash_put(interp, *clone, b->key, &valtmp);
b = getBucket(hash, b->next);
}
}
- return ret;
}
/*
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/interpreter.c,v
retrieving revision 1.95
diff -p -u -r1.95 interpreter.c
--- interpreter.c 12 Aug 2002 07:23:14 -0000 1.95
+++ interpreter.c 14 Aug 2002 01:50:34 -0000
@@ -10,6 +10,7 @@
* References:
*/
+#include <assert.h>
#include "parrot/parrot.h"
#include "parrot/interp_guts.h"
#include "parrot/oplib/core_ops.h"
@@ -573,9 +574,11 @@ make_interpreter(Interp_flags flags)
/* Need a user stack */
interpreter->ctx.user_stack = new_stack(interpreter);
+ assert(interpreter->ctx.user_stack->buffer != interpreter->ctx.pad_stack->buffer);
/* And a control stack */
interpreter->ctx.control_stack = new_stack(interpreter);
+ assert(interpreter->ctx.control_stack->buffer !=
+interpreter->ctx.user_stack->buffer);
/* A regex stack would be nice too. */
interpreter->ctx.intstack = intstack_new(interpreter);
Index: pdb.c
===================================================================
RCS file: /cvs/public/parrot/pdb.c,v
retrieving revision 1.2
diff -p -u -r1.2 pdb.c
--- pdb.c 7 Jun 2002 01:31:57 -0000 1.2
+++ pdb.c 14 Aug 2002 01:50:34 -0000
@@ -35,7 +35,7 @@ main(int argc, char *argv[])
return 1;
}
- Parrot_init(interpreter);
+ Parrot_init(interpreter, (void*) &interpreter);
if (argc != 2) {
fprintf(stderr, "Usage: pdb programfile\n");
Index: rx.c
===================================================================
RCS file: /cvs/public/parrot/rx.c,v
retrieving revision 1.16
diff -p -u -r1.16 rx.c
--- rx.c 12 Jun 2002 22:58:29 -0000 1.16
+++ rx.c 14 Aug 2002 01:50:35 -0000
@@ -27,10 +27,10 @@ const char *RX_NEWLINES = "\r\n";
* Initial version by Brent Dax *
*************************************************************/
-rxinfo *
-rx_allocate_info(struct Parrot_Interp *interpreter, STRING *string)
+void
+rx_allocate_info(struct Parrot_Interp *interpreter, STRING *string, void ** info)
{
- rxinfo *rx = mem_sys_allocate(sizeof(rxinfo));
+ rxinfo *rx = *info = mem_sys_allocate(sizeof(rxinfo));
rx->minlength = rx->index = rx->startindex = 0;
rx->flags = enum_rxflags_none;
@@ -45,8 +45,15 @@ rx_allocate_info(struct Parrot_Interp *i
string_transcode(interpreter, rx->string, encoding_lookup("utf32"),
rx->string->type, &rx->string);
+}
- return rx;
+PMC* rx_mark(struct Parrot_Interp* interp, void* info, PMC* last)
+{
+ rxinfo *rx = (rxinfo *) info;
+ if (rx->string) buffer_lives((Buffer *)rx->string);
+ if (rx->groupstart) last = mark_used(rx->groupstart, last);
+ if (rx->groupend) last = mark_used(rx->groupend, last);
+ return last;
}
INTVAL
Index: rx.ops
===================================================================
RCS file: /cvs/public/parrot/rx.ops,v
retrieving revision 1.23
diff -p -u -r1.23 rx.ops
--- rx.ops 24 Jul 2002 04:38:32 -0000 1.23
+++ rx.ops 14 Aug 2002 01:50:36 -0000
@@ -188,21 +188,17 @@ is the string to match against.
=cut
op rx_allocinfo(out pmc, in str) {
- rxinfo *rx=rx_allocate_info(interpreter, $2);
-
$1=pmc_new(interpreter, enum_class_Pointer);
-
- $1->data=(void*)rx;
+ $1->cache.struct_val = rx_mark;
+ rx_allocate_info(interpreter, $2, &$1->data);
goto NEXT();
}
op rx_allocinfo(out pmc, in pmc) {
- rxinfo *rx=rx_allocate_info(interpreter, $2->vtable->get_string(interpreter,
$2));
-
$1=pmc_new(interpreter, enum_class_Pointer);
-
- $1->data=(void*)rx;
+ $1->cache.struct_val = rx_mark;
+ rx_allocate_info(interpreter, $2->vtable->get_string(interpreter, $2),
+&$1->data);
goto NEXT();
}
Index: stacks.c
===================================================================
RCS file: /cvs/public/parrot/stacks.c,v
retrieving revision 1.44
diff -p -u -r1.44 stacks.c
--- stacks.c 12 Aug 2002 07:08:35 -0000 1.44
+++ stacks.c 14 Aug 2002 01:50:38 -0000
@@ -33,8 +33,11 @@ new_stack(Interp *interpreter)
/* Set buffer to null before allocation which might call GC */
stack->buffer = NULL;
stack->buffer = new_buffer_header(interpreter);
+
+ interpreter->DOD_block_level++;
Parrot_allocate(interpreter, stack->buffer,
sizeof(Stack_Entry_t) * STACK_CHUNK_DEPTH);
+ interpreter->DOD_block_level--;
#ifdef TIDY
entry = (Stack_Entry_t *)stack->buffer->bufstart;
Index: test_main.c
===================================================================
RCS file: /cvs/public/parrot/test_main.c,v
retrieving revision 1.55
diff -p -u -r1.55 test_main.c
--- test_main.c 29 Jul 2002 22:09:34 -0000 1.55
+++ test_main.c 14 Aug 2002 01:50:39 -0000
@@ -25,6 +25,7 @@ static void version(void);
int
main(int argc, char *argv[])
{
+ int dummy_var;
Parrot_Interp interpreter;
char *filename;
Parrot_PackFile pf;
@@ -35,7 +36,7 @@ main(int argc, char *argv[])
return 1;
}
- Parrot_init(interpreter);
+ Parrot_init(interpreter, (void*) &dummy_var);
filename = parseflags(interpreter, &argc, &argv);
Index: classes/perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.25
diff -p -u -r1.25 perlhash.pmc
--- classes/perlhash.pmc 12 Aug 2002 07:47:06 -0000 1.25
+++ classes/perlhash.pmc 14 Aug 2002 01:50:42 -0000
@@ -61,7 +61,7 @@ pmclass PerlHash {
undef->flags |= PMC_constant_FLAG;
}
SELF->flags |= PMC_custom_mark_FLAG;
- SELF->data = new_hash(INTERP);
+ new_hash(INTERP, (HASH **)&SELF->data);
}
/* The end of used parameter is passed into the mark_used function of
@@ -91,7 +91,8 @@ pmclass PerlHash {
}
ret->vtable = &(Parrot_base_vtables[enum_class_PerlHash]);
- ret->data = hash_clone(INTERP, (HASH *)SELF->data);
+ ret->flags |= PMC_custom_mark_FLAG;
+ hash_clone(INTERP, (HASH *)SELF->data, (HASH **)&ret->data);
return ret;
}
Index: classes/pointer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/pointer.pmc,v
retrieving revision 1.3
diff -p -u -r1.3 pointer.pmc
--- classes/pointer.pmc 8 Aug 2002 20:57:48 -0000 1.3
+++ classes/pointer.pmc 14 Aug 2002 01:50:42 -0000
@@ -17,10 +17,17 @@ pmclass Pointer {
void init () {
SELF->data=NULL;
- SELF->flags=PMC_private_GC_FLAG;
+ SELF->flags=PMC_private_GC_FLAG | PMC_custom_mark_FLAG;
}
void morph (INTVAL type) {
+ }
+
+ PMC* mark (PMC *end_of_used_list) {
+ PMC* (*mark_function)(struct Parrot_Interp*, void*, PMC *) =
+SELF->cache.struct_val;
+ if (SELF->data == NULL) return end_of_used_list;
+ if (SELF->cache.struct_val == NULL) return end_of_used_list;
+ return (*mark_function)(INTERP, SELF->data, end_of_used_list);
}
void destroy () {
Index: include/parrot/embed.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/embed.h,v
retrieving revision 1.13
diff -p -u -r1.13 embed.h
--- include/parrot/embed.h 15 Jul 2002 02:52:00 -0000 1.13
+++ include/parrot/embed.h 14 Aug 2002 01:50:42 -0000
@@ -24,7 +24,7 @@ typedef void *Parrot_Interp_flag_val;
Parrot_Interp Parrot_new(void);
-void Parrot_init(Parrot_Interp);
+void Parrot_init(Parrot_Interp, void*);
void Parrot_setflag(Parrot_Interp, Parrot_Interp_flag, Parrot_Interp_flag_val);
Index: include/parrot/hash.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/hash.h,v
retrieving revision 1.6
diff -p -u -r1.6 hash.h
--- include/parrot/hash.h 7 Aug 2002 19:02:06 -0000 1.6
+++ include/parrot/hash.h 14 Aug 2002 01:50:42 -0000
@@ -20,8 +20,8 @@ typedef struct _hashbucket HASHBUCKET;
/* HASH is really a hashtable, but 'hash' is standard perl nomenclature. */
typedef struct _hash HASH;
-HASH *new_hash(Interp * interpreter);
-HASH *hash_clone(Interp * interpreter, HASH * hash);
+void new_hash(Interp * interpreter, HASH **hash_ptr);
+void hash_clone(Interp * interpreter, HASH * src, HASH **dest);
INTVAL hash_size(Interp * interpreter, HASH *hash);
void hash_set_size(Interp * interpreter, HASH *hash, UINTVAL size);
void hash_destroy(Interp * interpreter, HASH *hash);
Index: include/parrot/rx.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/rx.h,v
retrieving revision 1.20
diff -p -u -r1.20 rx.h
--- include/parrot/rx.h 17 Jul 2002 05:04:28 -0000 1.20
+++ include/parrot/rx.h 14 Aug 2002 01:50:42 -0000
@@ -67,7 +67,8 @@ typedef struct rxinfo {
} rxinfo;
-rxinfo *rx_allocate_info(struct Parrot_Interp *, STRING *);
+void rx_allocate_info(struct Parrot_Interp *, STRING *, void ** data);
+PMC* rx_mark(struct Parrot_Interp *, void* info, PMC* last);
INTVAL rx_is_word_character(struct Parrot_Interp *, INTVAL ch);
INTVAL rx_is_number_character(struct Parrot_Interp *, INTVAL ch);
Index: t/pmc/perlhash.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlhash.t,v
retrieving revision 1.20
diff -p -u -r1.20 perlhash.t
--- t/pmc/perlhash.t 7 Aug 2002 05:16:44 -0000 1.20
+++ t/pmc/perlhash.t 14 Aug 2002 01:50:47 -0000
@@ -431,7 +431,7 @@ output_is(<<'CODE', <<OUTPUT, "Testing c
set P1["a"], "A"
# P0 = { a => "a", b => [undef, undef, undef], c => 4 }
- # P0 = { a => "A", b => [undef, undef] }
+ # P1 = { a => "A", b => [undef, undef] }
set S0, P0["a"]
eq S0, "a", ok1
