cvsuser 04/08/20 01:41:39
Modified: classes default.pmc perlhash.pmc
include/parrot pmc_freeze.h
src headers.c pmc_freeze.c
Log:
gc subsystems 8 - incremental GC is working
Revision Changes Path
1.99 +4 -2 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -w -r1.98 -r1.99
--- default.pmc 19 Aug 2004 13:46:12 -0000 1.98
+++ default.pmc 20 Aug 2004 08:41:35 -0000 1.99
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.98 2004/08/19 13:46:12 leo Exp $
+$Id: default.pmc,v 1.99 2004/08/20 08:41:35 leo Exp $
=head1 NAME
@@ -190,6 +190,7 @@
void init_pmc_props (PMC* initializer, PMC* properties) {
if (!SELF->pmc_ext)
add_pmc_ext(INTERP, SELF);
+ DOD_WRITE_BARRIER(interpreter, SELF, NULL, properties);
PMC_metadata(SELF) = properties;
if (initializer)
DYNSELF.init_pmc(initializer);
@@ -831,6 +832,7 @@
if (!SELF->pmc_ext)
add_pmc_ext(INTERP, SELF);
info->thaw_ptr = &PMC_metadata(SELF);
+ info->container = SELF;
(info->visit_pmc_now)(interpreter, PMC_metadata(SELF), info);
}
else
1.89 +2 -1 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.88
retrieving revision 1.89
diff -u -w -r1.88 -r1.89
--- perlhash.pmc 19 Aug 2004 11:48:14 -0000 1.88
+++ perlhash.pmc 20 Aug 2004 08:41:35 -0000 1.89
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlhash.pmc,v 1.88 2004/08/19 11:48:14 leo Exp $
+$Id: perlhash.pmc,v 1.89 2004/08/20 08:41:35 leo Exp $
=head1 NAME
@@ -1036,6 +1036,7 @@
*/
void visit(visit_info *info) {
+ info->container = SELF;
hash_visit(INTERP, (Hash*)PMC_struct_val(SELF), info);
SUPER(info);
}
1.7 +2 -1 parrot/include/parrot/pmc_freeze.h
Index: pmc_freeze.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc_freeze.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- pmc_freeze.h 22 Apr 2004 08:55:06 -0000 1.6
+++ pmc_freeze.h 20 Aug 2004 08:41:37 -0000 1.7
@@ -1,7 +1,7 @@
/* pmc_freeze.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.h,v 1.6 2004/04/22 08:55:06 leo Exp $
+ * $Id: pmc_freeze.h,v 1.7 2004/08/20 08:41:37 leo Exp $
* Overview:
* PMC freeze and thaw interface
* Data Structure and Algorithms:
@@ -67,6 +67,7 @@
STRING* image;
PMC* mark_ptr;
PMC** thaw_ptr; /* where to thaw aa new PMC */
+ PMC* container; /* when thawing aggregate items */
INTVAL last_type;
PMC* seen; /* seen hash */
PMC* todo; /* todo list */
1.58 +10 -1 parrot/src/headers.c
Index: headers.c
===================================================================
RCS file: /cvs/public/parrot/src/headers.c,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -w -r1.57 -r1.58
--- headers.c 19 Aug 2004 11:48:18 -0000 1.57
+++ headers.c 20 Aug 2004 08:41:38 -0000 1.58
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: headers.c,v 1.57 2004/08/19 11:48:18 leo Exp $
+$Id: headers.c,v 1.58 2004/08/20 08:41:38 leo Exp $
=head1 NAME
@@ -322,6 +322,15 @@
{
pmc->pmc_ext = new_pmc_ext(interpreter);
PObj_is_PMC_EXT_SET(pmc);
+#ifdef PARROT_GC_IMS
+ /*
+ * preserve DDD color: a simple PMC live = black
+ * an aggregate live = grey
+ * set'em black
+ */
+ if (PObj_live_TEST(pmc))
+ PObj_get_FLAGS(pmc) |= PObj_custom_GC_FLAG;
+#endif
}
/*
1.26 +19 -6 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- pmc_freeze.c 19 Aug 2004 13:46:14 -0000 1.25
+++ pmc_freeze.c 20 Aug 2004 08:41:39 -0000 1.26
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc_freeze.c,v 1.25 2004/08/19 13:46:14 leo Exp $
+$Id: pmc_freeze.c,v 1.26 2004/08/20 08:41:39 leo Exp $
=head1 NAME
@@ -42,7 +42,7 @@
/*
* normal freeze can use next_for_GC ptrs or a seen hash
*/
-#define FREEZE_USE_NEXT_FOR_GC 1
+#define FREEZE_USE_NEXT_FOR_GC 0
/*
* when thawing a string longer then this size, we first do a
@@ -731,6 +731,7 @@
info->id_list = pmc_new(interpreter, enum_class_Array);
info->id = 0;
info->extra_flags = EXTRA_IS_NULL;
+ info->container = NULL;
}
static void visit_todo_list(Parrot_Interp, PMC*, visit_info* info);
@@ -924,9 +925,9 @@
break;
}
assert(info->thaw_ptr);
- /*TODO
- * DOD_WRITE_BARRIER(interpreter, info->container, NULL, pmc);
- */
+ if (info->container) {
+ DOD_WRITE_BARRIER(interpreter, info->container, NULL, pmc);
+ }
*info->thaw_ptr = pmc;
}
return pmc;
@@ -991,6 +992,11 @@
#else
assert(must_have_seen);
#endif
+ /*
+ * that's a duplicate
+ if (info->container)
+ DOD_WRITE_BARRIER(interpreter, info->container, NULL, pmc);
+ */
*info->thaw_ptr = pmc;
return pmc;
}
@@ -1251,7 +1257,14 @@
visit_todo_list(Parrot_Interp interpreter, PMC* pmc, visit_info* info)
{
UINTVAL id;
- int seen = todo_list_seen(interpreter, pmc, info, &id);
+ int seen;
+
+ if (PMC_IS_NULL(pmc)) {
+ seen = 1;
+ id = 0;
+ }
+ else
+ seen = todo_list_seen(interpreter, pmc, info, &id);
do_action(interpreter, pmc, info, seen, id);
if (!seen)
(info->visit_action)(interpreter, pmc, info);
