Author: chromatic
Date: Sun Nov 9 00:11:25 2008
New Revision: 32465
Modified:
trunk/src/pmc.c
Log:
[src] Made temporary_pmc_free() call the destroy vtable entry on appropriate
PMCs.
Modified: trunk/src/pmc.c
==============================================================================
--- trunk/src/pmc.c (original)
+++ trunk/src/pmc.c Sun Nov 9 00:11:25 2008
@@ -100,7 +100,7 @@
/*
-=item C<PMC* pmc_reuse>
+=item C<PMC * pmc_reuse>
Reuse an existing PMC, turning it into an empty PMC of the new type. Any
required internal structure will be put in place (such as the extension area)
@@ -114,12 +114,12 @@
PARROT_API
PARROT_CANNOT_RETURN_NULL
-PMC*
+PMC *
pmc_reuse(PARROT_INTERP, ARGIN(PMC *pmc), INTVAL new_type,
SHIM(UINTVAL flags))
{
- INTVAL has_ext, new_flags;
VTABLE *new_vtable;
+ INTVAL has_ext, new_flags;
if (pmc->vtable->base_type == new_type)
return pmc;
@@ -128,27 +128,31 @@
/* Singleton/const PMCs/types are not eligible */
- if ((pmc->vtable->flags | new_vtable->flags)
- & (VTABLE_PMC_IS_SINGLETON | VTABLE_IS_CONST_FLAG))
+ if ((pmc->vtable->flags | new_vtable->flags)
+ & (VTABLE_PMC_IS_SINGLETON | VTABLE_IS_CONST_FLAG))
{
/* First, is the destination a singleton? No joy for us there */
if (new_vtable->flags & VTABLE_PMC_IS_SINGLETON)
- Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't turn to a singleton type!\n");
/* First, is the destination a constant? No joy for us there */
if (new_vtable->flags & VTABLE_IS_CONST_FLAG)
- Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't turn to a constant type!\n");
/* Is the source a singleton? */
if (pmc->vtable->flags & VTABLE_PMC_IS_SINGLETON)
- Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't modify a singleton\n");
/* Is the source constant? */
if (pmc->vtable->flags & VTABLE_IS_CONST_FLAG)
- Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't modify a constant\n");
}
@@ -157,10 +161,10 @@
/* Do we need one? */
if (new_vtable->flags & VTABLE_PMC_NEEDS_EXT) {
- if (!has_ext) {
- /* If we need an ext area, go allocate one */
+ /* If we need an ext area, go allocate one */
+ if (!has_ext)
add_pmc_ext(interp, pmc);
- }
+
new_flags = PObj_is_PMC_EXT_FLAG;
}
else {
@@ -185,6 +189,7 @@
return pmc;
}
+
/*
=item C<static PMC* get_new_pmc_header>
@@ -197,7 +202,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-static PMC*
+static PMC *
get_new_pmc_header(PARROT_INTERP, INTVAL base_type, UINTVAL flags)
{
PMC *pmc;
@@ -216,8 +221,8 @@
/* we only have one global Env object, living in the interp */
if (vtable_flags & VTABLE_PMC_IS_SINGLETON) {
/*
- * singletons (monadic objects) exist only once, the interface
- * with the class is:
+ * singletons (monadic objects) exist only once
+ * the interface * with the class is:
* - get_pointer: return NULL or a pointer to the single instance
* - set_pointer: set the only instance once
*
@@ -238,9 +243,8 @@
return pmc;
}
- if (vtable_flags & VTABLE_IS_CONST_PMC_FLAG) {
+ if (vtable_flags & VTABLE_IS_CONST_PMC_FLAG)
flags |= PObj_constant_FLAG;
- }
else 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,
@@ -308,6 +312,7 @@
return get_new_pmc_header(interp, base_type, 0);
}
+
/*
=item C<PMC * constant_pmc_new_noinit>
@@ -326,11 +331,12 @@
return get_new_pmc_header(interp, base_type, PObj_constant_FLAG);
}
+
/*
=item C<PMC * constant_pmc_new>
-Creates a new constant PMC of type C<base_type>, the call C<init>.
+Creates a new constant PMC of type C<base_type>, then calls its C<init>.
=cut
@@ -346,11 +352,12 @@
return pmc;
}
+
/*
=item C<PMC * pmc_new_init>
-As C<pmc_new()>, but passes C<init> to the PMC's C<init_pmc()> method.
+As C<pmc_new()>, but passes C<init> to the PMC's C<init_pmc()> vtable entry.
=cut
@@ -372,11 +379,13 @@
}
}
+
/*
=item C<PMC * constant_pmc_new_init>
-As C<constant_pmc_new>, but passes C<init> to the PMC's C<init_pmc> method.
+As C<constant_pmc_new>, but passes C<init> to the PMC's C<init_pmc> vtable
+entry.
=cut
@@ -392,12 +401,13 @@
return pmc;
}
+
/*
=item C<PMC * temporary_pmc_new(PARROT_INTERP, INTVAL base_type)>
Creates a new temporary PMC of type C<base_type>, the call C<init>. B<You> are
-responsible for freeing this PMC when it goes out of scope, with
+responsible for freeing this PMC when it goes out of scope with
C<free_temporary_pmc()>. B<Do not> store this PMC in any other PMCs, or allow
it to be stored. B<Do not> store any regular PMC in this PMC, or allow the
storage of any regular PMC in this PMC.
@@ -425,6 +435,7 @@
return pmc;
}
+
/*
=item C<void temporary_pmc_free>
@@ -444,6 +455,9 @@
Arenas *arena_base = interp->arena_base;
Small_Object_Pool *pool = arena_base->constant_pmc_pool;
+ if (PObj_active_destroy_TEST(pmc))
+ VTABLE_destroy(interp, pmc);
+
if (PObj_is_PMC_EXT_TEST(pmc))
Parrot_free_pmc_ext(interp, pmc);
@@ -452,11 +466,13 @@
pool->num_free_objects++;
}
+
/*
=item C<INTVAL pmc_register>
-This segment handles PMC registration and such.
+Registers the name of a new PMC type with Parrot, returning the INTVAL
+representing that type.
=cut
@@ -492,6 +508,7 @@
return type;
}
+
/*
=item C<INTVAL pmc_type>
@@ -525,6 +542,7 @@
}
}
+
/*
=item C<INTVAL pmc_type_p>
@@ -549,12 +567,13 @@
return 0;
}
+
/*
-=item C<static PMC* create_class_pmc>
+=item C<static PMC * create_class_pmc>
-Create a class object for this interpreter. Takes an interpreter
-name and type as arguments. Returns a pointer to the class object.
+Create a class object for this interpreter. Takes an interpreter name and type
+as arguments. Returns a pointer to the class object.
=cut
@@ -562,7 +581,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-static PMC*
+static PMC *
create_class_pmc(PARROT_INTERP, INTVAL type)
{
/*
@@ -576,10 +595,9 @@
/* If we are a second thread, we may get the same object as the
* original because we have a singleton. Just set the singleton to
- * be our class object, but don't mess with its vtable.
- */
+ * be our class object, but don't mess with its vtable. */
if ((interp->vtables[type]->flags & VTABLE_PMC_IS_SINGLETON)
- && (_class == _class->vtable->pmc_class)) {
+ && (_class == _class->vtable->pmc_class)) {
interp->vtables[type]->pmc_class = _class;
}
else {
@@ -599,6 +617,7 @@
return _class;
}
+
/*
=item C<void Parrot_create_mro>
@@ -614,13 +633,13 @@
Parrot_create_mro(PARROT_INTERP, INTVAL type)
{
PMC *_class, *mro;
- INTVAL i, count;
-
VTABLE *vtable = interp->vtables[type];
PMC *mro_list = vtable->mro;
+ INTVAL i, count;
/* multithreaded: has already mro */
- if (mro_list && mro_list->vtable->base_type !=
enum_class_ResizableStringArray)
+ if (mro_list
+ && mro_list->vtable->base_type != enum_class_ResizableStringArray)
return;
mro = pmc_new(interp, enum_class_ResizablePMCArray);
@@ -643,7 +662,7 @@
if (!vtable->_namespace) {
/* need a namespace Hash, anchor at parent, name it */
- PMC * const ns = pmc_new(interp,
+ PMC * const ns = pmc_new(interp,
Parrot_get_ctx_HLL_type(interp, enum_class_NameSpace));
vtable->_namespace = ns;
@@ -660,6 +679,7 @@
}
}
+
/*
=back
@@ -678,7 +698,7 @@
PARROT_API
void
-dod_register_pmc(PARROT_INTERP, ARGIN(PMC* pmc))
+dod_register_pmc(PARROT_INTERP, ARGIN(PMC *pmc))
{
/* Better not trigger a DOD run with a potentially unanchored PMC */
Parrot_block_GC_mark(interp);
@@ -689,6 +709,7 @@
Parrot_unblock_GC_mark(interp);
}
+
/*
=item C<void dod_unregister_pmc>
@@ -700,7 +721,7 @@
*/
void
-dod_unregister_pmc(PARROT_INTERP, ARGIN(PMC* pmc))
+dod_unregister_pmc(PARROT_INTERP, ARGIN(PMC *pmc))
{
PARROT_ASSERT(interp->DOD_registry);
@@ -708,7 +729,6 @@
}
-
/*
=back
