cvsuser 04/07/16 05:15:35
Modified: classes delegate.pmc fixedpmcarray.pmc parrotclass.pmc
parrotobject.pmc
include/parrot objects.h pobj.h
src dod.c objects.c
Log:
Pie-thon 71 - DOD marking
* objects, classes, *PMCArray all now use the same basic data struct
* this simplifies marking - it's now done inside the DOD system
* some experiments to reduce L2 misses for aggregates
* this one in abusing Luke's high priority / lazy DOD patch
and puts items to be marked in front of the mark chain
Revision Changes Path
1.27 +3 -3 parrot/classes/delegate.pmc
Index: delegate.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/delegate.pmc,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- delegate.pmc 8 Jul 2004 07:57:26 -0000 1.26
+++ delegate.pmc 16 Jul 2004 12:15:27 -0000 1.27
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: delegate.pmc,v 1.26 2004/07/08 07:57:26 leo Exp $
+$Id: delegate.pmc,v 1.27 2004/07/16 12:15:27 leo Exp $
=head1 NAME
@@ -160,8 +160,8 @@
noarg_noreturn(INTERP, SELF, class, PARROT_VTABLE_INIT_METHNAME, 0);
}
- void mark() {
- /* don't delegate mark */
+ void destroy() {
+ /* don't delegate destroy */
}
}
1.11 +8 -7 parrot/classes/fixedpmcarray.pmc
Index: fixedpmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedpmcarray.pmc,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- fixedpmcarray.pmc 15 Jul 2004 14:15:55 -0000 1.10
+++ fixedpmcarray.pmc 16 Jul 2004 12:15:27 -0000 1.11
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedpmcarray.pmc,v 1.10 2004/07/15 14:15:55 leo Exp $
+$Id: fixedpmcarray.pmc,v 1.11 2004/07/16 12:15:27 leo Exp $
=head1 NAME
@@ -227,7 +227,7 @@
PMC_data(dest) = mem_sys_allocate(size * sizeof(PMC*));
mem_sys_memcopy(PMC_data(dest), PMC_data(SELF), size*sizeof(PMC*));
- PObj_custom_mark_destroy_SETALL(dest);
+ PObj_data_is_PMC_array_SET(dest);
return dest;
}
@@ -249,9 +249,10 @@
data = (PMC **) PMC_data(SELF);
end = PMC_int_val(SELF);
for(i = 0; i < end; i++) {
- if(data[i] != PMCNULL && data[i] != SELF) {
- pobject_lives(INTERP, (PObj *) data[i]);
- }
+ PMC *p = data[i];
+ if (p == PMCNULL || p == SELF)
+ continue;
+ pobject_lives(INTERP, (PObj *) p);
}
}
@@ -484,7 +485,7 @@
for(i = 0; i < size; i++)
data[i] = PMCNULL;
PMC_data(SELF) = data;
- PObj_custom_mark_destroy_SETALL(SELF);
+ PObj_data_is_PMC_array_SET(SELF);
}
void set_pmc(PMC *value) {
@@ -501,7 +502,7 @@
PMC_data(SELF) = mem_sys_allocate(size * sizeof(PMC*));
mem_sys_memcopy(PMC_data(SELF), PMC_data(value), size*sizeof(PMC*));
PMC_int_val2(SELF) = size;
- PObj_custom_mark_destroy_SETALL(SELF);
+ PObj_data_is_PMC_array_SET(SELF);
}
/*
1.24 +3 -4 parrot/classes/parrotclass.pmc
Index: parrotclass.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotclass.pmc,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- parrotclass.pmc 23 Jun 2004 07:14:30 -0000 1.23
+++ parrotclass.pmc 16 Jul 2004 12:15:27 -0000 1.24
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotclass.pmc,v 1.23 2004/06/23 07:14:30 leo Exp $
+$Id: parrotclass.pmc,v 1.24 2004/07/16 12:15:27 leo Exp $
=head1 NAME
@@ -70,11 +70,10 @@
void init () {
/* No attributes to start with */
- PMC_int_val(SELF) = 0;
+ PMC_int_val(SELF) = ATTRIB_COUNT(SELF) = 0;
/* But we are a class, really */
PObj_is_class_SET(SELF);
- /* And, coincidentally, data points to a PMC. Fancy that... */
- PObj_flag_SET(is_PMC_ptr, SELF);
+ PObj_data_is_PMC_array_SET(SELF);
/* s. Parrot_new_class() for more initialization */
}
1.32 +1 -26 parrot/classes/parrotobject.pmc
Index: parrotobject.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotobject.pmc,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -w -r1.31 -r1.32
--- parrotobject.pmc 14 Jul 2004 09:42:21 -0000 1.31
+++ parrotobject.pmc 16 Jul 2004 12:15:27 -0000 1.32
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotobject.pmc,v 1.31 2004/07/14 09:42:21 leo Exp $
+$Id: parrotobject.pmc,v 1.32 2004/07/16 12:15:27 leo Exp $
=head1 NAME
@@ -66,36 +66,11 @@
"use the registered class instead");
}
- void init_pmc() {
- SELF.init();
- }
-
void* invoke(void* next) {
SELF.init();
return next;
}
- void mark() {
- SLOTTYPE *attrib_array = PMC_data(SELF);
- UINTVAL i;
-
- /* mark saved registers area */
- Parrot_delegate_mark(INTERP, SELF);
-
- if (attrib_array) {
- PMC *cur_pmc;
-
- pobject_lives(interpreter, GET_CLASS(attrib_array, SELF));
- pobject_lives(interpreter, attrib_array);
- for (i = 1; i < ATTRIB_COUNT(SELF); i++) {
- cur_pmc = get_attrib_num(attrib_array, i);
- if (cur_pmc) {
- pobject_lives(interpreter, (PObj *)cur_pmc);
- }
- }
- }
- }
-
/*
=item C<void init_pmc(PMC *init)>
1.27 +23 -42 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- objects.h 1 Jul 2004 13:45:28 -0000 1.26
+++ objects.h 16 Jul 2004 12:15:31 -0000 1.27
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.26 2004/07/01 13:45:28 leo Exp $
+ * $Id: objects.h,v 1.27 2004/07/16 12:15:31 leo Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -63,56 +63,37 @@
void Parrot_set_class_destructor(Parrot_Interp, STRING *, INTVAL, STRING *);
void Parrot_set_class_fallback(Parrot_Interp, STRING *, INTVAL, STRING *);
-/* XXX kwoo: Can the code in the #if 0 get removed now, or is it historically
- * important?
+/* Objects, classes and PMCarrays all use the same data scheme:
+ * PMC_data() holds a malloced array, PMC_int_val() is the size of it
+ * this simplifies DOD mark a lot
*/
-/* Get and set attributes. */
-#if 0
-/* Old way */
-#define get_attrib_num(x, y) VTABLE_get_pmc_keyed_int(interpreter, x, y)
-#define set_attrib_num(x, y, z) VTABLE_set_pmc_keyed_int(interpreter, x, y, z)
-#define get_attrib_count(x) VTABLE_elements(interpreter, x)
-#define new_attrib_array() pmc_new(interpreter, enum_class_Array)
-#define set_attrib_array_size(x, y) VTABLE_set_integer_native(interpreter, (x), (y))
-#define resize_attrib_array(x, y) VTABLE_set_integer_native(interpreter, (x), (y))
-#define set_attrib_flags(x)
-#define SLOTTYPE PMC
-
-#else
-/* These are the new way */
-#define get_attrib_num(x, y) *((PMC **)PObj_bufstart(x)+y)
-#define set_attrib_num(x, y, z) { PMC **foo = (PMC **)PObj_bufstart(x); foo[y] = z;
}
-#define get_attrib_count(x) (PObj_buflen(x) / sizeof(PMC *))
-#define new_attrib_array() new_buffer_header(interpreter)
-#define set_attrib_flags(x) PObj_is_buffer_of_PMCs_ptr_SET(x)
-#define set_attrib_array_size(x, y) Parrot_allocate_zeroed(interpreter, x,
(sizeof(PMC *)*(y)))
-#define resize_attrib_array(x, y) Parrot_reallocate(interpreter, x, (sizeof(PMC
*)*(y)))
-#define SLOTTYPE Buffer
-#endif /* 0 */
-#endif /* PARROT_OBJECTS_H_GUARD */
+#define SLOTTYPE PMC*
+#define get_attrib_num(x, y) ((PMC **)x)[y]
+#define set_attrib_num(x, y, z) ((PMC **)x)[y] = z
+#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)
+#define set_attrib_array_size(o, y) do { \
+ PMC_data(o) = mem_sys_allocate_zeroed((sizeof(PMC *)*(y))); \
+ PMC_int_val(o) = y; \
+} while (0)
+
+#define resize_attrib_array(o, y) do { \
+ PMC_data(o) = mem_sys_realloc(PMC_data(o), (sizeof(PMC *)*(y))); \
+ PMC_int_val(o) = y; \
+} while (0)
-#if 0
/*
* class = 1st element in object array
*/
-# define ATTRIB_COUNT(obj) PMC_int_val(obj)
+# define ATTRIB_COUNT(obj) PMC_int_val2(obj)
# define SET_CLASS(arr, obj, class) \
- set_attrib_num(obj, POD_CLASS, class)
+ set_attrib_num(arr, POD_CLASS, class)
# define GET_CLASS(arr, obj) \
- get_attrib_num(obj, POD_CLASS)
-#else
-
-/*
- * class is in the PMC
- */
-
-# define SET_CLASS(arr, obj, class) PObj_bufstart(obj) = class
-# define GET_CLASS(arr, obj) PObj_bufstart(obj)
-# define ATTRIB_COUNT(obj) PObj_buflen(obj)
-
-#endif /* 0 */
+ get_attrib_num(arr, POD_CLASS)
+#endif /* PARROT_OBJECTS_H_GUARD */
/*
* Local variables:
* c-indentation-style: bsd
1.46 +24 -24 parrot/include/parrot/pobj.h
Index: pobj.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pobj.h,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -w -r1.45 -r1.46
--- pobj.h 13 Jul 2004 14:09:17 -0000 1.45
+++ pobj.h 16 Jul 2004 12:15:31 -0000 1.46
@@ -1,7 +1,7 @@
/* pobj.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pobj.h,v 1.45 2004/07/13 14:09:17 leo Exp $
+ * $Id: pobj.h,v 1.46 2004/07/16 12:15:31 leo Exp $
* Overview:
* Parrot Object data members and flags enum
* Data Structure and Algorithms:
@@ -252,19 +252,15 @@
/* PMC specific FLAGs */
- /* Set to true if the PMC data pointer points to something that
- * looks like a string or buffer pointer */
- PObj_is_buffer_ptr_FLAG = 1 << 24,
- /* Set to true if the data pointer points to a PMC */
- PObj_is_PMC_ptr_FLAG = 1 << 25,
- /* When both the is_PMC_ptr and is_buffer_ptr flags
- are set, we assume that data is pointing to a buffer of PMCs, and
- will run through that buffer and mark all the PMCs in it as live */
- PObj_is_buffer_of_PMCs_ptr_FLAG = (1 << 24 | 1 << 25),
+ /* Set to true if the PMC data pointer points to a malloced
+ * array of PObjs
+ */
+ PObj_data_is_PMC_array_FLAG = 1 << 24,
+ /* unused */
+ PObj_is_unused_ptr_FLAG = 1 << 25,
/* a PMC that needs special handling in DOD, i.e one that has either:
* - metadata
- * - is_PMC_ptr_FLAG
- * - is_buffer_ptr_FLAG
+ * - data_is_PMC_array_FLAG
* - custom_mark_FLAG
*/
b_PObj_is_special_PMC_FLAG = 1 << 26,
@@ -295,9 +291,9 @@
# define d_PObj_is_special_PMC_FLAG ((UINTVAL)0x04)
/*
- * arenas are constant sized ~32 byte object size, ~16K objects
+ * arenas are constant sized ~32 byte object size, ~32K objects
*/
-# define ARENA_SIZE (32*1024*16)
+# define ARENA_SIZE (32*1024*32)
# define ARENA_ALIGN ARENA_SIZE
# define ARENA_MASK (~ (ARENA_SIZE-1) )
@@ -447,11 +443,10 @@
if ((PObj_get_FLAGS(o) & \
(PObj_active_destroy_FLAG | \
PObj_custom_mark_FLAG | \
- PObj_is_PMC_ptr_FLAG | \
+ PObj_data_is_PMC_array_FLAG | \
PObj_is_PMC_EXT_FLAG | \
- PObj_needs_early_DOD_FLAG | \
- PObj_is_buffer_of_PMCs_ptr_FLAG | \
- PObj_is_buffer_ptr_FLAG))) \
+ PObj_needs_early_DOD_FLAG \
+ ))) \
DOD_flag_SET(is_special_PMC, o); \
else \
DOD_flag_CLEAR(is_special_PMC, o); \
@@ -460,13 +455,18 @@
#define PObj_is_special_PMC_TEST(o) DOD_flag_TEST(is_special_PMC, o)
#define PObj_is_special_PMC_SET(o) DOD_flag_SET(is_special_PMC, o)
-#define PObj_is_buffer_ptr_SET(o) PObj_special_SET(is_buffer_ptr, o)
-#define PObj_is_buffer_ptr_CLEAR(o) PObj_special_CLEAR(is_buffer_ptr, o)
+#define PObj_data_is_PMC_array_SET(o) do { \
+ PObj_special_SET(data_is_PMC_array, o); \
+ PObj_flag_SET(active_destroy, o); \
+ } while(0)
+
+#define PObj_data_is_PMC_array_CLEAR(o) do {\
+ PObj_special_CLEAR(data_is_PMC_array, o); \
+ PObj_flag_CLEAR(active_destroy, o); \
+ } while (0)
-#define PObj_is_buffer_of_PMCs_ptr_SET(o) \
- PObj_special_SET(is_buffer_of_PMCs_ptr, o)
-#define PObj_is_buffer_of_PMCs_ptr_CLEAR(o) \
- PObj_special_CLEAR(is_buffer_of_PMCs_ptr, o)
+#define PObj_data_is_PMC_array_TEST(o) \
+ PObj_flag_TEST(data_is_PMC_array, o)
#define PObj_needs_early_DOD_TEST(o) PObj_flag_TEST(needs_early_DOD, o)
#define PObj_needs_early_DOD_SET(o) PObj_special_SET(needs_early_DOD, o)
1.118 +15 -29 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -w -r1.117 -r1.118
--- dod.c 5 Jul 2004 12:14:36 -0000 1.117
+++ dod.c 16 Jul 2004 12:15:34 -0000 1.118
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dod.c,v 1.117 2004/07/05 12:14:36 leo Exp $
+$Id: dod.c,v 1.118 2004/07/16 12:15:34 leo Exp $
=head1 NAME
@@ -91,7 +91,7 @@
hi_prio = 0;
if (obj->pmc_ext) {
- if (hi_prio) {
+ if (1 || hi_prio) {
PMC* tptr = interpreter->dod_trace_ptr;
if (PMC_next_for_GC(tptr) == tptr) {
PMC_next_for_GC(obj) = obj;
@@ -243,7 +243,8 @@
struct Stash *stash = 0;
/* We have to start somewhere, the interpreter globals is a good place */
- interpreter->dod_mark_ptr = current = interpreter->iglobals;
+ interpreter->dod_trace_ptr = interpreter->dod_mark_ptr = current =
+ interpreter->iglobals;
/* mark it as used */
pobject_lives(interpreter, (PObj *)interpreter->iglobals);
@@ -329,10 +330,9 @@
static int
trace_children(Interp *interpreter, PMC *current)
{
- PMC *prev = NULL;
- unsigned i = 0;
- UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
- | PObj_custom_mark_FLAG;
+ PMC *prev = NULL, *next;
+ INTVAL i = 0;
+ UINTVAL mask = PObj_data_is_PMC_array_FLAG | PObj_custom_mark_FLAG;
int lazy_dod = interpreter->lazy_dod;
@@ -368,28 +368,14 @@
* largest percentage of PMCs won't have anything in their data
* pointer that we need to trace */
if (bits) {
- if (bits == PObj_is_PMC_ptr_FLAG) {
- if (PMC_data(current)) {
- pobject_lives(interpreter, PMC_data(current));
- }
- }
- else if (bits == PObj_is_buffer_ptr_FLAG) {
- if (PMC_data(current)) {
- pobject_lives(interpreter, PMC_data(current));
- }
- }
- else if (bits == PObj_is_buffer_of_PMCs_ptr_FLAG) {
- /* buffer of PMCs */
- Buffer *trace_buf = PMC_data(current);
-
- if (trace_buf) {
- PMC **cur_pmc = PObj_bufstart(trace_buf);
-
- /* Mark the damn buffer as used! */
- pobject_lives(interpreter, trace_buf);
- for (i = 0; i < PObj_buflen(trace_buf) / sizeof(*cur_pmc); i++)
{
- if (cur_pmc[i]) {
- pobject_lives(interpreter, (PObj *)cur_pmc[i]);
+ if (bits == PObj_data_is_PMC_array_FLAG) {
+ /* malloced array of PMCs */
+ PMC **data = PMC_data(current);
+
+ if (data) {
+ for (i = 0; i < PMC_int_val(current); i++) {
+ if (data[i]) {
+ pobject_lives(interpreter, (PObj *)data[i]);
}
}
}
1.104 +21 -20 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -w -r1.103 -r1.104
--- objects.c 14 Jul 2004 14:50:15 -0000 1.103
+++ objects.c 16 Jul 2004 12:15:34 -0000 1.104
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.103 2004/07/14 14:50:15 leo Exp $
+$Id: objects.c,v 1.104 2004/07/16 12:15:34 leo Exp $
=head1 NAME
@@ -160,7 +160,7 @@
set_attrib_num(class_slots, PCD_ATTRIBUTES, attr_offset_hash);
set_attrib_num(class_slots, PCD_ATTRIB_OFFS, class_offset_hash);
/* And note the totals */
- PMC_int_val(class) = cur_offset - POD_FIRST_ATTRIB;
+ ATTRIB_COUNT(class) = cur_offset - POD_FIRST_ATTRIB;
}
/*
@@ -186,7 +186,8 @@
void * __ptr;
} __ptr_u;
- vtable_pmc = get_attrib_num((SLOTTYPE *)PMC_data(class), PCD_OBJECT_VTABLE);
+ vtable_pmc = get_attrib_num((SLOTTYPE*)PMC_data(class),
+ PCD_OBJECT_VTABLE);
vtable = PMC_struct_val(vtable_pmc);
deleg_pmc_vtable = Parrot_base_vtables[enum_class_deleg_pmc];
object_vtable = Parrot_base_vtables[enum_class_ParrotObject];
@@ -249,7 +250,7 @@
STRING *child_class_name)
{
PMC *child_class;
- PMC *child_class_array;
+ SLOTTYPE *child_class_array;
PMC *classname_pmc;
PMC *parents, *temp_pmc;
int parent_is_class;
@@ -275,13 +276,13 @@
child_class = pmc_new(interpreter, enum_class_ParrotClass);
/* Hang an array off the data pointer */
- child_class_array = PMC_data(child_class) = new_attrib_array();
+ set_attrib_array_size(child_class, PCD_MAX);
+ child_class_array = PMC_data(child_class);
set_attrib_flags(child_class);
/* We will have five entries in this array */
- set_attrib_array_size(child_class_array, PCD_MAX);
/* We have the same number of attributes as our parent */
- PMC_int_val(child_class) = PMC_int_val(base_class);
+ ATTRIB_COUNT(child_class) = ATTRIB_COUNT(base_class);
/* Our parent class array has a single member in it */
parents = pmc_new(interpreter, enum_class_Array);
@@ -357,14 +358,15 @@
void
Parrot_new_class(Parrot_Interp interpreter, PMC *class, STRING *class_name)
{
- PMC *class_array;
+ SLOTTYPE *class_array;
PMC *classname_pmc;
/* Hang an array off the data pointer, empty of course */
- class_array = PMC_data(class) = new_attrib_array();
- set_attrib_flags(class);
+ set_attrib_array_size(class, PCD_MAX);
+ class_array = PMC_data(class);
+ /* set_attrib_flags(class); init does it */
+
/* We will have five entries in this array */
- set_attrib_array_size(class_array, PCD_MAX);
/* Our parent class array has nothing in it */
set_attrib_num(class_array, PCD_PARENTS,
pmc_new(interpreter, enum_class_Array));
@@ -713,20 +715,19 @@
object->vtable = PMC_struct_val(vtable_pmc);
/* Grab the attribute count from the parent */
- attrib_count = PMC_int_val(class);
+ attrib_count = ATTRIB_COUNT(class);
class_array = PMC_data(class);
class_name = get_attrib_num(class_array, PCD_CLASS_NAME);
/* Build the array that hangs off the new object */
- new_object_array = new_attrib_array();
- PMC_data(object) = new_object_array;
-
/* First presize it */
- set_attrib_array_size(new_object_array,
+ set_attrib_array_size(object,
attrib_count + POD_FIRST_ATTRIB);
- /* then activate marking it - set_attrib_flags(object); */
- PObj_flag_SET(custom_mark, object);
+ new_object_array = PMC_data(object);
+
+ /* turn marking on */
+ 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);
@@ -1265,7 +1266,7 @@
* while there are already child class attrs
*/
idx = VTABLE_elements(interpreter, attr_hash);
- assert(PMC_int_val(class) == idx);
+ assert(ATTRIB_COUNT(class) == idx);
/*
* attr_hash is an OrderedHash so the line below could be:
*
@@ -1282,7 +1283,7 @@
VTABLE_set_integer_keyed_str(interpreter, attr_hash,
full_attr_name, idx);
assert(idx + 1 == VTABLE_elements(interpreter, attr_hash));
- PMC_int_val(class) = idx + 1;
+ ATTRIB_COUNT(class) = idx + 1;
return idx;
}
