[svn:parrot] r38471 - in trunk: . config/auto config/auto/sizes config/gen docs/book docs/book/draft docs/dev examples/languages/abc examples/languages/squaak include/parrot lib/Parrot/Pmc2c lib/Parrot/Pmc2c/PMC ports/cpan ports/cygwin ports/debian ports/fedora ports/mandriva ports/suse runtime/parrot/library/Math src/call src/gc src/interp src/pmc src/runcore t/compilers/tge t/dynpmc t/pmc t/src tools/dev tools/util
cotto at svn.parrot.org
cotto at svn.parrot.org
Mon May 4 22:47:16 UTC 2009
Author: cotto
Date: Mon May 4 22:47:15 2009
New Revision: 38471
URL: https://trac.parrot.org/parrot/changeset/38471
Log:
[pmc2c] merge the tt528_vtinit branch back into trunk
Modified:
trunk/ (props changed)
trunk/config/auto/pmc.pm
trunk/config/auto/sizes/intval_maxmin_c.in (props changed)
trunk/config/gen/core_pmcs.pm
trunk/docs/book/appb_patch_submission.pod (props changed)
trunk/docs/book/ch01_introduction.pod (props changed)
trunk/docs/book/ch03_pir.pod (props changed)
trunk/docs/book/ch04_compiler_tools.pod (props changed)
trunk/docs/book/ch07_dynpmcs.pod (props changed)
trunk/docs/book/ch08_dynops.pod (props changed)
trunk/docs/book/ch09_pasm.pod (props changed)
trunk/docs/book/ch10_opcode_reference.pod (props changed)
trunk/docs/book/draft/chXX_hlls.pod (props changed)
trunk/docs/book/draft/chXX_library.pod (props changed)
trunk/docs/book/draft/chXX_testing_and_debugging.pod (props changed)
trunk/docs/dev/c_functions.pod (props changed)
trunk/examples/languages/abc/ (props changed)
trunk/examples/languages/squaak/ (props changed)
trunk/include/parrot/call.h (props changed)
trunk/include/parrot/gc_api.h (props changed)
trunk/include/parrot/gc_mark_sweep.h (props changed)
trunk/include/parrot/gc_pools.h (props changed)
trunk/include/parrot/runcore_api.h (props changed)
trunk/include/parrot/runcore_trace.h (props changed)
trunk/lib/Parrot/Pmc2c/MethodEmitter.pm
trunk/lib/Parrot/Pmc2c/PMC/RO.pm
trunk/lib/Parrot/Pmc2c/PMC/default.pm
trunk/lib/Parrot/Pmc2c/PMCEmitter.pm
trunk/ports/cpan/pause_guide.pod (props changed)
trunk/ports/cygwin/parrot-1.0.0-1.cygport (props changed)
trunk/ports/debian/libparrot-dev.install.in (props changed)
trunk/ports/debian/libparrot.install.in (props changed)
trunk/ports/debian/parrot-doc.install.in (props changed)
trunk/ports/debian/parrot.install.in (props changed)
trunk/ports/fedora/parrot.spec.fedora (props changed)
trunk/ports/mandriva/parrot.spec.mandriva (props changed)
trunk/ports/suse/parrot.spec.suse (props changed)
trunk/runtime/parrot/library/Math/Rand.pir (props changed)
trunk/src/call/ops.c (props changed)
trunk/src/call/pcc.c (props changed)
trunk/src/gc/api.c (props changed)
trunk/src/gc/generational_ms.c (props changed)
trunk/src/gc/incremental_ms.c (props changed)
trunk/src/gc/mark_sweep.c (props changed)
trunk/src/gc/pools.c (props changed)
trunk/src/gc/system.c (props changed)
trunk/src/interp/inter_cb.c (props changed)
trunk/src/interp/inter_create.c (props changed)
trunk/src/interp/inter_misc.c (props changed)
trunk/src/pmc/default.pmc
trunk/src/runcore/cores.c (props changed)
trunk/src/runcore/main.c (props changed)
trunk/src/runcore/trace.c (props changed)
trunk/t/compilers/tge/NoneGrammar.tg (props changed)
trunk/t/dynpmc/pair.t (props changed)
trunk/t/pmc/pmc.t
trunk/t/src/embed.t (props changed)
trunk/tools/dev/fetch_languages.pl (props changed)
trunk/tools/dev/mk_gitignore.pl (props changed)
trunk/tools/util/perlcritic-cage.conf (props changed)
Modified: trunk/config/auto/pmc.pm
==============================================================================
--- trunk/config/auto/pmc.pm Mon May 4 22:40:07 2009 (r38470)
+++ trunk/config/auto/pmc.pm Mon May 4 22:47:15 2009 (r38471)
@@ -162,7 +162,7 @@
unless defined $name;
}
- my @names = $self->order_pmcs_by_hierarchy( \%parents );
+ my @names = ('default', $self->order_pmcs_by_hierarchy( \%parents ));
$conf->data->set(
pmc => $pmc_list,
Modified: trunk/config/gen/core_pmcs.pm
==============================================================================
--- trunk/config/gen/core_pmcs.pm Mon May 4 22:40:07 2009 (r38470)
+++ trunk/config/gen/core_pmcs.pm Mon May 4 22:47:15 2009 (r38471)
@@ -61,8 +61,7 @@
END_H
my @pmcs = split( / /, $conf->data->get('pmc_names') );
- print {$OUT} " enum_class_default,\n";
- my $i = 1;
+ my $i = 0;
foreach (@pmcs) {
print {$OUT} " enum_class_$_,\t/* $i */\n";
$i++;
Modified: trunk/lib/Parrot/Pmc2c/MethodEmitter.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/MethodEmitter.pm Mon May 4 22:40:07 2009 (r38470)
+++ trunk/lib/Parrot/Pmc2c/MethodEmitter.pm Mon May 4 22:47:15 2009 (r38471)
@@ -47,7 +47,7 @@
$self->rewrite_nci_method($pmc);
}
- $emit->( $pmc->export . ' ' . $self->decl( $pmc, 'CFILE' ) );
+ $emit->( $self->decl( $pmc, 'CFILE' ) );
$emit->("{\n");
$emit->($body);
$emit->("}\n");
@@ -98,14 +98,12 @@
$args = ", $args" if $args =~ /\S/;
$args =~ s/(\w+)\s*(\*)\s*/$1 $2/g;
- my ( $export, $extern, $newl, $semi );
+ my ( $extern, $newl, $semi );
if ( $for_header eq 'HEADER' ) {
- $export = $pmc->export;
$newl = ' ';
$semi = ';';
}
else {
- $export = '';
$newl = "\n";
$semi = '';
}
@@ -113,7 +111,7 @@
$pmcarg = "SHIM($pmcarg)" if $self->pmc_unused;
return <<"EOC";
-$decs$export $ret${newl}Parrot_${pmcname}_$meth(PARROT_INTERP, $pmcarg$args)$semi
+$decs $ret${newl}Parrot_${pmcname}_$meth(PARROT_INTERP, $pmcarg$args)$semi
EOC
}
@@ -250,7 +248,7 @@
\bDYNSUPER\b # Macro: DYNSUPER
\(\s*(.*?)\) # capture argument list
}x,
- sub { "interp->vtables[$supertype].$name(" . full_arguments($1) . ')' }
+ sub { "interp->vtables[$supertype]->$name(" . full_arguments($1) . ')' }
);
# Rewrite OtherClass.SUPER(args...)
@@ -260,7 +258,7 @@
\.SUPER\b # Macro: SUPER
\(\s*(.*?)\) # capture argument list
}x,
- sub { "Parrot_${1}_$name(" . full_arguments($2) . ')' }
+ sub { "interp->vtables[enum_class_${1}]->$name(" . full_arguments($2) . ')' }
);
# Rewrite SUPER(args...)
@@ -269,7 +267,7 @@
\bSUPER\b # Macro: SUPER
\(\s*(.*?)\) # capture argument list
}x,
- sub { "$supermethod(" . full_arguments($1) . ')' }
+ sub { "interp->vtables[$supertype]->$name(" . full_arguments($1) . ')' }
);
}
Modified: trunk/lib/Parrot/Pmc2c/PMC/RO.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PMC/RO.pm Mon May 4 22:40:07 2009 (r38470)
+++ trunk/lib/Parrot/Pmc2c/PMC/RO.pm Mon May 4 22:47:15 2009 (r38471)
@@ -82,7 +82,8 @@
else {
$find_method_parent = $parent->{super}{$vt_method_name};
}
- my $real_findmethod = 'Parrot_' . $find_method_parent . '_find_method';
+ # We can't use enum_class_Foo there. $parent can be non-core PMC.
+ my $real_findmethod = 'interp->vtables[pmc_type(interp, Parrot_str_new_constant(interp, "' . $find_method_parent . '"))]->find_method';
my $body = <<"EOC";
PMC *const method = $real_findmethod(interp, pmc, method_name);
if (!PMC_IS_NULL(VTABLE_getprop(interp, method, CONST_STRING_GEN(interp, "write"))))
Modified: trunk/lib/Parrot/Pmc2c/PMC/default.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PMC/default.pm Mon May 4 22:40:07 2009 (r38470)
+++ trunk/lib/Parrot/Pmc2c/PMC/default.pm Mon May 4 22:47:15 2009 (r38471)
@@ -49,6 +49,34 @@
return 1;
}
+sub update_vtable_func {
+ "";
+}
+
+# Really build default vtable.
+sub get_vtable_func {
+ my ($self) = @_;
+
+ my $cout = "";
+
+ my $vtable_decl = $self->vtable_decl("temp_vtable", '""');
+
+ $cout .= <<"EOC";
+
+PARROT_EXPORT VTABLE* Parrot_default_get_vtable(PARROT_INTERP) {
+
+ static const char attr_defs [] = "";
+
+$vtable_decl
+
+ return Parrot_clone_vtable(interp, &temp_vtable);
+}
+
+EOC
+
+ $cout;
+}
+
1;
# Local Variables:
Modified: trunk/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PMCEmitter.pm Mon May 4 22:40:07 2009 (r38470)
+++ trunk/lib/Parrot/Pmc2c/PMCEmitter.pm Mon May 4 22:47:15 2009 (r38471)
@@ -90,6 +90,8 @@
$c->emit("#include \"pmc_default.h\"\n");
+ $c->emit( $self->update_vtable_func );
+ $c->emit( $self->get_vtable_func );
$c->emit( $self->init_func );
$c->emit( $self->postamble );
@@ -103,9 +105,9 @@
=cut
sub generate_h_file {
- my ($self) = @_;
- my $h = $self->{emitter};
- my $name = uc $self->name;
+ my ($self) = @_;
+ my $h = $self->{emitter};
+ my $name = uc $self->name;
$h->emit( dont_edit( $self->filename ) );
$h->emit(<<"EOH");
@@ -139,7 +141,8 @@
my ($self) = @_;
my $hout;
- my $name = $self->name;
+ my $name = $self->name;
+ my $lc_name = $self->name;
# generate decls for all vtable methods in this PMC
foreach my $vt_method_name ( @{ $self->vtable->names } ) {
@@ -155,9 +158,18 @@
$hout .= $method->generate_headers($self);
}
+ my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : '';
+
# class init decl
- $hout .= 'PARROT_DYNEXT_EXPORT ' if ( $self->is_dynamic );
- $hout .= "void Parrot_${name}_class_init(PARROT_INTERP, int, int);\n";
+ $hout .= "${export}void Parrot_${name}_class_init(PARROT_INTERP, int, int);\n";
+
+ $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT ';
+
+ $hout .= "${export}VTABLE* Parrot_${lc_name}_update_vtable(VTABLE*);\n"
+ unless $name eq 'default';
+
+ $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable(PARROT_INTERP);\n";
+
$self->{hdecls} .= $hout;
return $self->{hdecls};
@@ -401,17 +413,15 @@
return "Parrot_${implementor}_$vt_method_name";
}
-=item C<vtable_decl($name)>
+=item C<vtable_flags()>
-Returns the C code for the declaration of a vtable temporary named
-C<$name> with the functions for this class.
+Returns C code to produce a PMC's flags.
=cut
-sub vtable_decl {
- my ( $self, $temp_struct_name, $enum_name ) = @_;
+sub vtable_flags {
+ my ($self) = @_;
- # gen vtable flags
my $vtbl_flag = 0;
$vtbl_flag .= '|VTABLE_PMC_NEEDS_EXT' if $self->flag('need_ext');
$vtbl_flag .= '|VTABLE_PMC_IS_SINGLETON' if $self->flag('singleton');
@@ -419,6 +429,22 @@
$vtbl_flag .= '|VTABLE_IS_READONLY_FLAG' if $self->flag('is_ro');
$vtbl_flag .= '|VTABLE_HAS_READONLY_FLAG' if $self->flag('has_ro');
+ return $vtbl_flag;
+}
+
+=item C<vtable_decl($name)>
+
+Returns the C code for the declaration of a vtable temporary named
+C<$name> with the functions for this class.
+
+=cut
+
+sub vtable_decl {
+ my ( $self, $temp_struct_name, $enum_name ) = @_;
+
+ # gen vtable flags
+ my $vtbl_flag = $self->vtable_flags;
+
my @vt_methods;
foreach my $vt_method ( @{ $self->vtable->methods } ) {
next if $vt_method->is_mmd;
@@ -438,7 +464,7 @@
NULL, /* isa_hash */
NULL, /* class */
NULL, /* mro */
- attr_defs, /* attribute_defs */
+ NULL, /* attribute_defs */
NULL, /* ro_variant_vtable */
$methlist
};
@@ -461,7 +487,6 @@
my $classname = $self->name;
my $enum_name = $self->is_dynamic ? -1 : "enum_class_$classname";
- my $vtable_decl = $self->vtable_decl( 'temp_base_vtable', $enum_name );
my $multi_funcs = $self->find_multi_functions();
my $multi_list = join( ",\n ",
@@ -522,13 +547,6 @@
}
$cout .= "\";\n";
- $cout .= <<"EOC";
-$vtable_decl
-EOC
-
- for my $k ( keys %extra_vt ) {
- $cout .= $extra_vt{$k}->vtable_decl( "temp_${k}_vtable", $enum_name );
- }
my $const = ( $self->{flags}{dynpmc} ) ? " " : " const ";
if ( @$multi_funcs ) {
@@ -543,63 +561,74 @@
$cout .= <<"EOC";
if (pass == 0) {
EOC
+ for my $k ( keys %extra_vt ) {
+ $cout .= " VTABLE *vt_$k;\n";
+ }
+
+ my $flags = $self->vtable_flags;
$cout .= <<"EOC";
- Hash *isa_hash;
- /* create vtable - clone it - we have to set a few items */
- VTABLE * const vt_clone = Parrot_clone_vtable(interp,
- &temp_base_vtable);
+ Hash * isa_hash;
+ VTABLE * vt = Parrot_${classname}_get_vtable(interp);
+ vt->base_type = $enum_name;
+ vt->flags = $flags;
+ vt->attribute_defs = attr_defs;
+
EOC
for my $k ( keys %extra_vt ) {
+ my $k_flags = $self->$k->vtable_flags;
$cout .= <<"EOC";
- VTABLE * const vt_${k}_clone = Parrot_clone_vtable(interp,
- &temp_${k}_vtable);
+ vt_${k} = Parrot_${classname}_${k}_get_vtable(interp);
+ vt_${k}->base_type = $enum_name;
+ vt_${k}->flags = $k_flags;
+ vt_${k}->attribute_defs = attr_defs;
+
EOC
}
# init vtable slot
if ( $self->is_dynamic ) {
$cout .= <<"EOC";
- vt_clone->base_type = entry;
- vt_clone->whoami = string_make(interp, "$classname", @{[length($classname)]}, "ascii",
- PObj_constant_FLAG|PObj_external_FLAG);
- vt_clone->provides_str = Parrot_str_append(interp, vt_clone->provides_str,
+ vt->base_type = entry;
+ vt->whoami = string_make(interp, "$classname", @{[length($classname)]},
+ "ascii", PObj_constant_FLAG|PObj_external_FLAG);
+ vt->provides_str = Parrot_str_append(interp, vt->provides_str,
string_make(interp, " $provides", @{[length($provides) + 1]}, "ascii",
PObj_constant_FLAG|PObj_external_FLAG));
/* set up isa hash */
isa_hash = parrot_new_hash(interp);
- vt_clone->isa_hash = isa_hash;
+ vt->isa_hash = isa_hash;
EOC
}
else {
$cout .= <<"EOC";
- vt_clone->whoami = CONST_STRING_GEN(interp, "$classname");
- vt_clone->provides_str = CONST_STRING_GEN(interp, "$provides");
+ vt->whoami = CONST_STRING_GEN(interp, "$classname");
+ vt->provides_str = CONST_STRING_GEN(interp, "$provides");
/* set up isa hash */
- isa_hash = parrot_new_hash(interp);
- vt_clone->isa_hash = isa_hash;
+ isa_hash = parrot_new_hash(interp);
+ vt->isa_hash = isa_hash;
EOC
}
for my $k ( keys %extra_vt ) {
$cout .= <<"EOC";
- vt_${k}_clone->base_type = entry;
- vt_${k}_clone->whoami = vt_clone->whoami;
- vt_${k}_clone->provides_str = vt_clone->provides_str;
+ vt_${k}->base_type = entry;
+ vt_${k}->whoami = vt->whoami;
+ vt_${k}->provides_str = vt->provides_str;
EOC
}
- if ( $extra_vt{ro} ) {
+ for my $k ( keys %extra_vt ) {
$cout .= <<"EOC";
- vt_clone->ro_variant_vtable = vt_ro_clone;
- vt_ro_clone->ro_variant_vtable = vt_clone;
- vt_ro_clone->isa_hash = isa_hash;
+ vt->${k}_variant_vtable = vt_${k};
+ vt_${k}->${k}_variant_vtable = vt;
+ vt_${k}->isa_hash = isa_hash;
EOC
}
$cout .= <<"EOC";
- interp->vtables[entry] = vt_clone;
+ interp->vtables[entry] = vt;
EOC
for my $isa ($classname, @isa) {
@@ -638,13 +667,13 @@
$cout .= <<"EOC";
{
- PMC *mro = pmc_new(interp, enum_class_ResizableStringArray);
- VTABLE * const vt_clone = interp->vtables[entry];
+ PMC * mro = pmc_new(interp, enum_class_ResizableStringArray);
+ VTABLE * const vt = interp->vtables[entry];
- vt_clone->mro = mro;
+ vt->mro = mro;
- if (vt_clone->ro_variant_vtable)
- vt_clone->ro_variant_vtable->mro = mro;
+ if (vt->ro_variant_vtable)
+ vt->ro_variant_vtable->mro = mro;
EOC
@@ -657,7 +686,7 @@
$cout .= <<"EOC";
}
- /* setup MRO and _namespace */
+ /* set up MRO and _namespace */
Parrot_create_mro(interp, entry);
EOC
@@ -715,6 +744,7 @@
} /* pass */
} /* Parrot_${classname}_class_init */
EOC
+
if ( $self->is_dynamic ) {
$cout .= dynext_load_code( $classname, $classname => {} );
}
@@ -722,6 +752,121 @@
$cout;
}
+=item C<update_vtable_func()>
+
+Returns the C code for the PMC's update_vtable method.
+
+=cut
+
+sub update_vtable_func {
+ my ($self) = @_;
+
+ my $cout = "";
+ my $classname = $self->name;
+
+ my $vtable_updates = '';
+ for my $name ( @{ $self->vtable->names } ) {
+ if (exists $self->{has_method}{$name}) {
+ $vtable_updates .= " vt->$name = Parrot_${classname}_${name};\n";
+ }
+ }
+
+ $cout .= <<"EOC";
+
+PARROT_EXPORT VTABLE *Parrot_${classname}_update_vtable(VTABLE *vt) {
+$vtable_updates
+ return vt;
+}
+
+EOC
+
+ my %extra_vt;
+ $extra_vt{ro} = $self->{ro} if $self->{ro};
+
+ for my $k (keys %extra_vt) {
+
+ my $vtable_updates = '';
+ foreach my $vt_method ( @{ $self->$k->vtable->names} ) {
+
+ next unless ($self->$k->implements_vtable($vt_method));
+
+ $vtable_updates .= " vt->$vt_method = Parrot_${classname}_${k}_${vt_method};\n";
+ }
+
+ $cout .= <<"EOC";
+
+PARROT_EXPORT VTABLE *Parrot_${classname}_${k}_update_vtable(VTABLE *vt) {
+$vtable_updates
+ return vt;
+}
+
+EOC
+ }
+
+ $cout;
+}
+
+=item C<get_vtable_func()>
+
+Returns the C code for the PMC's update_vtable method.
+
+=cut
+
+sub get_vtable_func {
+ my ($self) = @_;
+
+ my $cout = "";
+ my $classname = $self->name;
+
+ my $get_vtable = '';
+ foreach my $parent_name ( reverse ($self->name, @{ $self->parents }) ) {
+ if ($parent_name eq 'default') {
+ $get_vtable .= " vt = Parrot_default_get_vtable(interp);\n";
+ }
+ else {
+ $get_vtable .= " Parrot_${parent_name}_update_vtable(vt);\n";
+ }
+ }
+
+ $cout .= <<"EOC";
+PARROT_EXPORT
+VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) {
+ VTABLE *vt;
+$get_vtable
+ return vt;
+}
+
+EOC
+
+ my %extra_vt;
+ $extra_vt{ro} = $self->{ro} if $self->{ro};
+
+ for my $k (keys %extra_vt) {
+ my $get_extra_vtable = '';
+ foreach my $parent_name ( reverse ($self->name, @{ $self->parents }) ) {
+ if ($parent_name eq 'default') {
+ $get_extra_vtable .= " vt = Parrot_default_get_vtable(interp);\n";
+ }
+ else {
+ $get_extra_vtable .= " Parrot_${parent_name}_update_vtable(vt);\n";
+ $get_extra_vtable .= " Parrot_${parent_name}_${k}_update_vtable(vt);\n";
+ }
+ }
+
+ $cout .= <<"EOC";
+PARROT_EXPORT
+VTABLE* Parrot_${classname}_${k}_get_vtable(PARROT_INTERP) {
+ VTABLE *vt;
+$get_extra_vtable
+ return vt;
+}
+
+EOC
+ }
+
+ $cout;
+}
+
sub is_vtable_method {
my ( $self, $vt_method_name ) = @_;
return 1 if $self->vtable->has_method($vt_method_name);
Modified: trunk/src/pmc/default.pmc
==============================================================================
--- trunk/src/pmc/default.pmc Mon May 4 22:40:07 2009 (r38470)
+++ trunk/src/pmc/default.pmc Mon May 4 22:47:15 2009 (r38471)
@@ -264,7 +264,7 @@
} while (1);
}
-pmclass default abstract no_init {
+pmclass default abstract {
/*
Modified: trunk/t/pmc/pmc.t
==============================================================================
--- trunk/t/pmc/pmc.t Mon May 4 22:40:07 2009 (r38470)
+++ trunk/t/pmc/pmc.t Mon May 4 22:47:15 2009 (r38471)
@@ -49,7 +49,7 @@
my $checkTypes;
my %types_we_cant_test
= map { $_ => 1; } ( # These require initializers.
- qw(Null Iterator Enumerate ParrotObject ParrotThread BigInt LexInfo LexPad Object),
+ qw(default Null Iterator Enumerate ParrotObject ParrotThread BigInt LexInfo LexPad Object),
# Instances of these appear to have other types.
qw(PMCProxy Class) );
More information about the parrot-commits
mailing list