The attached patch fixes a bunch of bugs. They are:
>From before, rolled into this patch:
+ Creates a new flag, immortal, which is intended for GC use only, so it
shouldn't be set in the init() function. This is used to prevent the GC
from dod'ing the object.
+ PerlString now stores the string pointer in data instead of
cache.struct_val .
+ buffer_ptrs work properly now, and check that they point to something
before calling buffer_lives on it.
New fixes in this patch:
+ new_string_header nulls out the bufstart before returning it. This was
causing problems when 'bufstart = parrot_allocate...' was causing a
do_collect to be run, and it was referencing invalid memory. I also made
new_pmc_header null out the data field as well, for consistency, and
removed the nulling-out in pmc_new*.
+ Changed a conditional in stack_entry so that it looks up entry in the
correct place in a borderline case.
+ Fixed the same thing that Peter Gibb's patched fixed wrt the GC linked
list bug, but in what I think is a more efficient way. the next_for_GC
linked list now *requires* that the tail element point to itself. This
hack (I think this is a good hack, not a bad one, if documented)
determines the 'end-of-list'. This allows the same logic to be used in
mark_used to determine if the element is on the linked list. It avoids the
need to add additional conditional branches into mark_used, which is
probably a hotspot of the memory manager (haven't verified this, however).
Please let me know if there are any issues with this that I should
address.
Mike Lambert
Index: parrot/pmc.c
===================================================================
RCS file: /cvs/public/parrot/pmc.c,v
retrieving revision 1.11
diff -u -r1.11 pmc.c
--- parrot/pmc.c 10 Mar 2002 21:19:46 -0000 1.11
+++ parrot/pmc.c 29 Mar 2002 08:09:23 -0000
@@ -39,8 +39,8 @@
return NULL;
}
- pmc->flags = 0;
- pmc->data = 0;
+ /* Ensure the PMC survives DOD during this function */
+ pmc->flags |= PMC_immortal_FLAG;
pmc->vtable = &(Parrot_base_vtables[base_type]);
@@ -53,6 +53,9 @@
}
pmc->vtable->init(interpreter, pmc, 0);
+
+ /* Let the caller track this PMC */
+ pmc->flags &= ~PMC_immortal_FLAG;
return pmc;
}
@@ -67,8 +70,8 @@
return NULL;
}
- pmc->flags = 0;
- pmc->data = 0;
+ /* Ensure the PMC survives DOD during this function */
+ pmc->flags |= PMC_immortal_FLAG;
pmc->vtable = &(Parrot_base_vtables[base_type]);
@@ -81,6 +84,9 @@
}
pmc->vtable->init(interpreter, pmc, size);
+
+ /* Let the caller track this PMC */
+ pmc->flags &= ~PMC_immortal_FLAG;
return pmc;
}
Index: parrot/resources.c
===================================================================
RCS file: /cvs/public/parrot/resources.c,v
retrieving revision 1.35
diff -u -r1.35 resources.c
--- parrot/resources.c 26 Mar 2002 16:33:01 -0000 1.35
+++ parrot/resources.c 29 Mar 2002 08:09:23 -0000
@@ -139,6 +139,8 @@
interpreter->active_PMCs++;
/* Mark it live */
return_me->flags = PMC_live_FLAG;
+ /* Don't let it point to garbage memory */
+ return_me->data = NULL;
/* Return it */
return return_me;
}
@@ -242,6 +244,8 @@
interpreter->active_Buffers++;
/* Mark it live */
return_me->flags = BUFFER_live_FLAG;
+ /* Don't let it point to garbage memory */
+ return_me->bufstart = NULL;
/* Return it */
return return_me;
}
@@ -348,6 +352,9 @@
/* Now put it on the end of the list */
current_end_of_list->next_for_GC = used_pmc;
+ /* Explicitly make the tail of the linked list be self-referential */
+ used_pmc->next_for_GC = used_pmc;
+
/* return the PMC we were passed as the new end of the list */
return used_pmc;
}
@@ -355,20 +362,20 @@
/* Do a full trace run and mark all the PMCs as active if they are */
static void
trace_active_PMCs(struct Parrot_Interp *interpreter) {
- PMC *last, *current; /* Pointers to the last marked PMC and the
- currently being processed PMC. */
+ PMC *last, *current, *prev; /* Pointers to the last marked PMC, the
+ currently being processed PMC, and in
+ the previously processed PMC in a loop. */
unsigned int i, j, chunks_traced;
Stack_chunk *cur_stack, *start_stack;
struct PRegChunk *cur_chunk;
+
/* We have to start somewhere, and the global stash is a good
place */
last = current = interpreter->perl_stash->stash_hash;
+
/* mark it as used and get an updated end of list */
last = mark_used(current, last);
- /* Wipe out the next for gc bit, otherwise we'll never get anywhere */
- last->next_for_GC = NULL;
-
/* Now, go run through the PMC registers and mark them as live */
/* First mark the current set. */
for (i=0; i < NUM_REGISTERS; i++) {
@@ -407,7 +414,8 @@
/* Okay, we've marked the whole root set, and should have a
good-sized list 'o things to look at. Run through it */
- for (; current; current = current->next_for_GC) {
+ prev = NULL;
+ for (; current != prev; current = current->next_for_GC) {
UINTVAL mask = PMC_is_PMC_ptr_FLAG | PMC_is_buffer_ptr_FLAG;
UINTVAL bits = current->flags & mask;
@@ -420,7 +428,9 @@
}
else {
if (bits == PMC_is_buffer_ptr_FLAG) {
- buffer_lives(current->data);
+ if (current->data) {
+ buffer_lives(current->data);
+ }
}
else {
/* The only thing left is "buffer of PMCs" */
@@ -434,6 +444,7 @@
}
}
}
+ prev = current;
}
}
@@ -498,7 +509,7 @@
PMC *pmc_array = cur_arena->start_PMC;
for (i = 0; i < cur_arena->used; i++) {
/* If it's not live or on the free list, put it on the free list */
- if (!(pmc_array[i].flags & (PMC_live_FLAG |
+ if (!(pmc_array[i].flags & (PMC_live_FLAG | PMC_immortal_FLAG |
PMC_on_free_list_FLAG))) {
add_pmc_to_free(interpreter,
interpreter->arena_base->pmc_pool,
@@ -645,6 +656,8 @@
interpreter->active_Buffers++;
/* Mark it live */
return_me->flags = BUFFER_live_FLAG;
+ /* Don't let it point to garbage memory */
+ return_me->bufstart = NULL;
/* Return it */
return return_me;
}
@@ -826,6 +839,7 @@
if (NULL == interpreter) {
return mem_sys_allocate(size);
}
+
/* Make sure we round up to a multiple of 16 */
size += 16;
size &= ~0x0f;
Index: parrot/stacks.c
===================================================================
RCS file: /cvs/public/parrot/stacks.c,v
retrieving revision 1.25
diff -u -r1.25 stacks.c
--- parrot/stacks.c 22 Mar 2002 20:24:02 -0000 1.25
+++ parrot/stacks.c 29 Mar 2002 08:09:24 -0000
@@ -76,7 +76,7 @@
}
else {
chunk = stack_base->prev; /* Start at top */
- while (offset > chunk->used && chunk != stack_base) {
+ while (offset >= chunk->used && chunk != stack_base) {
offset -= chunk->used;
chunk = chunk->prev;
}
Index: parrot/classes/perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.17
diff -u -r1.17 perlint.pmc
--- parrot/classes/perlint.pmc 10 Mar 2002 21:18:13 -0000 1.17
+++ parrot/classes/perlint.pmc 29 Mar 2002 08:09:25 -0000
@@ -119,27 +119,27 @@
void set_string (PMC * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value->cache.struct_val;
+ SELF->data = value->cache.struct_val;
}
void set_string_native (STRING * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void set_string_unicode (STRING * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void set_string_other (STRING * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void set_string_same (PMC * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value->cache.struct_val;
+ SELF->data = value->cache.struct_val;
}
void set_value (void* value) {
Index: parrot/classes/perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.19
diff -u -r1.19 perlnum.pmc
--- parrot/classes/perlnum.pmc 10 Mar 2002 21:18:13 -0000 1.19
+++ parrot/classes/perlnum.pmc 29 Mar 2002 08:09:26 -0000
@@ -117,27 +117,27 @@
void set_string (PMC * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value->cache.struct_val;
+ SELF->data = value->cache.struct_val;
}
void set_string_native (STRING * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void set_string_unicode (STRING * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void set_string_other (STRING * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void set_string_same (PMC * value) {
SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
- SELF->cache.struct_val = value->cache.struct_val;
+ SELF->data = value->cache.struct_val;
}
void set_value (void* value) {
Index: parrot/classes/perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.18
diff -u -r1.18 perlstring.pmc
--- parrot/classes/perlstring.pmc 10 Mar 2002 21:18:13 -0000 1.18
+++ parrot/classes/perlstring.pmc 29 Mar 2002 08:09:26 -0000
@@ -23,12 +23,13 @@
}
void init (INTVAL size) {
- SELF->cache.struct_val = string_make(INTERP,NULL,0,NULL,0,NULL);
+ SELF->data = string_make(INTERP,NULL,0,NULL,0,NULL);
+ SELF->flags = PMC_is_buffer_ptr_FLAG;
}
void clone (PMC* dest) {
dest->vtable = SELF->vtable;
- dest->cache.struct_val = string_copy(INTERP,SELF->cache.struct_val);
+ dest->data = string_copy(INTERP,SELF->data);
}
void morph (INTVAL type) {
@@ -43,34 +44,34 @@
}
void destroy () {
- string_destroy(SELF->cache.struct_val);
+ string_destroy(SELF->data);
}
INTVAL get_integer () {
- STRING* s = (STRING*) SELF->cache.struct_val;
+ STRING* s = (STRING*) SELF->data;
return string_to_int(s);
}
FLOATVAL get_number () {
- STRING* s = (STRING*) SELF->cache.struct_val;
+ STRING* s = (STRING*) SELF->data;
return string_to_num(s);
}
STRING* get_string () {
- return (STRING*)SELF->cache.struct_val;
+ return (STRING*)SELF->data;
}
BOOLVAL get_bool () {
- return string_bool(SELF->cache.struct_val);
+ return string_bool(SELF->data);
}
void* get_value () {
- return &SELF->cache;
+ return &SELF->data;
}
BOOLVAL is_same (PMC* other) {
- STRING* s1 = (STRING*)SELF->cache.struct_val;
- STRING* s2 = (STRING*)other->cache.struct_val;
+ STRING* s1 = (STRING*)SELF->data;
+ STRING* s2 = (STRING*)other->data;
return (BOOLVAL)( other->vtable == SELF->vtable &&
s1->bufused == s2->bufused &&
(memcmp(s1->bufstart,s2->bufstart,(size_t)s1->bufused)==0));
@@ -113,29 +114,29 @@
}
void set_string (PMC * value) {
- SELF->cache.struct_val =
- string_copy(INTERP, (STRING*)value->cache.struct_val);
+ SELF->data =
+ string_copy(INTERP, (STRING*)value->data);
}
void set_string_native (STRING * value) {
- SELF->cache.struct_val = string_copy(INTERP, value);
+ SELF->data = string_copy(INTERP, value);
}
void set_string_unicode (STRING * value) {
- SELF->cache.struct_val = string_copy(INTERP, value);
+ SELF->data = string_copy(INTERP, value);
}
void set_string_other (STRING * value) {
- SELF->cache.struct_val = string_copy(INTERP, value);
+ SELF->data = string_copy(INTERP, value);
}
void set_string_same (PMC * value) {
- SELF->cache.struct_val =
- string_copy(INTERP, (STRING*)value->cache.struct_val);
+ SELF->data =
+ string_copy(INTERP, (STRING*)value->data);
}
void set_value (void* value) {
- SELF->cache.struct_val = value;
+ SELF->data = value;
}
void add (PMC * value, PMC* dest) {
@@ -347,54 +348,54 @@
}
void concatenate (PMC * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
- dest->cache.struct_val =
+ STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+ dest->data =
string_concat(INTERP,
s,
value->vtable->get_string(INTERP, value),
0
);
- /* don't destroy s, as it is dest->cache.struct_val */
+ /* don't destroy s, as it is dest->data */
}
void concatenate_native (STRING * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
- dest->cache.struct_val =
+ STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+ dest->data =
string_concat(INTERP,
s,
value,
0
);
- /* don't destroy s, as it is dest->cache.struct_val */
+ /* don't destroy s, as it is dest->data */
}
void concatenate_unicode (STRING * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
- dest->cache.struct_val =
+ STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+ dest->data =
string_concat(INTERP,
s,
value,
0
);
- /* don't destroy s, as it is dest->cache.struct_val */
+ /* don't destroy s, as it is dest->data */
}
void concatenate_other (STRING * value, PMC* dest) {
- STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
- dest->cache.struct_val =
+ STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+ dest->data =
string_concat(INTERP,
s,
value,
0
);
- /* don't destroy s, as it is dest->cache.struct_val */
+ /* don't destroy s, as it is dest->data */
}
void concatenate_same (PMC * value, PMC* dest) {
- dest->cache.struct_val =
+ dest->data =
string_concat(INTERP,
- SELF->cache.struct_val,
- value->cache.struct_val,
+ SELF->data,
+ value->data,
0
);
}
@@ -402,7 +403,7 @@
/* == operation */
BOOLVAL is_equal (PMC* value) {
return (BOOLVAL)( 0 == string_compare(INTERP,
- SELF->cache.struct_val,
+ SELF->data,
value->vtable->get_string(INTERP,
value)
));
}
@@ -430,40 +431,40 @@
void repeat (PMC * value, PMC* dest) {
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
- dest->cache.struct_val =
- string_repeat(INTERP, SELF->cache.struct_val,
+ dest->data =
+ string_repeat(INTERP, SELF->data,
(UINTVAL)value->vtable->get_integer(INTERP, value), NULL
);
}
void repeat_native (STRING * value, PMC* dest) {
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
- dest->cache.struct_val =
- string_repeat(INTERP, SELF->cache.struct_val,
+ dest->data =
+ string_repeat(INTERP, SELF->data,
(UINTVAL)string_to_int(value), NULL
);
}
void repeat_unicode (STRING * value, PMC* dest) {
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
- dest->cache.struct_val =
- string_repeat(INTERP, SELF->cache.struct_val,
+ dest->data =
+ string_repeat(INTERP, SELF->data,
(UINTVAL)string_to_int(value), NULL
);
}
void repeat_other (STRING * value, PMC* dest) {
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
- dest->cache.struct_val =
- string_repeat(INTERP, SELF->cache.struct_val,
+ dest->data =
+ string_repeat(INTERP, SELF->data,
(UINTVAL)string_to_int(value), NULL
);
}
void repeat_same (PMC * value, PMC* dest) {
dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
- dest->cache.struct_val =
- string_repeat(INTERP, SELF->cache.struct_val,
+ dest->data =
+ string_repeat(INTERP, SELF->data,
(UINTVAL)value->vtable->get_integer(INTERP, value), NULL
);
}
Index: parrot/include/parrot/pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.24
diff -u -r1.24 pmc.h
--- parrot/include/parrot/pmc.h 15 Mar 2002 19:45:00 -0000 1.24
+++ parrot/include/parrot/pmc.h 29 Mar 2002 08:09:27 -0000
@@ -38,6 +38,12 @@
DPOINTER *struct_val;
} cache;
SYNC *synchronize;
+ /* This flag determines the next PMC in the 'used' list during
+ dead object detection in the GC. It is a linked list, which is
+ only valid in trace_active_PMCs. Also, the linked list is
+ 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
@@ -98,7 +104,10 @@
/* Our refcount */
PMC_refcount_field = 1 << 16 | 1 << 17,
/* Constant flag */
- PMC_constant_FLAG = 1 << 18
+ PMC_constant_FLAG = 1 << 18,
+ /* Immortal flag, for ensuring a PMC survives DOD. Used internally
+ * by the GC: should not be used in PMC code. */
+ PMC_immortal_FLAG = 1 << 19
} PMC_flags;
/* XXX add various bit test macros once we have need of them */
