cvsuser 05/01/25 06:47:33
Modified: include/parrot dod.h interpreter.h settings.h smallobject.h
src dod.c gc_ims.c hash.c headers.c inter_create.c
memory.c pmc.c
Log:
GMS generational MS 1 - structures and hooks
Revision Changes Path
1.25 +42 -2 parrot/include/parrot/dod.h
Index: dod.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/dod.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- dod.h 22 Jan 2005 10:33:26 -0000 1.24
+++ dod.h 25 Jan 2005 14:47:31 -0000 1.25
@@ -1,7 +1,7 @@
/* dod.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.h,v 1.24 2005/01/22 10:33:26 leo Exp $
+ * $Id: dod.h,v 1.25 2005/01/25 14:47:31 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -63,7 +63,18 @@
/* mark a PObj live during DOD */
+#if PARROT_GC_GMS
+# define pobject_lives(i, o) do { \
+ if (!PObj_live_TEST(o) && \
+ PObj_to_GMSH(o)->gen->gen_no >= i->gc_generation) \
+ parrot_gc_gms_pobject_lives(i, o); \
+ } while (0)
+
+void parrot_gc_gms_pobject_lives(Interp* interpreter, PObj *obj);
+
+#else
void pobject_lives(Interp *interpreter, PObj *buffer);
+#endif
#if ! DISABLE_GC_DEBUG
/* Set when walking the system stack */
@@ -82,6 +93,7 @@
/* GC subsystem init functions */
void Parrot_gc_ms_init(Interp* interpreter);
void Parrot_gc_ims_init(Interp* interpreter);
+void Parrot_gc_gms_init(Interp* interpreter);
/* do_dod_run function for MS */
void Parrot_dod_ms_run(Interp *interpreter, int flags);
@@ -101,7 +113,7 @@
} while (0)
# define DOD_WRITE_BARRIER_KEY(interp, agg, old, old_key, new, new_key) \
- DOD_WRITE_BARRIER_KEY(interp, agg, old, new)
+ DOD_WRITE_BARRIER(interp, agg, old, new)
#endif
#if PARROT_GC_MS
@@ -109,6 +121,34 @@
# define DOD_WRITE_BARRIER_KEY(interp, agg, old, old_key, new, new_key)
#endif
+#if PARROT_GC_GMS
+# define DOD_WRITE_BARRIER(interp, agg, old, new) do { \
+ UINTVAL gen_agg, gen_new; \
+ if (PMC_IS_NULL(new)) \
+ break; \
+ gen_agg = PObj_to_GMSH(agg)->gen->gen_no; \
+ gen_new = PObj_to_GMSH(new)->gen->gen_no; \
+ if (gen_agg < gen_new) \
+ parrot_gc_gms_wb(interp, agg, old, new); \
+} while (0)
+
+# define DOD_WRITE_BARRIER_KEY(interp, agg, old, old_key, new, new_key) do
{ \
+ UINTVAL gen_agg, gen_new, gen_key; \
+ if (PMC_IS_NULL(new)) \
+ break; \
+ gen_agg = PObj_to_GMSH(agg)->gen->gen_no; \
+ gen_new = PObj_to_GMSH(new)->gen->gen_no; \
+ gen_key = PObj_to_GMSH(new_key)->gen->gen_no; \
+ if (gen_agg < gen_new || gen_agg < gen_key) \
+ 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_key(Interp *, PMC *agg,
+ PMC *old, void *old_key, PMC *new, void *new_key);
+
+#endif
+
#endif /* PARROT_DOD_H_GUARD */
/*
1.169 +2 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.168
retrieving revision 1.169
diff -u -r1.168 -r1.169
--- interpreter.h 17 Jan 2005 14:56:43 -0000 1.168
+++ interpreter.h 25 Jan 2005 14:47:31 -0000 1.169
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.168 2005/01/17 14:56:43 leo Exp $
+ * $Id: interpreter.h,v 1.169 2005/01/25 14:47:31 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -280,6 +280,7 @@
PMC ** exception_list; /* precreated exception objects */
struct _Thread_data *thread_data; /* thread specific items */
UINTVAL recursion_limit; /* Sub call resursion limit */
+ UINTVAL gc_generation; /* GC generation number */
};
/* typedef struct parrot_interp_t Interp; done in parrot.h so that
1.7 +32 -12 parrot/include/parrot/settings.h
Index: settings.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/settings.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- settings.h 4 Nov 2004 08:03:34 -0000 1.6
+++ settings.h 25 Jan 2005 14:47:31 -0000 1.7
@@ -1,7 +1,7 @@
/* settings.h
* Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: settings.h,v 1.6 2004/11/04 08:03:34 leo Exp $
+ * $Id: settings.h,v 1.7 2005/01/25 14:47:31 leo Exp $
* Overview:
* Overall settings for Parrot
* Data Structure and Algorithms:
@@ -36,17 +36,28 @@
/*
* GC_SUBSYSTEM selection
- */
-
-/*
- * PARROT_GC_MS is the stop-the-world mark and sweep collector
- */
-#define PARROT_GC_MS 1
-
-/*
- * PARROT_GC_IMS incremental mark and sweep collector
- */
-#define PARROT_GC_IMS !PARROT_GC_MS
+ * 0 ... MS stop-the-world mark & sweep
+ * 1 ... IMS incremental mark & sweep
+ * 2 ... GMS generational mark & sweep
+ */
+
+#define PARROT_GC_SUBSYSTEM 0
+
+#if PARROT_GC_SUBSYSTEM == 0
+# define PARROT_GC_MS 1
+# define PARROT_GC_IMS 0
+# define PARROT_GC_GMS 0
+#endif
+#if PARROT_GC_SUBSYSTEM == 1
+# define PARROT_GC_MS 0
+# define PARROT_GC_IMS 1
+# define PARROT_GC_GMS 0
+#endif
+#if PARROT_GC_SUBSYSTEM == 2
+# define PARROT_GC_MS 0
+# define PARROT_GC_IMS 0
+# define PARROT_GC_GMS 1
+#endif
/*
@@ -67,6 +78,15 @@
#define ARENA_DOD_FLAGS 0
/*
+ * ARENA_DOD_FLAGS works only for GC_MS
+ */
+
+#if ! PARROT_GC_MS
+# undef ARENA_DOD_FLAGS
+# define ARENA_DOD_FLAGS 0
+#endif
+
+/*
* misc settings
*/
1.18 +66 -0 parrot/include/parrot/smallobject.h
Index: smallobject.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/smallobject.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- smallobject.h 18 Jan 2005 14:05:18 -0000 1.17
+++ smallobject.h 25 Jan 2005 14:47:31 -0000 1.18
@@ -44,6 +44,60 @@
typedef void (*alloc_objects_fn_type)(Interp *,
struct Small_Object_Pool *);
+#if PARROT_GC_GMS
+/*
+ * all objects have this header in front of the actual
+ * object pointer. The prev/next pointers chain all existing
+ * objects for one pool (sizeclass) together.
+ *
+ * XXX this could lead to unaligned FLOATVALs in the adjacent PMC
+ * if that's true either insert a dummy or reorder PMC members
+ */
+typedef struct _gc_gms_hdr {
+ struct _gc_gms_hdr *prev;
+ struct _gc_gms_hdr *next;
+ struct _gc_gms_gen *gen;
+ void *gc_dummy_align; /* see above */
+} Gc_gms_hdr;
+
+#define PObj_to_GMSH(o) ( ((Gc_gms_hdr*)o)-1 )
+#define GMSH_to_PObj(p) ( (PObj*) (p+1) )
+
+/* the structure uses 2 ptrs itself */
+#define GC_GMS_STORE_SIZE (64-2)
+
+typedef struct _gc_gms_hdr_store {
+ struct _gc_gms_hdr_store *next;
+ Gc_gms_hdr **ptr; /* insert location */
+ Gc_gms_hdr * (store[GC_GMS_STORE_SIZE]); /* array of hdr pointers */
+} Gc_gms_hdr_store;
+
+typedef struct _gc_gms_hdr_list {
+ Gc_gms_hdr_store *first;
+ Gc_gms_hdr_store *last;
+} Gc_gms_hdr_list;
+
+
+/*
+ * all objects belong to one generation
+ */
+typedef struct _gc_gms_gen {
+ UINTVAL gen_no; /* generation number */
+ UINTVAL timely_destruct_obj_sofar; /* sum up to this generation */
+ UINTVAL black_color; /* live color of this generation */
+ struct _gc_gms_hdr *first; /* first header in this generation */
+ struct _gc_gms_hdr *last; /* last header in this generation */
+ struct _gc_gms_hdr *fin; /* need destruction/finalization */
+ struct Small_Object_Pool *pool; /* where this generation belongs to
*/
+ Gc_gms_hdr_list igp; /* IGPs for this generation */
+ UINTVAL n_possibly_dead; /* overwritten count */
+ UINTVAL n_objects; /* live objects count */
+ struct _gc_gms_gen *prev;
+ struct _gc_gms_gen *next;
+} Gc_gms_gen;
+
+#endif
+
/* Tracked resource pool */
struct Small_Object_Pool {
struct Small_Object_Arena *last_Arena;
@@ -66,6 +120,18 @@
size_t start_arena_memory;
size_t end_arena_memory;
const char *name;
+#if PARROT_GC_GMS
+ struct _gc_gms_hdr marker; /* limit of list */
+ struct _gc_gms_hdr *black; /* alive */
+ struct _gc_gms_hdr *black_fin; /* alive, needs destruction */
+ struct _gc_gms_hdr *gray; /* to be scanned */
+ struct _gc_gms_hdr *white; /* unprocessed */
+ struct _gc_gms_hdr *white_fin; /* unprocesse, needs destruction */
+
+ struct _gc_gms_gen *first_gen; /* linked list of generations */
+ struct _gc_gms_gen *last_gen;
+
+#endif
};
INTVAL contained_in_pool(Interp *,
1.143 +11 -7 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.142
retrieving revision 1.143
diff -u -r1.142 -r1.143
--- dod.c 21 Jan 2005 12:31:36 -0000 1.142
+++ dod.c 25 Jan 2005 14:47:32 -0000 1.143
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dod.c,v 1.142 2005/01/21 12:31:36 leo Exp $
+$Id: dod.c,v 1.143 2005/01/25 14:47:32 leo Exp $
=head1 NAME
@@ -130,7 +130,8 @@
}
}
-#if ARENA_DOD_FLAGS
+#if !PARROT_GC_GMS
+# if ARENA_DOD_FLAGS
/*
@@ -145,8 +146,8 @@
=cut
*/
-
-void pobject_lives(Interp *interpreter, PObj *obj)
+void
+pobject_lives(Interp *interpreter, PObj *obj)
{
struct Small_Object_Arena *arena = GET_ARENA(obj);
@@ -187,7 +188,7 @@
}
}
-#else
+# else
void pobject_lives(Interp *interpreter, PObj *obj)
{
@@ -226,7 +227,8 @@
#endif
}
-#endif
+# endif
+#endif /* PARROT_GC_GMS */
/*
@@ -1175,8 +1177,10 @@
* the sync sweep is always at the end, so that
* the live bits are cleared
*/
- if (flags & DOD_finish_FLAG)
+ if (flags & DOD_finish_FLAG) {
+ Parrot_dod_sweep(interpreter, interpreter->arena_base->pmc_pool);
return;
+ }
++arena_base->DOD_block_level;
arena_base->lazy_dod = flags & DOD_lazy_FLAG;
/*
1.19 +2 -1 parrot/src/gc_ims.c
Index: gc_ims.c
===================================================================
RCS file: /cvs/public/parrot/src/gc_ims.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- gc_ims.c 20 Jan 2005 14:48:25 -0000 1.18
+++ gc_ims.c 25 Jan 2005 14:47:32 -0000 1.19
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: gc_ims.c,v 1.18 2005/01/20 14:48:25 leo Exp $
+$Id: gc_ims.c,v 1.19 2005/01/25 14:47:32 leo Exp $
=head1 NAME
@@ -873,6 +873,7 @@
*/
if (g_ims->state >= GC_IMS_RE_INIT || g_ims->state < GC_IMS_FINISHED)
Parrot_dod_clear_live_bits(interpreter);
+ Parrot_dod_sweep(interpreter, interpreter->arena_base->pmc_pool);
g_ims->state = GC_IMS_DEAD;
return;
}
1.87 +9 -3 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -r1.86 -r1.87
--- hash.c 22 Jan 2005 10:33:27 -0000 1.86
+++ hash.c 25 Jan 2005 14:47:33 -0000 1.87
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: hash.c,v 1.86 2005/01/22 10:33:27 leo Exp $
+$Id: hash.c,v 1.87 2005/01/25 14:47:33 leo Exp $
=head1 NAME
@@ -218,6 +218,12 @@
return strcmp(a, b);
}
+static void
+pobject_lives_fn(Interp *interp, PObj *o)
+{
+ pobject_lives(interp, o);
+}
+
/*
=item C<void
@@ -564,7 +570,7 @@
Hash_key_type_ascii,
STRING_compare, /* STRING compare */
key_hash_STRING, /* hash */
- pobject_lives); /* mark */
+ pobject_lives_fn); /* mark */
}
void
@@ -576,7 +582,7 @@
Hash_key_type_ascii,
STRING_compare, /* STRING compare */
key_hash_STRING, /* hash */
- pobject_lives); /* mark */
+ pobject_lives_fn); /* mark */
}
/*
1.64 +5 -1 parrot/src/headers.c
Index: headers.c
===================================================================
RCS file: /cvs/public/parrot/src/headers.c,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -r1.63 -r1.64
--- headers.c 20 Jan 2005 14:48:25 -0000 1.63
+++ headers.c 25 Jan 2005 14:47:33 -0000 1.64
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: headers.c,v 1.63 2005/01/20 14:48:25 leo Exp $
+$Id: headers.c,v 1.64 2005/01/25 14:47:33 leo Exp $
=head1 NAME
@@ -298,10 +298,14 @@
* can't use normall get_free_object--PMC_EXT doesn't have flags
* it isn't a Buffer
*/
+#if PARROT_GC_GMS
+ ptr = pool->get_free_object(interpreter, pool);
+#else
if (!pool->free_list)
(*pool->more_objects) (interpreter, pool);
ptr = pool->free_list;
pool->free_list = *(void **)ptr;
+#endif
memset(ptr, 0, sizeof(PMC_EXT));
return ptr;
}
1.27 +1 -2 parrot/src/inter_create.c
Index: inter_create.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_create.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- inter_create.c 24 Nov 2004 05:56:57 -0000 1.26
+++ inter_create.c 25 Jan 2005 14:47:33 -0000 1.27
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_create.c,v 1.26 2004/11/24 05:56:57 leo Exp $
+$Id: inter_create.c,v 1.27 2005/01/25 14:47:33 leo Exp $
=head1 NAME
@@ -319,7 +319,6 @@
*/
Parrot_do_dod_run(interpreter, DOD_finish_FLAG);
- Parrot_dod_sweep(interpreter, interpreter->arena_base->pmc_pool);
/*
* that doesn't get rid of constant PMCs like these in vtable->data
* so if such a PMC needs destroy, we got a memory leak, like for
1.48 +4 -1 parrot/src/memory.c
Index: memory.c
===================================================================
RCS file: /cvs/public/parrot/src/memory.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- memory.c 10 Sep 2004 08:54:50 -0000 1.47
+++ memory.c 25 Jan 2005 14:47:33 -0000 1.48
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: memory.c,v 1.47 2004/09/10 08:54:50 leo Exp $
+$Id: memory.c,v 1.48 2005/01/25 14:47:33 leo Exp $
=head1 NAME
@@ -189,6 +189,9 @@
#if PARROT_GC_IMS
Parrot_gc_ims_init(interpreter);
#endif
+#if PARROT_GC_GMS
+ Parrot_gc_gms_init(interpreter);
+#endif
Parrot_initialize_memory_pools(interpreter);
Parrot_initialize_header_pools(interpreter);
1.93 +9 -3 parrot/src/pmc.c
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc.c,v
retrieving revision 1.92
retrieving revision 1.93
diff -u -r1.92 -r1.93
--- pmc.c 13 Dec 2004 13:46:25 -0000 1.92
+++ pmc.c 25 Jan 2005 14:47:33 -0000 1.93
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc.c,v 1.92 2004/12/13 13:46:25 leo Exp $
+$Id: pmc.c,v 1.93 2005/01/25 14:47:33 leo Exp $
=head1 NAME
@@ -562,12 +562,18 @@
*/
static int
-int_compare(Parrot_Interp interp, void *a, void *b)
+int_compare(Interp *interp, void *a, void *b)
{
UNUSED(interp);
return a != b;
}
+static void
+pobject_lives_fn(Interp *interp, PObj *o)
+{
+ pobject_lives(interp, o);
+}
+
/*
=back
@@ -599,7 +605,7 @@
registry = interpreter->DOD_registry = pmc_new_noinit(interpreter,
enum_class_Hash);
new_hash_x(interpreter, &hash, enum_type_int, 0, Hash_key_type_int,
- int_compare, key_hash_int, pobject_lives);
+ int_compare, key_hash_int, pobject_lives_fn);
PObj_custom_mark_SET(registry);
PMC_struct_val(registry) = hash;
}
