Since I am unable to help with the C part of things, I
figured I could at least track
down where the problem was for everyone. I have
isolated the ARENA_DOD_FLAGS problem
on Cygwin to a change committed to CVS between
2004-04-15 10:00 and 10:15 EDT. After
10:15, I need to disable it for it to compile.
There are 5 files that changed in that interval
headers.c
objects.c
pmc.c
smallobject.c
sub.c
here are the diffs
$ diff -u /tmp/good/sub.c /tmp/bad/sub.c
--- /tmp/good/sub.c 2004-05-06 12:08:49.638886800
-0400
+++ /tmp/bad/sub.c 2004-05-06 12:08:11.006060400
-0400
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights
Reserved.
-$Id: sub.c,v 1.59 2004/04/14 15:23:01 leo Exp $
+$Id: sub.c,v 1.60 2004/04/15 14:01:04 leo Exp $
=head1 NAME
@@ -446,8 +446,10 @@
/* fprintf(stderr, "** add %p free = %p\n", sub,
mc->retc_free_list); */
PMC_struct_val(sub) = mc->retc_free_list;
mc->retc_free_list = sub;
- /* don't mark the continuation context */
- PObj_custom_mark_CLEAR(sub);
+ /* don't mark the continuation context
+ * -- don't use PObj_custom_mark_* - too
expensive and not necessary
+ */
+ PObj_flag_CLEAR(custom_mark, sub);
/*
* shouldn't be necessary, s. also stack_common.c
*/
@@ -465,7 +467,7 @@
return NULL;
retc = mc->retc_free_list;
mc->retc_free_list = PMC_struct_val(retc);
- PObj_custom_mark_SET(retc);
+ PObj_flag_SET(custom_mark, retc);
/* PObj_on_free_list_CLEAR(retc); */
/* fprintf(stderr, "** get %p free = %p\n", retc,
mc->retc_free_list ); */
return retc;
$ diff -u /tmp/good/smallobject.c
/tmp/bad/smallobject.c
--- /tmp/good/smallobject.c 2004-05-06
12:08:44.222197200 -0400
+++ /tmp/bad/smallobject.c 2004-05-06
12:08:00.032594400 -0400
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights
Reserved.
-$Id: smallobject.c,v 1.41 2004/04/15 07:32:09 leo Exp
$
+$Id: smallobject.c,v 1.42 2004/04/15 14:01:04 leo Exp
$
=head1 NAME
@@ -198,10 +198,6 @@
pool->free_list = *(void **)ptr;
*((Dead_PObj*)ptr)->arena_dod_flag_ptr &=
~ (PObj_on_free_list_FLAG <<
((Dead_PObj*)ptr)->flag_shift);
-#if ! DISABLE_GC_DEBUG
- if (GC_DEBUG(interpreter))
- PObj_version((Buffer*)ptr) =
interpreter->dod_runs;
-#endif
return ptr;
}
$ diff -u /tmp/good/pmc.c /tmp/bad/pmc.c | more
--- /tmp/good/pmc.c 2004-05-06 12:08:37.793769600
-0400
+++ /tmp/bad/pmc.c 2004-05-06 12:07:45.121132800
-0400
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights
Reserved.
-$Id: pmc.c,v 1.77 2004/04/15 07:32:09 leo Exp $
+$Id: pmc.c,v 1.78 2004/04/15 14:01:04 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
*/
#include "parrot/parrot.h"
-static PMC* get_new_pmc_header(Parrot_Interp, INTVAL
base_type, int constant);
+static PMC* get_new_pmc_header(Parrot_Interp, INTVAL
base_type, UINTVAL flags);
#if PARROT_CATCH_NULL
@@ -40,8 +40,8 @@
{
LOCK(init_null_mutex);
if(!PMCNULL)
- PMCNULL = get_new_pmc_header(interpreter,
enum_class_Null, 1);
- PMCNULL->pmc_ext = NULL;
+ PMCNULL = get_new_pmc_header(interpreter,
enum_class_Null,
+ PObj_constant_FLAG);
PMCNULL->vtable =
Parrot_base_vtables[enum_class_Null];
UNLOCK(init_null_mutex);
return PMCNULL;
@@ -75,7 +75,7 @@
=item C<static PMC*
get_new_pmc_header(struct Parrot_Interp *interpreter,
INTVAL base_type,
- int constant)>
+ UINTVAL flags)>
Gets a new PMC header.
@@ -85,35 +85,42 @@
static PMC*
get_new_pmc_header(struct Parrot_Interp *interpreter,
INTVAL base_type,
- int constant)
+ UINTVAL flags)
{
PMC *pmc;
+ VTABLE *vtable = Parrot_base_vtables[base_type];
- if (Parrot_base_vtables[base_type]->flags &
VTABLE_IS_CONST_FLAG) {
+ if (vtable->flags & VTABLE_IS_CONST_FLAG) {
/* put the normal vtable in, so that the pmc
can be initialized first
* parrot or user code has to set the _ro
property then,
* to morph the PMC to the const variant
+ * This assumes that a constant PMC enum is
one bigger then
+ * the normal one.
*/
- constant = 1;
+ flags = PObj_constant_FLAG;
--base_type;
+ vtable = Parrot_base_vtables[base_type];
+ }
+ if (vtable->flags & VTABLE_PMC_NEEDS_EXT) {
+ flags |= PObj_is_PMC_EXT_FLAG;
+ if (vtable->flags & VTABLE_IS_SHARED_FLAG)
+ flags |= PObj_is_PMC_shared_FLAG;
}
- pmc = new_pmc_header(interpreter, constant);
+ pmc = new_pmc_header(interpreter, flags);
if (!pmc) {
internal_exception(ALLOCATION_ERROR,
"Parrot VM: PMC allocation
failed!\n");
return NULL;
}
- if (constant)
- PObj_constant_SET(pmc);
- pmc->vtable = Parrot_base_vtables[base_type];
+ pmc->vtable = vtable;
- if (!pmc->vtable || !pmc->vtable->init) {
+ if (!vtable || !vtable->init) {
/* This is usually because you either didn't
call init_world early
* enough or you added a new PMC class
without adding
* Parrot_(classname)_class_init to
init_world. */
- PANIC("Null vtable used");
+ PANIC("Null vtable used or missing init");
return NULL;
}
#if GC_VERBOSE
@@ -125,32 +132,6 @@
return pmc;
}
-/*
-
-=item C<static void
-pmc_new_ext(Parrot_Interp interpreter, PMC *pmc,
INTVAL base_type)>
-
-Add a new C<PMC_EXT> to C<*pmc>. If the C<*pmc> is
shared also add
-the C<synchronize> structure and init the mutex.
-
-=cut
-
-*/
-
-static void
-pmc_new_ext(Parrot_Interp interpreter, PMC *pmc,
INTVAL base_type)
-{
- if (pmc->vtable->flags & VTABLE_PMC_NEEDS_EXT) {
- add_pmc_ext(interpreter, pmc);
-
- if (pmc->vtable->flags &
VTABLE_IS_SHARED_FLAG) {
- PMC_sync(pmc) =
mem_sys_allocate(sizeof(*PMC_sync(pmc)));
- PMC_sync(pmc)->owner = interpreter;
- MUTEX_INIT(PMC_sync(pmc)->pmc_lock);
- PObj_is_PMC_shared_SET(pmc);
- }
- }
-}
/*
@@ -179,7 +160,8 @@
pmc =
VTABLE_get_pmc_keyed_int(interpreter,
interpreter->iglobals,
(INTVAL)IGLOBALS_ENV_HASH);
if (!pmc) {
- pmc = get_new_pmc_header(interpreter,
base_type, 1);
+ pmc = get_new_pmc_header(interpreter,
base_type,
+ PObj_constant_FLAG);
VTABLE_set_pmc_keyed_int(interpreter,
interpreter->iglobals,
(INTVAL)IGLOBALS_ENV_HASH,
pmc);
/* UNLOCK */}
@@ -196,13 +178,13 @@
pmc =
(Parrot_base_vtables[base_type]->get_pointer)(interpreter,
NULL);
/* LOCK */
if (!pmc) {
- pmc = get_new_pmc_header(interpreter,
base_type, 1);
+ pmc = get_new_pmc_header(interpreter,
base_type,
+ PObj_constant_FLAG);
VTABLE_set_pointer(interpreter, pmc,
pmc);
}
return pmc;
}
pmc = get_new_pmc_header(interpreter, base_type,
0);
- pmc_new_ext(interpreter, pmc, base_type);
return pmc;
}
@@ -220,8 +202,8 @@
PMC *
constant_pmc_new_noinit(struct Parrot_Interp
*interpreter, INTVAL base_type)
{
- PMC *pmc = get_new_pmc_header(interpreter,
base_type, 1);
- pmc_new_ext(interpreter, pmc, base_type);
+ PMC *pmc = get_new_pmc_header(interpreter,
base_type,
+ PObj_constant_FLAG);
return pmc;
}
@@ -239,8 +221,8 @@
PMC *
constant_pmc_new(struct Parrot_Interp *interpreter,
INTVAL base_type)
{
- PMC *pmc = get_new_pmc_header(interpreter,
base_type, 1);
- pmc_new_ext(interpreter, pmc, base_type);
+ PMC *pmc = get_new_pmc_header(interpreter,
base_type,
+ PObj_constant_FLAG);
VTABLE_init(interpreter, pmc);
return pmc;
}
@@ -283,7 +265,6 @@
PMC *init)
{
PMC *pmc = get_new_pmc_header(interpreter,
base_type, 1);
- pmc_new_ext(interpreter, pmc, base_type);
VTABLE_init_pmc(interpreter, pmc, init);
return pmc;
}
$ diff -u /tmp/good/objects.c /tmp/bad/objects.c
--- /tmp/good/objects.c 2004-05-06 12:08:32.859601200
-0400
+++ /tmp/bad/objects.c 2004-05-06 12:07:37.245141600
-0400
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights
Reserved.
-$Id: objects.c,v 1.82 2004/04/14 14:30:49 leo Exp $
+$Id: objects.c,v 1.83 2004/04/15 14:01:04 leo Exp $
=head1 NAME
@@ -613,7 +613,7 @@
set_attrib_array_size(new_object_array,
attrib_count +
POD_FIRST_ATTRIB);
/* then activate marking it -
set_attrib_flags(object); */
- PObj_custom_mark_SET(object);
+ PObj_flag_SET(custom_mark, 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);
$ diff -u /tmp/good/headers.c /tmp/bad/headers.c
--- /tmp/good/headers.c 2004-05-06 12:08:27.458476800
-0400
+++ /tmp/bad/headers.c 2004-05-06 12:07:27.298978800
-0400
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights
Reserved.
-$Id: headers.c,v 1.49 2004/04/15 10:51:12 leo Exp $
+$Id: headers.c,v 1.50 2004/04/15 14:01:04 leo Exp $
=head1 NAME
@@ -233,23 +233,40 @@
*/
+static PMC_EXT * new_pmc_ext(Parrot_Interp);
+
PMC *
new_pmc_header(struct Parrot_Interp *interpreter,
UINTVAL flags)
{
struct Small_Object_Pool *pool;
PMC *pmc;
- pool = flags ?
+ pool = flags & PObj_constant_FLAG ?
interpreter->arena_base->constant_pmc_pool :
interpreter->arena_base->pmc_pool;
pmc = pool->get_free_object(interpreter, pool);
/* clear flags, set is_PMC_FLAG */
- PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG);
+ if (flags & PObj_is_PMC_EXT_FLAG) {
+#if ARENA_DOD_FLAGS
+ *((Dead_PObj*)pmc)->arena_dod_flag_ptr |=
+ (PObj_is_special_PMC_FLAG <<
((Dead_PObj*)pmc)->flag_shift);
+#else
+ PObj_is_special_PMC_SET(pmc);
+#endif
+ pmc->pmc_ext = new_pmc_ext(interpreter);
+ if (flags & PObj_is_PMC_shared_FLAG) {
+ PMC_sync(pmc) =
mem_sys_allocate(sizeof(*PMC_sync(pmc)));
+ PMC_sync(pmc)->owner = interpreter;
+ MUTEX_INIT(PMC_sync(pmc)->pmc_lock);
+ }
+ }
+ else
+ pmc->pmc_ext = NULL;
+ PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG|flags);
pmc->vtable = NULL;
#if ! PMC_DATA_IN_EXT
PMC_data(pmc) = NULL;
#endif
- pmc->pmc_ext = NULL;
return pmc;
}
@@ -264,7 +281,7 @@
*/
-static PARROT_INLINE PMC_EXT *
+static PMC_EXT *
new_pmc_ext(struct Parrot_Interp *interpreter)
{
struct Small_Object_Pool *pool =
interpreter->arena_base->pmc_ext_pool;
Cheers
Joshua Gatcomb
a.k.a. Limbic~Region
__________________________________
Do you Yahoo!?
Win a $20,000 Career Makeover at Yahoo! HotJobs
http://hotjobs.sweepstakes.yahoo.com/careermakeover
