cvsuser 05/02/24 03:56:44
Modified: classes fixedstringarray.pmc resizablestringarray.pmc
include/parrot dod.h
src gc_gms.c
Log:
GMS generational MS 6 - bug fixes
* add missing write barriers in string arrays
* clear live bits after DOD run
* 43 more tests are passing 72/2221 still failing
Revision Changes Path
1.6 +15 -14 parrot/classes/fixedstringarray.pmc
Index: fixedstringarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedstringarray.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- fixedstringarray.pmc 29 Dec 2004 22:47:56 -0000 1.5
+++ fixedstringarray.pmc 24 Feb 2005 11:56:42 -0000 1.6
@@no-spam -1,6 +1,6 @@no-spam
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedstringarray.pmc,v 1.5 2004/12/29 22:47:56 scog Exp $
+$Id: fixedstringarray.pmc,v 1.6 2005/02/24 11:56:42 leo Exp $
=head1 NAME
@@no-spam -8,7 +8,7 @@no-spam
=head1 DESCRIPTION
-This class, FixedStringArray, implements an array of fixed size, which
+This class, FixedStringArray, implements an array of fixed size, which
stores Parrot strings.
=head2 Functions
@@no-spam -22,7 +22,7 @@no-spam
#include "parrot/parrot.h"
pmclass FixedStringArray need_ext does array {
-
+
/*
=back
@@no-spam -89,12 +89,12 @@no-spam
PMC* clone () {
INTVAL size;
PMC * dest = pmc_new(INTERP, SELF->vtable->base_type);
-
+
if (!PMC_data(SELF))
return dest;
size = PMC_int_val(SELF);
PMC_int_val(dest) = size;
-
+
PMC_data(dest) = mem_sys_allocate(size * sizeof(STRING*));
mem_sys_memcopy(PMC_data(dest), PMC_data(SELF), size*sizeof(STRING*));
PObj_custom_mark_destroy_SETALL(dest);
@@no-spam -129,9 +129,9 @@no-spam
=item C<INTVAL get_bool()>
-Returns 1 if the array has any elements; otherwise, returns 0.
-Since this is a fixed size array, C<get_bool> will always
-return true once the array has been initialized and had its
+Returns 1 if the array has any elements; otherwise, returns 0.
+Since this is a fixed size array, C<get_bool> will always
+return true once the array has been initialized and had its
size set by C<set_integer_native>.
=cut
@@no-spam -246,9 +246,9 @@no-spam
STRING* get_string_keyed_int (INTVAL key) {
STRING **data;
if (key < 0 || key >= PMC_int_val(SELF))
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"FixedStringArray: index out of bounds!");
-
+
data = (STRING **)PMC_data(SELF);
return data[key];
}
@@no-spam -308,8 +308,8 @@no-spam
=item C<void set_integer_native(INTVAL size)>
-Sets the size of the array to C<size> elements. Once the array
-has been given an initial size, attempts to resize it will
+Sets the size of the array to C<size> elements. Once the array
+has been given an initial size, attempts to resize it will
cause an exception to be thrown.
=cut
@@no-spam -397,7 +397,7 @@no-spam
k = key_integer(INTERP, key);
DYNSELF.set_number_keyed_int(k, value);
}
-
+
/*
=item C<void set_string_keyed_int(INTVAL key, STRING *value)>
@@no-spam -411,10 +411,11 @@no-spam
void set_string_keyed_int (INTVAL key, STRING* value) {
STRING **data;
if (key < 0 || key >= PMC_int_val(SELF))
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"FixedStringArray: index out of bounds!");
data = (STRING**)PMC_data(SELF);
+ DOD_WRITE_BARRIER(INTERP, SELF, data[key], value);
data[key] = value;
}
1.11 +12 -11 parrot/classes/resizablestringarray.pmc
Index: resizablestringarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/resizablestringarray.pmc,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- resizablestringarray.pmc 12 Jan 2005 11:42:06 -0000 1.10
+++ resizablestringarray.pmc 24 Feb 2005 11:56:42 -0000 1.11
@@no-spam -1,6 +1,6 @@no-spam
/*
Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
-$Id: resizablestringarray.pmc,v 1.10 2005/01/12 11:42:06 leo Exp $
+$Id: resizablestringarray.pmc,v 1.11 2005/02/24 11:56:42 leo Exp $
=head1 NAME
@@no-spam -8,7 +8,7 @@no-spam
=head1 DESCRIPTION
-ResizableStringArray implements a resizeable array which stores Parrot
+ResizableStringArray implements a resizeable array which stores Parrot
strings only. Any ints or floats assigned to elements of the array will
first be converted to String PMCs and then to native Parrot strings.
PMCs assigned to to elements of the array will be stringified by having
@@no-spam -31,7 +31,7 @@no-spam
#define NEEDED_SIZE(n) ((n-1)*sizeof(STRING*) + sizeof(SizeStringData))
pmclass ResizableStringArray extends FixedStringArray need_ext does array {
-
+
/*
=item C<STRING *get_string_keyed_int(INTVAL key)>
@@no-spam -45,11 +45,11 @@no-spam
STRING* get_string_keyed_int (INTVAL key) {
SizeStringData *sd;
if (key < 0)
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"ResizableStringArray: index out of bounds!");
if(key >= PMC_int_val(SELF))
DYNSELF.set_integer_native(key+1);
-
+
sd = (SizeStringData *)PMC_data(SELF);
return sd->data[key];
}
@@no-spam -67,12 +67,13 @@no-spam
void set_string_keyed_int (INTVAL key, STRING* value) {
SizeStringData *sd;
if (key < 0)
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"ResizableStringArray: index out of bounds!");
if(key >= PMC_int_val(SELF))
DYNSELF.set_integer_native(key+1);
sd = (SizeStringData *)PMC_data(SELF);
+ DOD_WRITE_BARRIER(INTERP, SELF, sd->data[key], value);
sd->data[key] = value;
}
@@no-spam -111,7 +112,7 @@no-spam
sd = (SizeStringData *)PMC_data(SELF);
if (sd == NULL || size == 0) {
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"ResizableStringArray: Can't pop from an empty array!");
}
@@no-spam -135,7 +136,7 @@no-spam
SizeStringData *sd;
if (size < 0)
- internal_exception(OUT_OF_BOUNDS,
+ internal_exception(OUT_OF_BOUNDS,
"ResizableStringArray: Can't resize!");
sd = (SizeStringData *)PMC_data(SELF);
@@no-spam -158,7 +159,7 @@no-spam
PMC_data(SELF) = sd;
PObj_custom_mark_destroy_SETALL(SELF);
}
-
+
/*
=item C<PMC *clone()>
@@no-spam -172,12 +173,12 @@no-spam
PMC* clone () {
SizeStringData *sd;
PMC * dest = pmc_new(INTERP, SELF->vtable->base_type);
-
+
if (!PMC_data(SELF))
return dest;
PMC_int_val(dest) = PMC_int_val(SELF);
sd = (SizeStringData *)PMC_data(SELF);
-
+
PMC_data(dest) = mem_sys_allocate(NEEDED_SIZE(sd->size));
mem_sys_memcopy(PMC_data(dest), PMC_data(SELF), NEEDED_SIZE(sd->size));
PObj_custom_mark_destroy_SETALL(SELF);
1.26 +3 -3 parrot/include/parrot/dod.h
Index: dod.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/dod.h,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- dod.h 25 Jan 2005 14:47:31 -0000 1.25
+++ dod.h 24 Feb 2005 11:56:43 -0000 1.26
@@no-spam -1,7 +1,7 @@no-spam
/* dod.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.h,v 1.25 2005/01/25 14:47:31 leo Exp $
+ * $Id: dod.h,v 1.26 2005/02/24 11:56:43 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@no-spam -143,9 +143,9 @@no-spam
parrot_gc_gms_wb_key(interp, agg, old, old_key, new, new_key); \
} while (0)
-void parrot_gc_gms_wb(Interp *, PMC *agg, PMC *old, PMC *new);
+void parrot_gc_gms_wb(Interp *, PMC *agg, void *old, void *new);
void parrot_gc_gms_wb_key(Interp *, PMC *agg,
- PMC *old, void *old_key, PMC *new, void *new_key);
+ void *old, void *old_key, void *new, void *new_key);
#endif
1.2 +19 -5 parrot/src/gc_gms.c
Index: gc_gms.c
===================================================================
RCS file: /cvs/public/parrot/src/gc_gms.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- gc_gms.c 30 Jan 2005 13:30:12 -0000 1.1
+++ gc_gms.c 24 Feb 2005 11:56:44 -0000 1.2
@@no-spam -1,6 +1,6 @@no-spam
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: gc_gms.c,v 1.1 2005/01/30 13:30:12 leo Exp $
+$Id: gc_gms.c,v 1.2 2005/02/24 11:56:44 leo Exp $
=head1 NAME
@@no-spam -398,7 +398,9 @@no-spam
hdr = pool->free_list;
pool->free_list = hdr->next;
hdr->gen = pool->last_gen;
- return hdr + 1;
+ ptr = GMSH_to_PObj(hdr);
+ PObj_flags_SETTO( (PObj*) ptr, 0);
+ return ptr;
}
/*
@@no-spam -611,7 +613,7 @@no-spam
}
void
-parrot_gc_gms_wb(Interp *interpreter, PMC *agg, PMC *old, PMC *new)
+parrot_gc_gms_wb(Interp *interpreter, PMC *agg, void *old, void *new)
{
Gc_gms_hdr *nh, *ah;
@@no-spam -621,7 +623,7 @@no-spam
/* if this may be an aggregate store it in IGP list, thus making
* it a possible root for this generation
*/
- if (PObj_is_PMC_TEST(new) && ((PMC*)new)->pmc_ext)
+ if (PObj_is_PMC_TEST((PObj*)new) && ((PMC*)new)->pmc_ext)
gc_gms_store_igp(interpreter, nh);
/* promote RHS to old generation of aggregate */
@@no-spam -636,7 +638,7 @@no-spam
void
parrot_gc_gms_wb_key(Interp *interpreter, PMC *agg,
- PMC *old, void *old_key, PMC *new, void *new_key)
+ void *old, void *old_key, void *new, void *new_key)
{
Gc_gms_hdr *nh, *ah;
@@no-spam -1218,6 +1220,15 @@no-spam
end_cycle_cb(Interp *interpreter, struct Small_Object_Pool *pool,
int flag, void *arg)
{
+ Gc_gms_hdr *h;
+ /*
+ * clear live flags
+ * TODO just swap black and white
+ */
+ if (!pool->black || pool->black == &pool->marker)
+ return 0;
+ for (h = pool->black; h != pool->white; h = h->next)
+ PObj_live_CLEAR(GMSH_to_PObj(h));
pool->black = pool->black_fin = pool->gray = pool->white;
return 0;
}
@@no-spam -1257,6 +1268,7 @@no-spam
if (arena_base->DOD_block_level) {
return;
}
+ ++arena_base->DOD_block_level;
g_gms = arena_base->gc_private;
if (flags & DOD_finish_FLAG) {
struct Small_Object_Pool *pool;
@@no-spam -1266,6 +1278,7 @@no-spam
/* XXX need to sweep over objects that have finalizers only */
Parrot_forall_header_pools(interpreter, POOL_PMC, 0, sweep_cb_pmc);
gc_gms_end_cycle(interpreter);
+ --arena_base->DOD_block_level;
return;
}
@@no-spam -1285,6 +1298,7 @@no-spam
++arena_base->lazy_dod_runs;
}
gc_gms_end_cycle(interpreter);
+ --arena_base->DOD_block_level;
}
#if GC_GMS_DEBUG