cvsuser 04/08/19 06:46:15
Modified: classes array.pmc default.pmc sarray.pmc
include/parrot list.h objects.h
src list.c objects.c pmc_freeze.c
Log:
gc subsystems 7 - more write barriers
* array, perlarray, orderedhash in list_set
* objects - hidden in set_attrib_num
* sarray
* todo refs, tqueue
* only 6 failing tests with incremental GC enabled:
2 freeze - known, s. TODO in pmc_freeze.c
4 nci/callbacks
Revision Changes Path
1.90 +6 -4 parrot/classes/array.pmc
Index: array.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/array.pmc,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -w -r1.89 -r1.90
--- array.pmc 19 Aug 2004 11:48:14 -0000 1.89
+++ array.pmc 19 Aug 2004 13:46:12 -0000 1.90
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: array.pmc,v 1.89 2004/08/19 11:48:14 leo Exp $
+$Id: array.pmc,v 1.90 2004/08/19 13:46:12 leo Exp $
=head1 NAME
@@ -182,7 +182,7 @@
*/
void init () {
- PMC_data(SELF) = list_new(INTERP, enum_type_PMC);
+ list_pmc_new(INTERP, SELF);
PObj_custom_mark_SET(SELF);
}
@@ -200,7 +200,7 @@
*/
void init_pmc (PMC *init) {
- PMC_data(SELF) = list_new_init(INTERP, enum_type_PMC, init);
+ list_pmc_new_init(INTERP, SELF, init);
PObj_custom_mark_SET(SELF);
}
@@ -229,9 +229,11 @@
*/
PMC* clone () {
+ List *l;
PMC* dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);
PObj_custom_mark_SET(dest);
- PMC_data(dest) = list_clone(INTERP, (List *) PMC_data(SELF));
+ PMC_data(dest) = l = list_clone(INTERP, (List *) PMC_data(SELF));
+ l->container = dest;
return dest;
}
1.98 +12 -7 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.97
retrieving revision 1.98
diff -u -w -r1.97 -r1.98
--- default.pmc 23 Jul 2004 13:26:21 -0000 1.97
+++ default.pmc 19 Aug 2004 13:46:12 -0000 1.98
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.97 2004/07/23 13:26:21 leo Exp $
+$Id: default.pmc,v 1.98 2004/08/19 13:46:12 leo Exp $
=head1 NAME
@@ -248,14 +248,16 @@
VTABLE_set_pmc_keyed_str(interpreter,
PMC_metadata(SELF), key, value);
} else {
+ PMC *prop;
if (!SELF->pmc_ext)
add_pmc_ext(INTERP, SELF);
/* first make new hash */
- PMC_metadata(SELF) = pmc_new_noinit(interpreter, enum_class_PerlHash);
- VTABLE_init(interpreter, PMC_metadata(SELF));
+ PMC_metadata(SELF) = prop =
+ pmc_new_noinit(interpreter, enum_class_PerlHash);
+ DOD_WRITE_BARRIER(interpreter, SELF, NULL, prop);
+ VTABLE_init(interpreter, prop);
/* then the key, else it vanishes with --gc-debug */
- VTABLE_set_pmc_keyed_str(interpreter,
- PMC_metadata(SELF), key, value);
+ VTABLE_set_pmc_keyed_str(interpreter, prop, key, value);
#if 0
PObj_report_SET(PMC_metadata(SELF));
#endif
@@ -294,8 +296,11 @@
if (!SELF->pmc_ext)
add_pmc_ext(INTERP, SELF);
if (!PMC_metadata(SELF)) {
- PMC_metadata(SELF) = pmc_new_noinit(interpreter, enum_class_PerlHash);
- VTABLE_init(interpreter, PMC_metadata(SELF));
+ PMC *prop;
+ PMC_metadata(SELF) = prop =
+ pmc_new_noinit(interpreter, enum_class_PerlHash);
+ DOD_WRITE_BARRIER(interpreter, SELF, NULL, prop);
+ VTABLE_init(interpreter, prop);
}
return PMC_metadata(SELF);
}
1.29 +2 -1 parrot/classes/sarray.pmc
Index: sarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sarray.pmc,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- sarray.pmc 2 Jul 2004 09:30:00 -0000 1.28
+++ sarray.pmc 19 Aug 2004 13:46:12 -0000 1.29
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sarray.pmc,v 1.28 2004/07/02 09:30:00 leo Exp $
+$Id: sarray.pmc,v 1.29 2004/08/19 13:46:12 leo Exp $
=head1 NAME
@@ -767,6 +767,7 @@
internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
e = (HashEntry *) PMC_data(SELF) + (2 + key);
e->type = enum_hash_pmc;
+ DOD_WRITE_BARRIER(INTERP, SELF, UVal_pmc(e->val), src);
UVal_pmc(e->val) = src;
e = (HashEntry *) PMC_data(SELF) + 1;
if (key >= UVal_int(e->val))
1.17 +4 -1 parrot/include/parrot/list.h
Index: list.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/list.h,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- list.h 22 Apr 2004 08:55:05 -0000 1.16
+++ list.h 19 Aug 2004 13:46:14 -0000 1.17
@@ -3,7 +3,7 @@
* Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
* License: Artistic/GPL, see README and LICENSES for details
* CVS Info
- * $Id: list.h,v 1.16 2004/04/22 08:55:05 leo Exp $
+ * $Id: list.h,v 1.17 2004/08/19 13:46:14 leo Exp $
* Overview:
* list aka array routines for Parrot
* s. list.c for more
@@ -33,6 +33,7 @@
Buffer chunk_list; /* pointers to chunks */
UINTVAL length; /* number of items in list */
UINTVAL start; /* offset, where array[0] is */
+ PMC * container; /* the Array PMC */
int item_type; /* item type */
int item_size; /* item size */
int items_per_chunk; /* override defaults */
@@ -76,6 +77,8 @@
List * list_new(Interp *interpreter, INTVAL type);
List * list_new_init(Interp *interpreter, INTVAL type, PMC *init);
+void list_pmc_new(Interp *interpreter, PMC *container);
+void list_pmc_new_init(Interp *interpreter, PMC *container, PMC *init);
List * list_clone(Interp *interpreter, List *other);
void list_mark(Interp* interpreter, List* list);
void list_visit(Interp* interpreter, List* list, void*);
1.28 +7 -3 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- objects.h 16 Jul 2004 12:15:31 -0000 1.27
+++ objects.h 19 Aug 2004 13:46:14 -0000 1.28
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.27 2004/07/16 12:15:31 leo Exp $
+ * $Id: objects.h,v 1.28 2004/08/19 13:46:14 leo Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -69,7 +69,11 @@
*/
#define SLOTTYPE PMC*
#define get_attrib_num(x, y) ((PMC **)x)[y]
-#define set_attrib_num(x, y, z) ((PMC **)x)[y] = z
+#define set_attrib_num(o, x, y, z) \
+ do { \
+ DOD_WRITE_BARRIER(interpreter, o, ((PMC **)x)[y], z); \
+ ((PMC **)x)[y] = z; \
+ } while (0)
#define get_attrib_count(x) PMC_int_val2(x)
#define new_attrib_array() Dont_use
#define set_attrib_flags(x) PObj_data_is_PMC_array_SET(x)
@@ -89,7 +93,7 @@
# define ATTRIB_COUNT(obj) PMC_int_val2(obj)
# define SET_CLASS(arr, obj, class) \
- set_attrib_num(arr, POD_CLASS, class)
+ set_attrib_num(obj, arr, POD_CLASS, class)
# define GET_CLASS(arr, obj) \
get_attrib_num(arr, POD_CLASS)
1.52 +36 -1 parrot/src/list.c
Index: list.c
===================================================================
RCS file: /cvs/public/parrot/src/list.c,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -r1.51 -r1.52
--- list.c 25 Jul 2004 10:40:29 -0000 1.51
+++ list.c 19 Aug 2004 13:46:14 -0000 1.52
@@ -1,7 +1,7 @@
/*
Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
License: Artistic/GPL, see README and LICENSES for details
-$Id: list.c,v 1.51 2004/07/25 10:40:29 leo Exp $
+$Id: list.c,v 1.52 2004/08/19 13:46:14 leo Exp $
=head1 NAME
@@ -1022,6 +1022,11 @@
((FLOATVAL *) PObj_bufstart(&chunk->data))[idx] = *(FLOATVAL *)item;
break;
case enum_type_PMC:
+ if (list->container) {
+ DOD_WRITE_BARRIER(interpreter, list->container,
+ ((PMC **) PObj_bufstart(&chunk->data))[idx],
+ (PMC*)item);
+ }
((PMC **) PObj_bufstart(&chunk->data))[idx] = (PMC *)item;
break;
case enum_type_STRING:
@@ -1131,6 +1136,11 @@
Returns a new list of type C<type>.
+=item C<void
+list_pmc_new(Interp *interpreter, PMC *container)>
+
+Create a new list containing PMC* values in PMC_data(container).
+
=cut
*/
@@ -1172,6 +1182,14 @@
return list;
}
+void
+list_pmc_new(Interp *interpreter, PMC *container)
+{
+ List *l = list_new(interpreter, enum_type_PMC);
+ l->container = container;
+ PMC_data(container) = l;
+}
+
/*
=item C<List *
@@ -1188,6 +1206,11 @@
After getting these values out of the key/value pairs, a new array with
these values is stored in user_data, where the keys are explicit.
+=item C<void
+list_pmc_new_init(Interp *interpreter, PMC *container, PMC *init)>
+
+Create a new list containing PMC* values in PMC_data(container).
+
=cut
*/
@@ -1261,6 +1284,18 @@
return list;
}
+void
+list_pmc_new_init(Interp *interpreter, PMC *container, PMC *init)
+{
+ List *l = list_new_init(interpreter, enum_type_PMC, init);
+ l->container = container;
+ PMC_data(container) = l;
+ /*
+ * this is a new PMC, so no old value
+ */
+ DOD_WRITE_BARRIER(interpreter, container, NULL, l->user_data);
+}
+
/*
=item C<List *
1.115 +17 -16 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.114
retrieving revision 1.115
diff -u -w -r1.114 -r1.115
--- objects.c 3 Aug 2004 18:56:06 -0000 1.114
+++ objects.c 19 Aug 2004 13:46:14 -0000 1.115
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.114 2004/08/03 18:56:06 scog Exp $
+$Id: objects.c,v 1.115 2004/08/19 13:46:14 leo Exp $
=head1 NAME
@@ -159,8 +159,8 @@
}
/* And replace what was in there with the new ones */
- set_attrib_num(class_slots, PCD_ATTRIBUTES, attr_offset_hash);
- set_attrib_num(class_slots, PCD_ATTRIB_OFFS, class_offset_hash);
+ set_attrib_num(class, class_slots, PCD_ATTRIBUTES, attr_offset_hash);
+ set_attrib_num(class, class_slots, PCD_ATTRIB_OFFS, class_offset_hash);
/* And note the totals */
ATTRIB_COUNT(class) = cur_offset - POD_FIRST_ATTRIB;
}
@@ -306,7 +306,7 @@
parents = pmc_new(interpreter, enum_class_Array);
VTABLE_set_integer_native(interpreter, parents, 1);
VTABLE_set_pmc_keyed_int(interpreter, parents, 0, base_class);
- set_attrib_num(child_class_array, PCD_PARENTS, parents);
+ set_attrib_num(child_class, child_class_array, PCD_PARENTS, parents);
/* Set the classname, if we have one */
classname_pmc = pmc_new(interpreter, enum_class_PerlString);
@@ -320,7 +320,7 @@
child_class_name );
}
- set_attrib_num(child_class_array, PCD_CLASS_NAME, classname_pmc);
+ set_attrib_num(child_class, child_class_array, PCD_CLASS_NAME, classname_pmc);
/* Our penultimate parent list is a clone of our parent's parent
list, with our parent unshifted onto the beginning */
@@ -339,12 +339,13 @@
VTABLE_set_integer_native(interpreter, temp_pmc, 0);
}
VTABLE_unshift_pmc(interpreter, temp_pmc, base_class);
- set_attrib_num(child_class_array, PCD_ALL_PARENTS, temp_pmc);
+ set_attrib_num(child_class, child_class_array, PCD_ALL_PARENTS, temp_pmc);
/* But we have no attributes of our own. Yet */
temp_pmc = pmc_new(interpreter, enum_class_Array);
- set_attrib_num(child_class_array, PCD_CLASS_ATTRIBUTES, temp_pmc);
+ set_attrib_num(child_class, child_class_array, PCD_CLASS_ATTRIBUTES,
+ temp_pmc);
Parrot_class_register(interpreter, child_class_name, child_class,
base_class);
@@ -390,18 +391,18 @@
/* We will have five entries in this array */
/* Our parent class array has nothing in it */
- set_attrib_num(class_array, PCD_PARENTS,
+ set_attrib_num(class, class_array, PCD_PARENTS,
pmc_new(interpreter, enum_class_Array));
- set_attrib_num(class_array, PCD_ALL_PARENTS,
+ set_attrib_num(class, class_array, PCD_ALL_PARENTS,
pmc_new(interpreter, enum_class_Array));
- set_attrib_num(class_array, PCD_CLASS_ATTRIBUTES,
+ set_attrib_num(class, class_array, PCD_CLASS_ATTRIBUTES,
pmc_new(interpreter, enum_class_Array));
/* Set the classname, if we have one */
classname_pmc = pmc_new(interpreter, enum_class_PerlString);
VTABLE_set_string_native(interpreter, classname_pmc, class_name);
- set_attrib_num(class_array, PCD_CLASS_NAME, classname_pmc);
+ set_attrib_num(class, class_array, PCD_CLASS_NAME, classname_pmc);
Parrot_class_register(interpreter, class_name, class, NULL);
@@ -512,7 +513,7 @@
new_vtable = Parrot_clone_vtable(interpreter, parent_vtable);
new_vtable->base_type = new_type;
- set_attrib_num((SLOTTYPE*)PMC_data(new_class), PCD_OBJECT_VTABLE,
+ set_attrib_num(new_class, (SLOTTYPE*)PMC_data(new_class), PCD_OBJECT_VTABLE,
vtable_pmc = constant_pmc_new(interpreter, enum_class_VtableCache));
PMC_struct_val(vtable_pmc) = new_vtable;
@@ -572,7 +573,7 @@
if (parent_class->vtable->base_type != enum_class_ParrotClass)
VTABLE_invoke(interpreter, parent_class, NULL);
attr = REG_PMC(5);
- set_attrib_num(obj_data, POD_FIRST_ATTRIB, attr);
+ set_attrib_num(object, obj_data, POD_FIRST_ATTRIB, attr);
}
}
meth_str = CONST_STRING(interpreter, "__init__");
@@ -629,7 +630,7 @@
PMC *attr = pmc_new_noinit(interpreter,
parent_class->vtable->base_type);
SLOTTYPE *obj_data = PMC_data(object);
- set_attrib_num(obj_data, POD_FIRST_ATTRIB, attr);
+ set_attrib_num(object, obj_data, POD_FIRST_ATTRIB, attr);
VTABLE_init(interpreter, attr);
continue;
}
@@ -787,7 +788,7 @@
set_attrib_flags(object);
/* 0 - class PMC, 1 - class name */
SET_CLASS(new_object_array, object, class);
- set_attrib_num(new_object_array, POD_CLASS_NAME, class_name);
+ set_attrib_num(object, new_object_array, POD_CLASS_NAME, class_name);
/* Note the number of used slots */
ATTRIB_COUNT(object) = POD_FIRST_ATTRIB + attrib_count;
@@ -1513,7 +1514,7 @@
if (attrib >= attrib_count || attrib < POD_FIRST_ATTRIB) {
internal_exception(OUT_OF_BOUNDS, "No such attribute");
}
- set_attrib_num(attrib_array, attrib, value);
+ set_attrib_num(object, attrib_array, attrib, value);
}
void
1.25 +4 -1 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- pmc_freeze.c 15 Apr 2004 07:32:09 -0000 1.24
+++ pmc_freeze.c 19 Aug 2004 13:46:14 -0000 1.25
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc_freeze.c,v 1.24 2004/04/15 07:32:09 leo Exp $
+$Id: pmc_freeze.c,v 1.25 2004/08/19 13:46:14 leo Exp $
=head1 NAME
@@ -924,6 +924,9 @@
break;
}
assert(info->thaw_ptr);
+ /*TODO
+ * DOD_WRITE_BARRIER(interpreter, info->container, NULL, pmc);
+ */
*info->thaw_ptr = pmc;
}
return pmc;
