cvsuser 03/12/31 03:54:41
Modified: include/parrot extend.h interpreter.h pmc.h
ops core.ops ops.num pmc.ops
src dod.c extend.c interpreter.c pmc.c
Log:
register ops
* add register, unregister opcodes
* extension interface
* mark registry in DOD
Revision Changes Path
1.12 +4 -1 parrot/include/parrot/extend.h
Index: extend.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/extend.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- extend.h 10 Dec 2003 20:06:51 -0000 1.11
+++ extend.h 31 Dec 2003 11:54:32 -0000 1.12
@@ -1,7 +1,7 @@
/* extend.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: extend.h,v 1.11 2003/12/10 20:06:51 petergibbs Exp $
+ * $Id: extend.h,v 1.12 2003/12/31 11:54:32 leo Exp $
* Overview:
* This is the Parrot extension mechanism, the face we present to
* extension modules and whatnot
@@ -83,6 +83,9 @@
Parrot_Const_CharType Parrot_find_chartype(Parrot_INTERP, char*);
Parrot_Language Parrot_find_language(Parrot_INTERP, char*);
Parrot_Const_Encoding Parrot_find_encoding(Parrot_INTERP, char*);
+
+void Parrot_register_pmc(Parrot_INTERP, Parrot_PMC);
+void Parrot_unregister_pmc(Parrot_INTERP, Parrot_PMC);
#endif
1.113 +2 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -w -r1.112 -r1.113
--- interpreter.h 27 Dec 2003 12:27:54 -0000 1.112
+++ interpreter.h 31 Dec 2003 11:54:32 -0000 1.113
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.112 2003/12/27 12:27:54 leo Exp $
+ * $Id: interpreter.h,v 1.113 2003/12/31 11:54:32 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -256,6 +256,7 @@
/* 4: PMC *ParrotInterpreter that's me */
/* 5: PMC *Dyn_libs Array of dynamically loaded ParrotLibrary */
int has_early_DOD_PMCs; /* Flag that some want immediate destruction */
+ PMC* DOD_registry; /* registered PMCs added to the root set */
struct MMD_table *binop_mmd_funcs; /* Table of MMD function pointers */
struct QUEUE* task_queue; /* per interpreter queue */
struct _Thread_data *thread_data; /* thread specific items */
1.64 +7 -1 parrot/include/parrot/pmc.h
Index: pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -w -r1.63 -r1.64
--- pmc.h 2 Dec 2003 17:45:12 -0000 1.63
+++ pmc.h 31 Dec 2003 11:54:32 -0000 1.64
@@ -1,7 +1,7 @@
/* pmc.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc.h,v 1.63 2003/12/02 17:45:12 dan Exp $
+ * $Id: pmc.h,v 1.64 2003/12/31 11:54:32 leo Exp $
* Overview:
* This is the api header for the pmc subsystem
* Data Structure and Algorithms:
@@ -36,6 +36,12 @@
INTVAL pmc_register(struct Parrot_Interp *, STRING *);
INTVAL pmc_type(struct Parrot_Interp *, STRING *);
+
+/*
+ * DOD registry interface
+ */
+void dod_register_pmc(Parrot_Interp, PMC*);
+void dod_unregister_pmc(Parrot_Interp, PMC*);
/* multi method fallbacks */
void register_fallback_methods(Parrot_Interp);
1.343 +3 -3 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.342
retrieving revision 1.343
diff -u -w -r1.342 -r1.343
--- core.ops 29 Dec 2003 04:40:06 -0000 1.342
+++ core.ops 31 Dec 2003 11:54:38 -0000 1.343
@@ -1056,7 +1056,7 @@
VTABLE_type(interpreter, overflow) != enum_class_Null &&
((elems_in_array = VTABLE_get_integer(interpreter, overflow)) != 0)) {
INTVAL cur_elem;
- INTVAL start = 0;
+ start = 0;
if ($2 > 11) {
start = $2 - 11;
}
1.18 +4 -0 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- ops.num 27 Dec 2003 10:34:08 -0000 1.17
+++ ops.num 31 Dec 2003 11:54:38 -0000 1.18
@@ -1343,3 +1343,7 @@
isnull_p_ic 1316
deref_p_p 1317
foldup_p 1318
+foldup_p_i 1319
+foldup_p_ic 1320
+register_p 1321
+unregister_p 1322
1.16 +38 -0 parrot/ops/pmc.ops
Index: pmc.ops
===================================================================
RCS file: /cvs/public/parrot/ops/pmc.ops,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- pmc.ops 19 Nov 2003 15:43:33 -0000 1.15
+++ pmc.ops 31 Dec 2003 11:54:38 -0000 1.16
@@ -534,6 +534,44 @@
=cut
+###############################################################################
+
+=head2 Misc PMC related ops
+
+=over 4
+
+=cut
+
+########################################
+
+=item B<register>(in PMC)
+
+Add a reference of PMC $1 to the interpreters root set of PMCs. This is needed
+for extensions to make sure, that the PMC is properly marked during DOD, if
+that PMC is not known to Parrots core elsewhere.
+
+A PMC can be registered multiple times, if its unregistered and the
+registration count reaches zero, it will be destroyed during the next DOD run.
+
+=item B<unregister>(in PMC)
+
+Remove one reference of $1.
+
+=cut
+
+op register(in PMC) {
+ dod_register_pmc(interpreter, $1);
+ goto NEXT();
+}
+
+op unregister(in PMC) {
+ dod_unregister_pmc(interpreter, $1);
+ goto NEXT();
+}
+
+=back
+
+
=head1 COPYRIGHT
Copyright (C) 2001-2003 The Perl Foundation. All rights reserved.
1.77 +5 -1 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -w -r1.76 -r1.77
--- dod.c 24 Nov 2003 05:47:40 -0000 1.76
+++ dod.c 31 Dec 2003 11:54:41 -0000 1.77
@@ -1,7 +1,7 @@
/* dod.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.c,v 1.76 2003/11/24 05:47:40 mrjoltcola Exp $
+ * $Id: dod.c,v 1.77 2003/12/31 11:54:41 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -157,6 +157,10 @@
/* Now mark the class hash */
pobject_lives(interpreter, (PObj *)interpreter->class_hash);
+
+ /* Mark the registry if any */
+ if (interpreter->DOD_registry)
+ pobject_lives(interpreter, (PObj *)interpreter->DOD_registry);
/* Now walk the pmc stack. Make sure to walk from top down since stack may
* have segments above top that we shouldn't walk. */
1.16 +30 -1 parrot/src/extend.c
Index: extend.c
===================================================================
RCS file: /cvs/public/parrot/src/extend.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- extend.c 10 Dec 2003 17:14:44 -0000 1.15
+++ extend.c 31 Dec 2003 11:54:41 -0000 1.16
@@ -1,7 +1,7 @@
/* extend.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: extend.c,v 1.15 2003/12/10 17:14:44 dan Exp $
+ * $Id: extend.c,v 1.16 2003/12/31 11:54:41 leo Exp $
* Overview:
* The Parrot extension interface. These are the functions that
* parrot extensions (i.e. parrot subroutines written in C, or
@@ -339,6 +339,35 @@
Parrot_Const_CharType Parrot_find_chartype(Parrot_INTERP interpreter, char
*chartype) {
return Parrot_chartype_lookup(chartype);
}
+
+/*=for api extend Parrot_register_pmc
+ *
+ * Add a reference of the PMC to the interpreters DOD registry.
+ * This prevents PMCs only known to extension from getting destroyed
+ * during DOD runs.
+ *
+ */
+
+void
+Parrot_register_pmc(Parrot_INTERP interpreter, Parrot_PMC pmc)
+{
+ dod_register_pmc(interpreter, pmc);
+}
+
+/*=for api extend Parrot_unregister_pmc
+ *
+ * Remove a reference of the PMC from the interpreters DOD registry
+ * If the register count reaches zero, the PMC will be destroyed during
+ * the next DOD run.
+ *
+ */
+
+void
+Parrot_unregister_pmc(Parrot_INTERP interpreter, Parrot_PMC pmc)
+{
+ dod_unregister_pmc(interpreter, pmc);
+}
+
/*
* Local variables:
* c-indentation-style: bsd
1.251 +4 -1 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.250
retrieving revision 1.251
diff -u -w -r1.250 -r1.251
--- interpreter.c 27 Dec 2003 14:44:29 -0000 1.250
+++ interpreter.c 31 Dec 2003 11:54:41 -0000 1.251
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.250 2003/12/27 14:44:29 leo Exp $
+ * $Id: interpreter.c,v 1.251 2003/12/31 11:54:41 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -1055,6 +1055,9 @@
SET_NULL_P(interpreter->prederef.code, void **);
SET_NULL_P(interpreter->prederef.branches, Prederef_btanch*);
SET_NULL(interpreter->jit_info);
+
+ /* null out the root set registry */
+ SET_NULL_P(interpreter->DOD_registry, PMC *);
/* register assembler/compilers */
setup_default_compreg(interpreter);
1.60 +62 -1 parrot/src/pmc.c
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc.c,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -w -r1.59 -r1.60
--- pmc.c 10 Dec 2003 17:18:35 -0000 1.59
+++ pmc.c 31 Dec 2003 11:54:41 -0000 1.60
@@ -1,7 +1,7 @@
/* pmc.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc.c,v 1.59 2003/12/10 17:18:35 leo Exp $
+ * $Id: pmc.c,v 1.60 2003/12/31 11:54:41 leo Exp $
* Overview:
* The base vtable calling functions.
* Data Structure and Algorithms:
@@ -539,6 +539,67 @@
}
+
+static size_t
+key_hash_int(Interp *interp, Hash *hash, void *value)
+{
+ UNUSED(interp);
+ UNUSED(hash);
+ return (size_t) value;
+}
+
+static int
+int_compare(Parrot_Interp interp, void *a, void *b)
+{
+ UNUSED(interp);
+ return a != b;
+}
+/*
+ * DOD registry interface
+ */
+void
+dod_register_pmc(Parrot_Interp interpreter, PMC* pmc)
+{
+ Hash *hash;
+ HashBucket *bucket;
+
+ if (!interpreter->DOD_registry) {
+ PMC *registry;
+ registry = interpreter->DOD_registry = pmc_new_noinit(interpreter,
+ enum_class_PerlHash);
+ new_hash_x(interpreter, &hash, enum_type_int, 0, Hash_key_type_int,
+ int_compare, key_hash_int, pobject_lives);
+ PObj_custom_mark_SET(registry);
+ PMC_ptr1v(registry) = hash;
+ }
+ else
+ hash = PMC_ptr1v(interpreter->DOD_registry);
+
+ bucket = hash_get_bucket(interpreter, hash, pmc);
+ if (bucket)
+ LVALUE_CAST(int, bucket->value) ++;
+ else
+ hash_put(interpreter, hash, pmc, (void *) 1);
+}
+
+void
+dod_unregister_pmc(Parrot_Interp interpreter, PMC* pmc)
+{
+ Hash *hash;
+ HashBucket *bucket;
+
+ if (!interpreter->DOD_registry)
+ return; /* XXX or signal exception? */
+ hash = PMC_ptr1v(interpreter->DOD_registry);
+
+ bucket = hash_get_bucket(interpreter, hash, pmc);
+ if (bucket) {
+ if ((int) bucket->value == 1)
+ hash_delete(interpreter, hash, pmc);
+ else
+ LVALUE_CAST(int, bucket->value) --;
+ }
+}
/*
* Local variables:
