cvsuser 05/03/09 12:31:29
Modified: config/gen core_pmcs.pl
include/parrot pmc.h
lib/Parrot Pmc2c.pm
ops ops.num pmc.ops
src global_setup.c pmc.c
t/pmc pmc.t
Log:
Objects 2 - create mro for PMCs
* mro list for core PMCs
It's remarkably easy to get PMC bootstrapping wrong,
if you want to register PMCs in a hash or create an
mro array, while initializing these PMCS :)
Revision Changes Path
1.19 +10 -4 parrot/config/gen/core_pmcs.pl
Index: core_pmcs.pl
===================================================================
RCS file: /cvs/public/parrot/config/gen/core_pmcs.pl,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- core_pmcs.pl 8 Mar 2005 22:52:07 -0000 1.18
+++ core_pmcs.pl 9 Mar 2005 20:31:25 -0000 1.19
@@ -1,5 +1,5 @@
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: core_pmcs.pl,v 1.18 2005/03/08 22:52:07 bernhard Exp $
+# $Id: core_pmcs.pl,v 1.19 2005/03/09 20:31:25 leo Exp $
=head1 NAME
@@ -83,6 +83,7 @@
print OUT <<"END";
+static void Parrot_register_core_pmcs(Interp *interp, PMC* registry);
extern void Parrot_initialize_core_pmcs(Interp *interp);
void Parrot_initialize_core_pmcs(Interp *interp)
{
@@ -99,11 +100,16 @@
foreach (@pmcs[0..$#pmcs-1]);
print OUT <<"END";
if (!pass) {
+ PMC *classname_hash;
/* Need an empty stash */
interp->globals = mem_sys_allocate(sizeof(struct Stash));
interp->globals->stash_hash =
- pmc_new(interp, enum_class_PerlHash);
+ pmc_new(interp, enum_class_Hash);
interp->globals->parent_stash = NULL;
+ /* We need a class hash */
+ interp->class_hash = classname_hash =
+ pmc_new(interp, enum_class_Hash);
+ Parrot_register_core_pmcs(interp, classname_hash);
}
}
}
@@ -114,8 +120,8 @@
VTABLE_set_integer_keyed_str(interp, registry, key, pmc_id);
}
-extern void Parrot_register_core_pmcs(Interp *interp, PMC* registry);
-void Parrot_register_core_pmcs(Interp *interp, PMC* registry)
+static void
+Parrot_register_core_pmcs(Interp *interp, PMC* registry)
{
END
1.70 +7 -4 parrot/include/parrot/pmc.h
Index: pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- pmc.h 18 Oct 2004 01:35:25 -0000 1.69
+++ pmc.h 9 Mar 2005 20:31:25 -0000 1.70
@@ -1,7 +1,7 @@
/* pmc.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc.h,v 1.69 2004/10/18 01:35:25 brentdax Exp $
+ * $Id: pmc.h,v 1.70 2005/03/09 20:31:25 leo Exp $
* Overview:
* This is the api header for the pmc subsystem
* Data Structure and Algorithms:
@@ -42,11 +42,14 @@
/*
* DOD registry interface
*/
-void dod_register_pmc(Parrot_Interp, PMC*);
-void dod_unregister_pmc(Parrot_Interp, PMC*);
+void dod_register_pmc(Interp *, PMC*);
+void dod_unregister_pmc(Interp *, PMC*);
/* multi method fallbacks */
-void register_fallback_methods(Parrot_Interp);
+void register_fallback_methods(Interp *);
+
+/* mro creation */
+void Parrot_create_mro(Interp *, INTVAL);
#endif /* PARROT_PMC_H_GUARD */
1.63 +4 -1 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -r1.62 -r1.63
--- Pmc2c.pm 9 Mar 2005 14:52:00 -0000 1.62
+++ Pmc2c.pm 9 Mar 2005 20:31:26 -0000 1.63
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Pmc2c.pm,v 1.62 2005/03/09 14:52:00 leo Exp $
+# $Id: Pmc2c.pm,v 1.63 2005/03/09 20:31:26 leo Exp $
=head1 NAME
@@ -886,6 +886,9 @@
int my_enum_class_$dynclass = Parrot_PMC_typenum(interp,
"$dynclass");
EOC
}
+ $cout .= <<"EOC";
+ Parrot_create_mro(interp, entry);
+EOC
# init MMD "right" slots with the dynpmc types
foreach my $entry (@init_mmds) {
if ($entry->[1] eq $classname) {
1.62 +1 -0 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- ops.num 2 Mar 2005 13:47:29 -0000 1.61
+++ ops.num 9 Mar 2005 20:31:27 -0000 1.62
@@ -1430,3 +1430,4 @@
trans_charset_s_sc_ic 1400
bytelength_i_s 1401
bytelength_i_sc 1402
+get_mro_p_p 1403
1.35 +12 -0 parrot/ops/pmc.ops
Index: pmc.ops
===================================================================
RCS file: /cvs/public/parrot/ops/pmc.ops,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- pmc.ops 17 Dec 2004 09:58:16 -0000 1.34
+++ pmc.ops 9 Mar 2005 20:31:27 -0000 1.35
@@ -667,6 +667,18 @@
goto NEXT();
}
+=item B<get_mro>(out PMC, in PMC)
+
+Set $1 to the mro array of the PMC $2. Please note that this is a
+direct reference so messing with it can do harm to the method lookup.
+
+=cut
+
+op get_mro(out PMC, in PMC) {
+ $1 = $2->vtable->mro;
+ goto NEXT();
+}
+
=back
1.58 +1 -11 parrot/src/global_setup.c
Index: global_setup.c
===================================================================
RCS file: /cvs/public/parrot/src/global_setup.c,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- global_setup.c 27 Feb 2005 09:58:47 -0000 1.57
+++ global_setup.c 9 Mar 2005 20:31:28 -0000 1.58
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: global_setup.c,v 1.57 2005/02/27 09:58:47 leo Exp $
+$Id: global_setup.c,v 1.58 2005/03/09 20:31:28 leo Exp $
=head1 NAME
@@ -26,7 +26,6 @@
/* These functions are defined in the auto-generated file core_pmcs.c */
extern void Parrot_initialize_core_pmcs(Interp *interp);
-extern void Parrot_register_core_pmcs(Interp *interp, PMC *registry);
/*
@@ -71,15 +70,6 @@
/* Call base vtable class constructor methods */
Parrot_initialize_core_pmcs(interpreter);
- /* Now register the names of the PMCs */
-
- /* We need a class hash */
- interpreter->class_hash = classname_hash =
- pmc_new(interpreter, enum_class_Hash);
-
- /* Now fill the hash */
- Parrot_register_core_pmcs(interpreter, classname_hash);
-
/* init the interpreter globals array */
iglobals = pmc_new(interpreter, enum_class_SArray);
interpreter->iglobals = iglobals;
1.96 +45 -12 parrot/src/pmc.c
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc.c,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -r1.95 -r1.96
--- pmc.c 9 Mar 2005 14:52:01 -0000 1.95
+++ pmc.c 9 Mar 2005 20:31:28 -0000 1.96
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc.c,v 1.95 2005/03/09 14:52:01 leo Exp $
+$Id: pmc.c,v 1.96 2005/03/09 20:31:28 leo Exp $
=head1 NAME
@@ -376,10 +376,11 @@
Parrot_base_vtables = new_vtable_table;
class_table_size = new_max;
}
-
+ /* set entry in name->type hash */
VTABLE_set_integer_keyed_str(interp, classname_hash, name, type);
UNLOCK(class_count_mutex);
+
return type;
}
@@ -420,6 +421,48 @@
void
+Parrot_create_mro(Interp *interpreter, INTVAL type)
+{
+ VTABLE *vtable;
+ STRING *class_name;
+ INTVAL pos, len, parent_type;
+ PMC *class, *mro;
+
+ vtable = Parrot_base_vtables[type];
+ mro = pmc_new(interpreter, enum_class_ResizablePMCArray);
+ vtable->mro = mro;
+ class_name = vtable->whoami;
+ for (pos = 0; ;) {
+ len = string_length(interpreter, class_name);
+ pos += len + 1;
+ parent_type = pmc_type(interpreter, class_name);
+ if (!parent_type) /* abstract classes don't have a vtable */
+ break;
+ class = Parrot_base_vtables[parent_type]->class;
+ if (!class) {
+ /*
+ * class interface - a PMC is it's own class
+ * put an instance of this PMC into class
+ */
+ class = get_new_pmc_header(interpreter, parent_type,
+ PObj_constant_FLAG);
+ Parrot_base_vtables[parent_type]->class = class;
+ PMC_pmc_val(class) = (void*)0xdeadbeef;
+ PMC_struct_val(class)= (void*)0xdeadbeef;
+ }
+ VTABLE_push_pmc(interpreter, mro, class);
+ if (pos >= (INTVAL)string_length(interpreter, vtable->isa_str))
+ break;
+ len = string_str_index(interpreter, vtable->isa_str,
+ CONST_STRING(interpreter, " "), pos);
+ if (len == -1)
+ break;
+ class_name = string_substr(interpreter, vtable->isa_str, pos,
+ len - pos, NULL, 0);
+ }
+}
+
+void
Parrot_mmd_register_parents(Interp* interpreter, INTVAL type,
const MMD_init *mmd_table, INTVAL n)
{
@@ -430,16 +473,6 @@
PMC *class;
UINTVAL func_nr;
/*
- * class interface - a PMC is it's own class
- * XXX use a separate vtable entry?
- *
- * put an instance of this PMC into data
- */
- class = get_new_pmc_header(interpreter, type, PObj_constant_FLAG);
- vtable->class = class;
- PMC_pmc_val(class) = (void*)0xdeadbeef;
- PMC_struct_val(class)= (void*)0xdeadbeef;
- /*
* register default mmds for this type
*/
for (i = 0; i < n; ++i) {
1.101 +21 -2 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.100
retrieving revision 1.101
diff -u -r1.100 -r1.101
--- pmc.t 2 Jan 2005 11:34:56 -0000 1.100
+++ pmc.t 9 Mar 2005 20:31:29 -0000 1.101
@@ -1,7 +1,7 @@
#! perl -w
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.100 2005/01/02 11:34:56 leo Exp $
+# $Id: pmc.t,v 1.101 2005/03/09 20:31:29 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 97;
+use Parrot::Test tests => 98;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -2652,5 +2652,24 @@
ok 3
OUT
+output_is(<<'CODE', <<'OUT', "get_mro");
+ new P0, .PerlInt
+ get_mro P1, P0
+ print "ok 1\n"
+ elements I1, P1
+ null I0
+loop:
+ set P2, P1[I0]
+ classname S0, P2
+ print S0
+ print "\n"
+ inc I0
+ lt I0, I1, loop
+ end
+CODE
+ok 1
+PerlInt
+Integer
+OUT
1;
