cvsuser 04/08/19 04:48:19
Modified: classes array.pmc perlhash.pmc
include/parrot dod.h hash.h
src dod.c gc_ims.c hash.c headers.c smallobject.c
t/op gc.t
Log:
gc subsystems 6 - hash write barrier
* add new_pmc_hash to put the container PMC into the hash
* write barrier in hash_put
* strings and other buffers are now created black with the
incremental GC
* preserve object flags from the allocator
Revision Changes Path
1.89 +5 -5 parrot/classes/array.pmc
Index: array.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/array.pmc,v
retrieving revision 1.88
retrieving revision 1.89
diff -u -w -r1.88 -r1.89
--- array.pmc 10 Jul 2004 16:56:53 -0000 1.88
+++ array.pmc 19 Aug 2004 11:48:14 -0000 1.89
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: array.pmc,v 1.88 2004/07/10 16:56:53 leo Exp $
+$Id: array.pmc,v 1.89 2004/08/19 11:48:14 leo Exp $
=head1 NAME
1.88 +7 -5 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -w -r1.87 -r1.88
--- perlhash.pmc 29 Jul 2004 09:12:38 -0000 1.87
+++ perlhash.pmc 19 Aug 2004 11:48:14 -0000 1.88
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlhash.pmc,v 1.87 2004/07/29 09:12:38 leo Exp $
+$Id: perlhash.pmc,v 1.88 2004/08/19 11:48:14 leo Exp $
=head1 NAME
@@ -85,11 +85,12 @@
INTVAL start, end, step;
Hash* hash;
parrot_range_t *range = PMC_struct_val(keys);
- new_hash_x(interpreter, &hash, enum_type_ptr,
+
+ new_pmc_hash_x(interpreter, self, enum_type_ptr,
0, Hash_key_type_int,
int_compare, key_hash_int,
(hash_mark_key_fn) NULL);
- PMC_struct_val(self) = hash;
+ hash = PMC_struct_val(self);
start = RVal_int(range->start);
end = RVal_int(range->end);
step = RVal_int(range->step);
@@ -214,7 +215,7 @@
void init () {
PObj_custom_mark_SET(SELF);
- new_hash(INTERP, (Hash**)&PMC_struct_val(SELF));
+ new_pmc_hash(INTERP, SELF);
}
/*
@@ -289,6 +290,7 @@
PMC* clone () {
PMC* dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);
PObj_custom_mark_SET(dest);
+ ((Hash*)PMC_struct_val(dest))->container = dest;
hash_clone(INTERP, (Hash *)PMC_struct_val(SELF),
(Hash**)&PMC_struct_val(dest));
return dest;
1.19 +2 -2 parrot/include/parrot/dod.h
Index: dod.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/dod.h,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- dod.h 18 Aug 2004 12:53:28 -0000 1.18
+++ dod.h 19 Aug 2004 11:48:16 -0000 1.19
@@ -1,7 +1,7 @@
/* dod.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.h,v 1.18 2004/08/18 12:53:28 leo Exp $
+ * $Id: dod.h,v 1.19 2004/08/19 11:48:16 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -86,7 +86,7 @@
#if PARROT_GC_IMS
# define DOD_WRITE_BARRIER(interp, agg, old, new) \
do { \
- if ( \
+ if ( !PMC_IS_NULL(new) && \
PObj_live_TEST(agg) && \
(PObj_get_FLAGS(agg) & PObj_custom_GC_FLAG) && \
!PObj_live_TEST(new)) { \
1.24 +5 -1 parrot/include/parrot/hash.h
Index: hash.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/hash.h,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- hash.h 22 Apr 2004 08:55:05 -0000 1.23
+++ hash.h 19 Aug 2004 11:48:17 -0000 1.24
@@ -1,7 +1,7 @@
/* hash.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.h,v 1.23 2004/04/22 08:55:05 leo Exp $
+ * $Id: hash.h,v 1.24 2004/08/19 11:48:17 leo Exp $
* Overview:
* Hashtable implementation
* Data Structure and Algorithms:
@@ -64,6 +64,7 @@
UINTVAL entries; /* Number of values stored in hashtable */
Buffer *bucket_pool; /* Buffer full of buckets, used and unused */
BucketIndex free_list;
+ PMC *container; /* e.g. the PerlHash PMC */
PARROT_DATA_TYPES entry_type; /* type of value */
size_t value_size; /* currently unused, if set this size
at value is copied as a hash_entry */
@@ -76,8 +77,11 @@
};
void new_hash(Interp * interpreter, Hash **hptr);
+void new_pmc_hash(Interp * interpreter, PMC *container);
void new_hash_x(Interp *, Hash**, PARROT_DATA_TYPES, size_t val_size,
Hash_key_type, hash_comp_fn, hash_hash_key_fn, hash_mark_key_fn);
+void new_pmc_hash_x(Interp *, PMC*, PARROT_DATA_TYPES, size_t val_size,
+ Hash_key_type, hash_comp_fn, hash_hash_key_fn, hash_mark_key_fn);
void new_cstring_hash(Interp *interpreter, Hash **);
void hash_clone(Interp * interpreter, Hash * src, Hash **dest);
INTVAL hash_size(Interp * interpreter, Hash *hash);
1.128 +4 -2 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.127
retrieving revision 1.128
diff -u -w -r1.127 -r1.128
--- dod.c 18 Aug 2004 12:53:29 -0000 1.127
+++ dod.c 19 Aug 2004 11:48:18 -0000 1.128
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dod.c,v 1.127 2004/08/18 12:53:29 leo Exp $
+$Id: dod.c,v 1.128 2004/08/19 11:48:18 leo Exp $
=head1 NAME
@@ -127,9 +127,11 @@
arena_base->dod_mark_ptr = PMC_next_for_GC(obj) = obj;
}
}
- else if (PObj_custom_mark_TEST(obj))
+ else if (PObj_custom_mark_TEST(obj)) {
+ PObj_get_FLAGS(obj) |= PObj_custom_GC_FLAG;
VTABLE_mark(interpreter, obj);
}
+}
#if ARENA_DOD_FLAGS
1.6 +18 -11 parrot/src/gc_ims.c
Index: gc_ims.c
===================================================================
RCS file: /cvs/public/parrot/src/gc_ims.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- gc_ims.c 18 Aug 2004 12:53:29 -0000 1.5
+++ gc_ims.c 19 Aug 2004 11:48:18 -0000 1.6
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: gc_ims.c,v 1.5 2004/08/18 12:53:29 leo Exp $
+$Id: gc_ims.c,v 1.6 2004/08/19 11:48:18 leo Exp $
=head1 NAME
@@ -436,22 +436,28 @@
gc_ims_get_free_object(Interp *interpreter,
struct Small_Object_Pool *pool)
{
- void *ptr;
+ PObj *ptr;
+ struct Arenas *arena_base;
Gc_ims_private *g_ims;
+ arena_base = interpreter->arena_base;
/* if we don't have any objects */
if (!pool->free_list)
(*pool->alloc_objects) (interpreter, pool);
ptr = pool->free_list;
pool->free_list = *(void **)ptr;
- PObj_on_free_list_CLEAR((PObj*) ptr);
- PObj_get_FLAGS((PObj*)ptr) &= ~PObj_custom_GC_FLAG;
+ /*
+ * buffers are born black, PMCs not yet?
+ * XXX this does not solve the problem of storing keys in hashes
+ * in the next DOD cycle (if the key isn't marked elsewhere ?)
+ */
+ PObj_flags_SETTO(ptr, pool == arena_base->pmc_pool ? 0 : PObj_live_FLAG);
--pool->num_free_objects;
#if ! DISABLE_GC_DEBUG
if (GC_DEBUG(interpreter))
- PObj_version((Buffer*)ptr) = interpreter->arena_base->dod_runs;
+ PObj_version((Buffer*)ptr) = arena_base->dod_runs;
#endif
- g_ims = interpreter->arena_base->gc_private;
+ g_ims = arena_base->gc_private;
if (++g_ims->allocations >= g_ims->alloc_trigger)
parrot_gc_ims_run_increment(interpreter);
return ptr;
@@ -683,6 +689,8 @@
Gc_ims_private *g_ims;
struct Arenas *arena_base = interpreter->arena_base;
+ if (Parrot_is_blocked_DOD(interpreter))
+ return;
g_ims = arena_base->gc_private;
g_ims->allocations = 0;
++g_ims->increments;
@@ -695,9 +703,7 @@
g_ims->throttle = THROTTLE;
break;
case GC_IMS_STARTING:
- if (Parrot_is_blocked_DOD(interpreter))
- break;
- /* else fall through and start */
+ /* fall through and start */
case GC_IMS_RE_INIT:
parrot_gc_ims_reinit(interpreter);
break;
@@ -839,8 +845,9 @@
Parrot_dod_ims_wb(Interp* interpreter, PMC *agg, PMC *new)
{
#if DOD_IMS_GREY_NEW
- IMS_DEBUG((stderr, "%d ", ((Gc_ims_private *)interpreter->arena_base->
- gc_private)->state));
+ IMS_DEBUG((stderr, "%d agg %p mark %p\n",
+ ((Gc_ims_private *)interpreter->arena_base->
+ gc_private)->state, agg, new));
pobject_lives(interpreter, (PObj*)new);
#else
PObj_get_FLAGS(agg) &= ~ (PObj_live_FLAG|PObj_custom_GC_FLAG);
1.84 +70 -15 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -w -r1.83 -r1.84
--- hash.c 10 Jul 2004 11:40:55 -0000 1.83
+++ hash.c 19 Aug 2004 11:48:18 -0000 1.84
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: hash.c,v 1.83 2004/07/10 11:40:55 leo Exp $
+$Id: hash.c,v 1.84 2004/08/19 11:48:18 leo Exp $
=head1 NAME
@@ -547,6 +547,10 @@
Returns a new Parrot string hash in C<hptr>.
+new_pmc_hash(Interp *interpreter, PMC *container)>
+
+Create a new Parrot string hash in PMC_struct_val(container)
+
=cut
*/
@@ -563,6 +567,17 @@
pobject_lives); /* mark */
}
+void
+new_pmc_hash(Interp *interpreter, PMC *container)
+{
+ new_pmc_hash_x(interpreter, container,
+ enum_type_PMC,
+ 0,
+ Hash_key_type_ascii,
+ STRING_compare, /* STRING compare */
+ key_hash_STRING, /* hash */
+ pobject_lives); /* mark */
+}
/*
=item C<void
@@ -607,19 +622,28 @@
on the stack I<including> this newly constructed Hash, so that it gets
marked properly.
+=item C<void
+new_pmc_hash_x(Interp *interpreter, PMC *container,
+ PARROT_DATA_TYPES val_type, size_t val_size,
+ Hash_key_type hkey_type,
+ hash_comp_fn compare, hash_hash_key_fn keyhash,
+ hash_mark_key_fn mark)>
+
+Like above but w/o the decribed problems. The passed in C<container> PMC gets
+stored in the Hash end the newly created Hash is in PMC_struct_val(container).
+
=cut
*/
-void
-new_hash_x(Interp *interpreter, Hash **hptr,
+static void
+init_hash(Interp *interpreter, Hash *hash,
PARROT_DATA_TYPES val_type, size_t val_size,
Hash_key_type hkey_type,
hash_comp_fn compare, hash_hash_key_fn keyhash,
hash_mark_key_fn mark)
{
- Hash *hash = (Hash *)new_bufferlike_header(interpreter, sizeof(*hash));
- *hptr = hash;
+
hash->compare = compare;
hash->hash_val = keyhash;
hash->mark_key = mark;
@@ -650,6 +674,33 @@
expand_hash(interpreter, hash);
}
+void
+new_hash_x(Interp *interpreter, Hash **hptr,
+ PARROT_DATA_TYPES val_type, size_t val_size,
+ Hash_key_type hkey_type,
+ hash_comp_fn compare, hash_hash_key_fn keyhash,
+ hash_mark_key_fn mark)
+{
+ Hash *hash = (Hash *)new_bufferlike_header(interpreter, sizeof(*hash));
+ *hptr = hash;
+ init_hash(interpreter, hash, val_type, val_size, hkey_type,
+ compare, keyhash, mark);
+}
+
+void
+new_pmc_hash_x(Interp *interpreter, PMC *container,
+ PARROT_DATA_TYPES val_type, size_t val_size,
+ Hash_key_type hkey_type,
+ hash_comp_fn compare, hash_hash_key_fn keyhash,
+ hash_mark_key_fn mark)
+{
+ Hash *hash = (Hash *)new_bufferlike_header(interpreter, sizeof(*hash));
+ PMC_struct_val(container) = hash;
+ hash->container = container;
+ init_hash(interpreter, hash, val_type, val_size, hkey_type,
+ compare, keyhash, mark);
+}
+
/*
=item C<INTVAL
@@ -718,9 +769,9 @@
/*
=item C<HashBucket *
-hash_get_bucket(Interp *interpreter, Hash *hash, void *okey)>
+hash_get_bucket(Interp *interpreter, Hash *hash, void *key)>
-Returns the bucket for C<okey>.
+Returns the bucket for C<key>.
=cut
@@ -774,9 +825,9 @@
/*
=item C<HashBucket*
-hash_put(Interp *interpreter, Hash *hash, void *okey, void *value)>
+hash_put(Interp *interpreter, Hash *hash, void *key, void *value)>
-Puts the key and value into the hash. Note that C<okey> is B<not>
+Puts the key and value into the hash. Note that C<key> is B<not>
copied.
=cut
@@ -784,7 +835,7 @@
*/
HashBucket*
-hash_put(Interp *interpreter, Hash *hash, void *okey, void *value)
+hash_put(Interp *interpreter, Hash *hash, void *key, void *value)
{
BucketIndex *table;
UINTVAL hashval;
@@ -792,8 +843,6 @@
BucketIndex chain;
HashBucket *bucket;
- void *key = okey;
-
/* dump_hash(interpreter, hash); */
hashval = (hash->hash_val)(interpreter, hash, key);
@@ -806,10 +855,17 @@
/* hash, PObj_bufstart(&hash->buffer), chain, bucket,
string_to_cstring(interpreter, key)); */
if (bucket) {
+ if (hash->entry_type == enum_type_PMC && hash->container) {
+ DOD_WRITE_BARRIER(interpreter, hash->container,
+ (PMC*)bucket->value, (PMC*)value);
+ }
/* Replacing old value */
bucket->value = value; /* TODO copy value_size */
}
else {
+ if (hash->entry_type == enum_type_PMC && hash->container) {
+ DOD_WRITE_BARRIER(interpreter, hash->container, NULL, (PMC*)value);
+ }
/* Create new bucket */
hash->entries++;
bucket_index = new_bucket(interpreter, hash, key, value);
@@ -825,7 +881,7 @@
/*
=item C<void
-hash_delete(Interp *interpreter, Hash *hash, void *okey)>
+hash_delete(Interp *interpreter, Hash *hash, void *key)>
Deletes the key from the hash.
@@ -834,13 +890,12 @@
*/
void
-hash_delete(Interp *interpreter, Hash *hash, void *okey)
+hash_delete(Interp *interpreter, Hash *hash, void *key)
{
UINTVAL hashval;
HashIndex slot;
HashBucket *bucket;
HashBucket *prev = NULL;
- void *key = okey;
hashval = (hash->hash_val)(interpreter, hash, key);
slot = hashval & hash->max_chain;
1.57 +10 -6 parrot/src/headers.c
Index: headers.c
===================================================================
RCS file: /cvs/public/parrot/src/headers.c,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -w -r1.56 -r1.57
--- headers.c 16 Aug 2004 10:33:35 -0000 1.56
+++ headers.c 19 Aug 2004 11:48:18 -0000 1.57
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: headers.c,v 1.56 2004/08/16 10:33:35 leo Exp $
+$Id: headers.c,v 1.57 2004/08/19 11:48:18 leo Exp $
=head1 NAME
@@ -53,10 +53,14 @@
get_free_buffer(Interp *interpreter,
struct Small_Object_Pool *pool)
{
- Buffer *buffer = pool->get_free_object(interpreter, pool);
+ PObj *buffer = pool->get_free_object(interpreter, pool);
- memset(buffer, 0, pool->object_size);
- SET_NULL(PObj_bufstart(buffer));
+ /* don't mess around with flags */
+ PObj_bufstart(buffer) = NULL;
+ PObj_buflen(buffer) = 0;
+
+ if (pool->object_size > sizeof(PObj))
+ memset(buffer + 1, 0, pool->object_size - sizeof(PObj));
return buffer;
}
@@ -266,7 +270,7 @@
}
else
pmc->pmc_ext = NULL;
- PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG|flags);
+ PObj_get_FLAGS(pmc) |= PObj_is_PMC_FLAG|flags;
pmc->vtable = NULL;
#if ! PMC_DATA_IN_EXT
PMC_data(pmc) = NULL;
@@ -340,7 +344,7 @@
? interpreter->
arena_base->constant_string_header_pool :
interpreter->arena_base->string_header_pool);
- PObj_flags_SETTO(string, flags | PObj_is_string_FLAG);
+ PObj_get_FLAGS(string) |= flags | PObj_is_string_FLAG;
SET_NULL(string->strstart);
return string;
}
1.50 +5 -1 parrot/src/smallobject.c
Index: smallobject.c
===================================================================
RCS file: /cvs/public/parrot/src/smallobject.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -w -r1.49 -r1.50
--- smallobject.c 15 Aug 2004 15:24:17 -0000 1.49
+++ smallobject.c 19 Aug 2004 11:48:18 -0000 1.50
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: smallobject.c,v 1.49 2004/08/15 15:24:17 leo Exp $
+$Id: smallobject.c,v 1.50 2004/08/19 11:48:18 leo Exp $
=head1 NAME
@@ -183,7 +183,10 @@
(*pool->more_objects) (interpreter, pool);
ptr = pool->free_list;
pool->free_list = *(void **)ptr;
+ PObj_flags_SETTO( (PObj*) ptr, 0);
+#if ARENA_DOD_FLAGS
PObj_on_free_list_CLEAR((PObj*) ptr);
+#endif
--pool->num_free_objects;
#if ! DISABLE_GC_DEBUG
if (GC_DEBUG(interpreter))
@@ -207,6 +210,7 @@
--pool->num_free_objects;
*((Dead_PObj*)ptr)->arena_dod_flag_ptr &=
~ (PObj_on_free_list_FLAG << ((Dead_PObj*)ptr)->flag_shift);
+ PObj_flags_SETTO( (PObj*) ptr, 0);
return ptr;
}
1.16 +58 -2 parrot/t/op/gc.t
Index: gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- gc.t 18 Aug 2004 12:53:31 -0000 1.15
+++ gc.t 19 Aug 2004 11:48:19 -0000 1.16
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: gc.t,v 1.15 2004/08/18 12:53:31 leo Exp $
+# $Id: gc.t,v 1.16 2004/08/19 11:48:19 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 15;
+use Parrot::Test tests => 16;
output_is( <<'CODE', '1', "sweep 1" );
interpinfo I1, 2 # How many DOD runs have we done already?
@@ -526,3 +526,59 @@
CODE
ok
OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "write barrier 2 - hash");
+ null I2
+ set I3, 100
+lp3:
+ null I0
+ set I1, 100
+ new P1, .PerlHash
+lp1:
+ new P2, .PerlHash
+ new P0, .Integer
+ set P0, I0
+ set S0, I0
+ set P2["first"], P0
+ set P1[S0], P2
+ if I0, not_0
+ new P0, .Integer
+ needs_destroy P0
+ null P0
+ # force full sweep
+ sweep 0
+not_0:
+ new P3, .Undef
+ new P4, .Undef
+ inc I0
+ lt I0, I1, lp1
+
+ null I0
+ # trace 1
+lp2:
+ set S0, I0
+ set P2, P1[S0]
+ set P2, P2["first"]
+ eq P2, I0, ok
+ print "nok\n"
+ print "I0: "
+ print I0
+ print " P2: "
+ print P2
+ print " type: "
+ typeof S0, P2
+ print S0
+ print " I2: "
+ print I2
+ print "\n"
+ exit 1
+ok:
+ inc I0
+ lt I0, I1, lp2
+ inc I2
+ lt I2, I3, lp3
+ print "ok\n"
+ end
+CODE
+ok
+OUTPUT
