Oh, yay. Orange tinderboxen rule, only because I haven't seen that much
orange in quite awhile. :)
Anyways, I looked into the bug. There's actually a few problems...First,
is that perlstrings use the structval to store the buffer, and so it gets
missed by the GC. The patch below fixes perlstring to use the data pointer
like the GC wants. (And the other perl* classes, to use perlstring's data
pointer. What happened to the encapsulation in calling set_number, etc?)
Then I found a small GC bug where it was trying to buffer_lives on a null
pointer. Below patch fixes this as well.
Then there was *still* corruption. I thought this is the 'GC before I've
done anything with it' problem. When I create a new pmc, it calls init()
before the pmc gets put into the reg table. If the vtable init() creates a
new string (PerlString does this), then it's possible a dod run will
occur, and cause the as-yet-unassigned PMC to be incorrectly freed. Below
patch marks it as immortal for the duration of the init() call.
This finally fixed the problem. :)
While I was at it, I also made string_copy set the 'live' flag on the
newly-created string, such that when it calls Parrot_allocate for the
string's contents, a call to Parrot_go_collect will not forget to copy our
new string.
Note, there is one 'big' problem with this patch. It makes it impossible
to make constant pmc's using the init() vtable method, since it unsets the
flag after calling the function. Perhaps we should make a private GC flag,
PMC_private_constant_FLAG, or something, which the PMCs should *never*
use, and is reserved for the GC, in cases like these.
Regardless, this patch does make 'make test' happy again, and should be
safe to apply apply, as long as we don't forget about the afore-mentioned
caveat, which will probably come back to bite us in the future if we don't
take care of it. I wonder how many more GC bugs are lurking, waiting for
good tests cases like these..
Mike Lambert
Josh Wilmes wrote:
> Date: Thu, 28 Mar 2002 02:52:15 -0500
> From: Josh Wilmes <[EMAIL PROTECTED]>
> To: [EMAIL PROTECTED]
> Subject: Re: "deep" tests for stacks.t
>
>
> Mike pointed out that I was missing "end" opcodes in there, so I added
> them and went ahead and committed this code to CVS. Currently test #7 is
> failing, but I think it's a legitimate bug- if not, I apologize for
> breaking the tinderbox ;)
>
> --Josh
>
> At 1:15 on 03/28/2002 EST, Josh Wilmes <[EMAIL PROTECTED]> wrote:
>
> >
> > I added some tests which push larger numbers of stack frames- this
> > improves our coverage in register.c. However, one of the tests is failing
> > for me. Is this something I did wrong, or did I find a bug?
> >
> > I'm getting weird output for the pushp and popp (deep) test.
> >
> > --Josh
> >
> > Here's the patch:
> >
> > Index: t/op/stacks.t
> > ===================================================================
> > RCS file: /cvs/public/parrot/t/op/stacks.t,v
> > retrieving revision 1.12
> > diff -u -r1.12 stacks.t
> > --- t/op/stacks.t 29 Jan 2002 02:32:17 -0000 1.12
> > +++ t/op/stacks.t 28 Mar 2002 06:12:31 -0000
> > @@ -1,6 +1,6 @@
> > #! perl -w
> >
> > -use Parrot::Test tests => 15;
> > +use Parrot::Test tests => 18;
> > use Test::More;
> >
> > # Tests for stack operations, currently push*, push_*_c and pop*
> > @@ -87,6 +87,23 @@
> > 3031
> > OUTPUT
> >
> > +
> > +my ($code, $output);
> > +for (0..1024) {
> > + $code .= " set I0, $_\n";
> > + $code .= " set I31, " . (1024-$_) . "\n";
> > + $code .= " pushi\n";
> > +}
> > +for (0..1024) {
> > + $code .= " popi\n";
> > + $code .= " print I0\n";
> > + $code .= " print I31\n";
> > + $code .= " print \"\\n\"\n";
> > + $output .= (1024-$_) . "$_\n";
> > +}
> > +output_is($code, $output, "pushi & popi (deep)" );
> > +
> > +
> > output_is(<<"CODE", <<'OUTPUT', 'pushs & pops');
> > @{[ set_str_regs( sub {$_[0]%2} ) ]}
> > pushs
> > @@ -102,6 +119,23 @@
> > 01010101010101010101010101010101
> > OUTPUT
> >
> > +
> > +($code, $output) = ();
> > +for (0..1024) {
> > + $code .= " set S0, \"$_\"\n";
> > + $code .= " set S31, \"" . (1024-$_) . "\"\n";
> > + $code .= " pushs\n";
> > +}
> > +for (0..1024) {
> > + $code .= " pops\n";
> > + $code .= " print S0\n";
> > + $code .= " print S31\n";
> > + $code .= " print \"\\n\"\n";
> > + $output .= (1024-$_) . "$_\n";
> > +}
> > +output_is($code, $output, "pushs & pops (deep)" );
> > +
> > +
> > output_is(<<"CODE", <<'OUTPUT', 'pushn & popn');
> > @{[ set_num_regs( sub { "1.0".$_ } ) ]}
> > pushn
> > @@ -119,6 +153,7 @@
> > Seem to have positive Nx after pop
> > OUTPUT
> >
> > +
> > output_is(<<"CODE", <<'OUTPUT', 'pushp & popp');
> > new P0, PerlString
> > set P0, "BUTTER IN HELL!\\n"
> > @@ -132,6 +167,25 @@
> > CODE
> > THERE'LL BE NO BUTTER IN HELL!
> > OUTPUT
> > +
> > +
> > +($code, $output) = ();
> > +for (0..1024) {
> > + $code .= " new P0, PerlString\n";
> > + $code .= " new P31, PerlString\n";
> > + $code .= " set P0, \"$_\"\n";
> > + $code .= " set P31, \"" . (1024-$_) . "\"\n";
> > + $code .= " pushp\n";
> > +}
> > +for (0..1024) {
> > + $code .= " popp\n";
> > + $code .= " print P0\n";
> > + $code .= " print P31\n";
> > + $code .= " print \"\\n\"\n";
> > + $output .= (1024-$_) . "$_\n";
> > +}
> > +output_is($code, $output, "pushp & popp (deep)" );
> > +
> >
> > # Test proper stack chunk handling
> > output_is(<<CODE, <<'OUTPUT', 'save_i & restore_i');
> >
> >
>
>
>
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 28 Mar 2002 10:18:33 -0000
@@ -52,7 +52,11 @@
return NULL;
}
+ /* This flag gets turned off in a second anyway.
+ This ensures the string survives Parrot_do_dod_run */
+ pmc->flags |= PMC_constant_FLAG | PMC_live_FLAG;
pmc->vtable->init(interpreter, pmc, 0);
+ pmc->flags &= ~PMC_constant_FLAG;
return pmc;
}
@@ -80,7 +84,11 @@
return NULL;
}
+ /* This flag gets turned off in a second anyway.
+ This ensures the string survives Parrot_do_dod_run */
+ pmc->flags |= PMC_constant_FLAG | PMC_live_FLAG;
pmc->vtable->init(interpreter, pmc, size);
+ pmc->flags &= ~PMC_constant_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 28 Mar 2002 10:18:34 -0000
@@ -420,7 +420,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" */
Index: parrot/string.c
===================================================================
RCS file: /cvs/public/parrot/string.c,v
retrieving revision 1.64
diff -u -r1.64 string.c
--- parrot/string.c 24 Mar 2002 06:57:28 -0000 1.64
+++ parrot/string.c 28 Mar 2002 10:18:34 -0000
@@ -166,6 +166,9 @@
{
STRING *d;
d = new_string_header(interpreter);
+ /* This flag gets reset in a bit anyway.
+ This ensures the string survives Parrot_go_collect */
+ d->flags = BUFFER_live_FLAG;
d->bufstart = Parrot_allocate(interpreter, s->buflen);
d->buflen = s->buflen;
d->flags = s->flags & (~(unsigned int)BUFFER_constant_FLAG);
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 28 Mar 2002 10:18:36 -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 28 Mar 2002 10:18:36 -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 28 Mar 2002 10:18:36 -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,25 +44,25 @@
}
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 () {
@@ -69,8 +70,8 @@
}
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
);
}
