classes/*.c is created by the bytecode compiler classes/pmc2c2.pl. Most of the actual code is in lib/Parrot/Pmc2c.pm.
The created C code could need some improvements:
* the temp_base_vtable should be const.
This is currently not possible, because items like ".whoami" are changed in the temp_base_vtable. But we don't have to do that, as the vtable is cloned a few lines below anyway. So we should create a const table and do the rest of the init stuff in the cloned table.
* same with the MMD init table.
* All constant strings in classes (whoami, isa_str, does_str) and method names in the delegate.c should use the CONST_STRING() macro. That would need some Makefile tweaks too, to add a dependency on the .str file.
Note: foo = CONST_STRING(interpreter, "foo"); should always be on it's own line and not inside a multiline expression.
Patch attached.
Note: previously base_type for dynclasses was set twice in dynclasses. I'm not clear why this was done. If this is important, this will need to be restored; but without it dynclasses/dynfoo.pasm passes anyway.
- Sam Ruby
Index: config/gen/makefiles/root.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/root.in,v
retrieving revision 1.254
diff -u -r1.254 root.in
--- config/gen/makefiles/root.in 12 Oct 2004 09:00:16 -0000 1.254
+++ config/gen/makefiles/root.in 1 Nov 2004 03:14:25 -0000
@@ -279,6 +279,8 @@
CLASS_O_FILES = ${TEMP_pmc_classes_o}
+CLASS_STR_FILES = ${TEMP_pmc_classes_str}
+
ENCODING_O_FILES = \
encodings/utf8$(O)
@@ -478,7 +480,7 @@
$(SRC)/pmc.str \
$(SRC)/py_func.str \
$(SRC)/objects.str \
- classes/delegate.str
+ $(CLASS_STR_FILES)
$(INC)/string_private_cstring.h : $(STR_FILES) build_tools/c2str.pl
$(PERL) build_tools/c2str.pl --all
Index: config/inter/pmc.pl
===================================================================
RCS file: /cvs/public/parrot/config/inter/pmc.pl,v
retrieving revision 1.17
diff -u -r1.17 pmc.pl
--- config/inter/pmc.pl 9 May 2004 14:58:09 -0000 1.17
+++ config/inter/pmc.pl 1 Nov 2004 03:14:25 -0000
@@ -114,6 +114,7 @@
# names of class files for classes/Makefile
(my $TEMP_pmc_o = $pmc_list) =~ s/\.pmc/\$(O)/g;
+ (my $TEMP_pmc_str = $pmc_list) =~ s/\.pmc/\.str/g;
# calls to pmc2c.pl for classes/Makefile
my $TEMP_pmc_build = <<"E_NOTE";
@@ -145,7 +146,7 @@
classes/pmc_$pmc.h: classes/$pmc.pmc
\$(PMC2CC) classes/$pmc.pmc
-classes/$pmc\$(O): \$(NONGEN_HEADERS) \\
+classes/$pmc\$(O): classes/$pmc.str \$(NONGEN_HEADERS) \\
$parent_headers
END
@@ -155,6 +156,7 @@
# build list of libraries for link line in Makefile
my $slash = Configure::Data->get('slash');
(my $TEMP_pmc_classes_o = $TEMP_pmc_o ) =~ s/^| / classes${slash}/g;
+ (my $TEMP_pmc_classes_str = $TEMP_pmc_str ) =~ s/^| / classes${slash}/g;
(my $TEMP_pmc_classes_pmc = $pmc_list) =~ s/^| / classes${slash}/g;
# Gather the actual names (with MixedCase) of all of the
@@ -191,6 +193,7 @@
TEMP_pmc_o => $TEMP_pmc_o,
TEMP_pmc_build => $TEMP_pmc_build,
TEMP_pmc_classes_o => $TEMP_pmc_classes_o,
+ TEMP_pmc_classes_str => $TEMP_pmc_classes_str,
TEMP_pmc_classes_pmc => $TEMP_pmc_classes_pmc,
);
}
Index: include/parrot/vtables.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/vtables.h,v
retrieving revision 1.5
diff -u -r1.5 vtables.h
--- include/parrot/vtables.h 22 Apr 2004 08:55:06 -0000 1.5
+++ include/parrot/vtables.h 1 Nov 2004 03:14:26 -0000
@@ -14,7 +14,7 @@
#define PARROT_VTABLES_H_GUARD
VTABLE *Parrot_new_vtable(Parrot_Interp);
-VTABLE *Parrot_clone_vtable(Parrot_Interp, VTABLE *base_vtable);
+VTABLE *Parrot_clone_vtable(Parrot_Interp, const VTABLE *base_vtable);
void Parrot_destroy_vtable(Parrot_Interp, VTABLE *vtable);
void Parrot_vtable_set_type(Parrot_Interp, VTABLE *, INTVAL);
Index: lib/Parrot/Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.47
diff -u -r1.47 Pmc2c.pm
--- lib/Parrot/Pmc2c.pm 28 Oct 2004 11:24:37 -0000 1.47
+++ lib/Parrot/Pmc2c.pm 1 Nov 2004 03:14:26 -0000
@@ -378,6 +378,12 @@
#include "pmc_$name.h"
EOC
}
+ if (!$self->{flags}{dynpmc}) {
+ my $name = lc $self->{class};
+ $cout .= <<"EOC";
+#include "$name.str"
+EOC
+ }
"$cout\n";
}
@@ -714,7 +720,7 @@
void
Parrot_${classname}_class_init(Parrot_Interp interp, int entry, int pass)
{
- struct _vtable temp_base_vtable = {
+ const struct _vtable temp_base_vtable = {
NULL, /* package */
$enum_name, /* base_type */
NULL, /* whoami */
@@ -728,7 +734,7 @@
$cout .= <<"EOC";
- MMD_init _temp_mmd_init[] = {
+ const MMD_init _temp_mmd_init[] = {
$mmd_list
};
/* Dynamic classes need the runtime type
@@ -742,13 +748,6 @@
int my_enum_class_$dynclass = Parrot_PMC_typenum(interp, "$dynclass");
EOC
}
- # init vtable slot
- if ($self->{flags}{dynpmc}) {
- $cout .= <<"EOC";
-
- temp_base_vtable.base_type = entry;
-EOC
- }
# init MMD "right" slots with the dynpmc types
foreach my $entry (@init_mmds) {
if ($entry->[1] eq $classname) {
@@ -772,29 +771,39 @@
$cout .= <<"EOC";
if (pass == 0) {
EOC
- # init vtable slot
- if ($self->{flags}{dynpmc}) {
- $cout .= <<"EOC";
- temp_base_vtable.base_type = entry;
-EOC
- }
$cout .= <<"EOC";
/*
* Parrot_base_vtables is a true global - register just once
*/
if (!Parrot_base_vtables[entry]) {
- temp_base_vtable.whoami = string_make(interp,
+ struct _vtable *clone =
+ Parrot_clone_vtable(interp, &temp_base_vtable);
+
+EOC
+ # init vtable slot
+ if ($self->{flags}{dynpmc}) {
+ $cout .= <<"EOC";
+ clone->base_type = entry;
+ clone->whoami = string_make(interp,
"$classname", @{[length($classname)]}, "iso-8859-1",
PObj_constant_FLAG|PObj_external_FLAG);
- temp_base_vtable.isa_str = string_make(interp,
+ clone->isa_str = string_make(interp,
"$isa", @{[length($isa)]}, "iso-8859-1",
PObj_constant_FLAG|PObj_external_FLAG);
- temp_base_vtable.does_str = string_make(interp,
+ clone->does_str = string_make(interp,
"$does", @{[length($does)]}, "iso-8859-1",
PObj_constant_FLAG|PObj_external_FLAG);
-
- Parrot_base_vtables[entry] =
- Parrot_clone_vtable(interp, &temp_base_vtable);
+EOC
+ }
+ else {
+ $cout .= <<"EOC";
+ clone->whoami = CONST_STRING(interp, "$classname");
+ clone->isa_str = CONST_STRING(interp, "$isa");
+ clone->does_str = CONST_STRING(interp, "$does");
+EOC
+ }
+ $cout .= <<"EOC";
+ Parrot_base_vtables[entry] = clone;
}
EOC
$cout .= <<"EOC";
Index: src/vtables.c
===================================================================
RCS file: /cvs/public/parrot/src/vtables.c,v
retrieving revision 1.6
diff -u -r1.6 vtables.c
--- src/vtables.c 28 Jan 2004 23:55:24 -0000 1.6
+++ src/vtables.c 1 Nov 2004 03:14:26 -0000
@@ -37,7 +37,7 @@
/*
=item C<VTABLE *
-Parrot_clone_vtable(Parrot_Interp interpreter, VTABLE *base_vtable)>
+Parrot_clone_vtable(Parrot_Interp interpreter, const VTABLE *base_vtable)>
Clones C<*base_vtable> and returns a pointer to the new C<VTABLE>.
@@ -46,7 +46,7 @@
*/
VTABLE *
-Parrot_clone_vtable(Parrot_Interp interpreter, VTABLE *base_vtable) {
+Parrot_clone_vtable(Parrot_Interp interpreter, const VTABLE *base_vtable) {
VTABLE *new_vtable = mem_sys_allocate(sizeof(VTABLE));
if (new_vtable) {
memcpy(new_vtable, base_vtable, sizeof(VTABLE));
