Author: tewk
Date: Tue Jun 12 13:40:22 2007
New Revision: 18964
Added:
branches/pmc2c/lib/Parrot/Pmc2c/ComposedMethod.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/ParrotClass.pm
Modified:
branches/pmc2c/MANIFEST
branches/pmc2c/MANIFEST.SKIP
branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm
branches/pmc2c/lib/Parrot/Pmc2c/Method.pm
branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm
branches/pmc2c/lib/Parrot/Pmc2c/PCCMETHOD.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/RO.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm
branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm
branches/pmc2c/src/pmc/delegate.pmc
branches/pmc2c/src/pmc/parrotclass.pmc
branches/pmc2c/t/pmc/sarray.t
branches/pmc2c/t/tools/pmc2c.t
Log:
[Pmc2c] Branch passes all tests :) Woot
Modified: branches/pmc2c/MANIFEST
==============================================================================
--- branches/pmc2c/MANIFEST (original)
+++ branches/pmc2c/MANIFEST Tue Jun 12 13:40:22 2007
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 6 18:11:24 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Jun 12 20:37:58 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -354,11 +354,13 @@
docs/dev/dod.pod [devel]doc
docs/dev/events.pod [devel]doc
docs/dev/fhs.pod [devel]doc
+docs/dev/headerizer.pod [main]doc
docs/dev/infant.pod [devel]doc
docs/dev/jit_i386.pod [main]doc
docs/dev/longopt.pod [main]doc
docs/dev/nanoparrot.c [main]doc
docs/dev/optimizer.pod [main]doc
+docs/dev/parrot_api.pod [main]doc
docs/dev/pccmethods.pod [main]doc
docs/dev/pmc_freeze.pod [devel]doc
docs/dev/pmc_object_design_meeting_notes.pod [main]doc
@@ -2296,22 +2298,29 @@
lib/Parrot/Ops2pm/Utils.pm [devel]
lib/Parrot/OpsFile.pm [devel]
lib/Parrot/PIR/Formatter.pm [devel]
-lib/Parrot/Pmc2c.pm [devel]
+lib/Parrot/Pmc2c/CodeFragment.pm [devel]
+lib/Parrot/Pmc2c/ComposedMethod.pm [devel]
+lib/Parrot/Pmc2c/Dumper.pm [devel]
+lib/Parrot/Pmc2c/Emitter.pm [devel]
lib/Parrot/Pmc2c/Library.pm [devel]
-lib/Parrot/Pmc2c/Null.pm [devel]
+lib/Parrot/Pmc2c/Method.pm [devel]
+lib/Parrot/Pmc2c/MethodEmitter.pm [devel]
lib/Parrot/Pmc2c/PCCMETHOD.pm [devel]
+lib/Parrot/Pmc2c/PMC.pm [devel]
+lib/Parrot/Pmc2c/PMC/Null.pm [devel]
+lib/Parrot/Pmc2c/PMC/ParrotClass.pm [devel]
+lib/Parrot/Pmc2c/PMC/RO.pm [devel]
+lib/Parrot/Pmc2c/PMC/Ref.pm [devel]
+lib/Parrot/Pmc2c/PMC/STMRef.pm [devel]
+lib/Parrot/Pmc2c/PMC/SharedRef.pm [devel]
+lib/Parrot/Pmc2c/PMC/default.pm [devel]
+lib/Parrot/Pmc2c/PMC/deleg_pmc.pm [devel]
+lib/Parrot/Pmc2c/PMC/delegate.pm [devel]
+lib/Parrot/Pmc2c/PMCEmitter.pm [devel]
lib/Parrot/Pmc2c/Parser.pm [devel]
lib/Parrot/Pmc2c/Pmc2cMain.pm [devel]
-lib/Parrot/Pmc2c/Ref.pm [devel]
-lib/Parrot/Pmc2c/SharedRef.pm [devel]
-lib/Parrot/Pmc2c/Standard.pm [devel]
-lib/Parrot/Pmc2c/StandardConst.pm [devel]
-lib/Parrot/Pmc2c/StandardRO.pm [devel]
-lib/Parrot/Pmc2c/StmRef.pm [devel]
lib/Parrot/Pmc2c/UtilFunctions.pm [devel]
-lib/Parrot/Pmc2c/default.pm [devel]
-lib/Parrot/Pmc2c/deleg_pmc.pm [devel]
-lib/Parrot/Pmc2c/delegate.pm [devel]
+lib/Parrot/Pmc2c/VTable.pm [devel]
lib/Parrot/Revision.pm [devel]
lib/Parrot/Test.pm [devel]
lib/Parrot/Test/APL.pm [devel]
@@ -3127,6 +3136,7 @@
t/tools/pmc2cutils/05-gen_c.t []
t/tools/pmc2cutils/06-print_tree.t []
t/tools/pmc2cutils/07-open_file.t []
+t/tools/pmc2cutils/08-pmc.pm.t []
t/tools/pmc2cutils/README []
t/tools/smartlinks.t []
tools/build/addopstags.pl []
Modified: branches/pmc2c/MANIFEST.SKIP
==============================================================================
--- branches/pmc2c/MANIFEST.SKIP (original)
+++ branches/pmc2c/MANIFEST.SKIP Tue Jun 12 13:40:22 2007
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed Jun 6 18:11:24 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Tue Jun 12 20:37:58 2007 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -14,11 +14,16 @@
# debian/ should not go into release tarballs
^debian$
^debian/
-# generated from svn:ignore of 'languages/pheme/'
-^languages/pheme/.*\.pbc$
-^languages/pheme/.*\.pbc/
-^languages/pheme/Makefile$
-^languages/pheme/Makefile/
+# generated from svn:ignore of '
+languages/pheme/'
+^
+languages/pheme/.*\.pbc$
+^
+languages/pheme/.*\.pbc/
+^
+languages/pheme/Makefile$
+^
+languages/pheme/Makefile/
# generated from svn:ignore of './'
^.*\.core$
^.*\.core/
Added: branches/pmc2c/lib/Parrot/Pmc2c/ComposedMethod.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/ComposedMethod.pm Tue Jun 12 13:40:22 2007
@@ -0,0 +1,40 @@
+# Copyright (C) 2004-2006, The Perl Foundation.
+# $Id$
+package Parrot::Pmc2c::ComposedMethod;
+use strict;
+use warnings;
+use base qw( Parrot::Pmc2c::Method Exporter );
+use Data::Dumper;
+use Parrot::Pmc2c::UtilFunctions qw(count_newlines );
+
+sub new {
+ my ( $class, $self_hash ) = @_;
+ my $self = Parrot::Pmc2c::Method->new($self_hash);
+ bless $self, (ref($class) || $class);
+ $self;
+}
+
+sub full_method_name {
+ my ( $self, $parent_name ) = @_;
+ return "Parrot_" . $self->{parent_name} . "_" . $self->name;
+}
+
+sub generate_body {
+ return 1;
+}
+
+sub generate_headers {
+ my ( $self, $pmc ) = @_;
+ return "";
+}
+
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm Tue Jun 12 13:40:22 2007
@@ -131,7 +131,7 @@
}
else {
$line = $self->{current_line} if $line == -1;;
- #$data .= "#line $line \"$filename\" \n";
+ $data .= "#line $line \"$filename\"\n";
$data .= $it->{data};
}
$self->{output} .= $data;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Method.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Method.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Method.pm Tue Jun 12 13:40:22 2007
@@ -19,6 +19,7 @@
body => "",
parameters => "",
mmd_rights => [],
+ parent_name => "",
%{ $self_hash || {} }
)};
bless $self, (ref($class) || $class);
@@ -26,10 +27,10 @@
}
sub clone {
- my ( $self ) = @_;
- my $new = {( %{ $self } )};
- bless $new, ref($self);
- return $new;
+ my ( $self, $self_hash ) = @_;
+ return $self->new( {( %{ $self },
+ %{ $self_hash || {} }
+ )} );
}
sub add_mmd_rights {
@@ -43,8 +44,8 @@
}
#getters/setters
-for my $x qw( name type return_type body mmds symbol mmd_prefix mmd_table
mmd_name right
- attrs parameters ) {
+for my $x qw( name parent_name type return_type body mmds symbol mmd_prefix
mmd_table mmd_name
+ right attrs parameters ) {
my $code = <<'EOC';
sub REPLACE {
my ( $self, $value ) = @_;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm Tue Jun 12 13:40:22 2007
@@ -314,6 +314,11 @@
return "INTERP, $obj";
}
+sub full_method_name {
+ my ( $self, $parent_name ) = @_;
+ return "Parrot_${parent_name}_" . $self->name;
+}
+
1;
# Local Variables:
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PCCMETHOD.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PCCMETHOD.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PCCMETHOD.pm Tue Jun 12 13:40:22 2007
@@ -234,6 +234,7 @@
my $e = Parrot::Pmc2c::Emitter->new($pmc->filename);
$e->emit(<<"END", __FILE__, __LINE__ + 1);
+ {
/*BEGIN PCCRETURN $returns */
/*BEGIN GENERATED ACCESSORS */
END
@@ -250,6 +251,7 @@
string_from_const_cstring(interp, $returns_flags, 0), 0);
$goto_string
/*END PCCRETURN $returns */
+ }
END
$matched->replace($match, $e);
}
@@ -467,8 +469,8 @@
\( ([^\(]*) \) #results
\s* #optional whitespace
= #results equals PCCINVOKE invocation
- )? #results are optional
\s* #optional whitespace
+ )? #results are optional
PCCINVOKE #method name
\s* #optional whitespace
\( ([^\(]*) \) #parameters
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm Tue Jun 12 13:40:22 2007
@@ -50,6 +50,7 @@
methods => [],
super => {},
variant => '',
+ mixins => [],
%{ $self } ) } ;
bless $self, (ref($class) || $class);
$self;
@@ -96,11 +97,21 @@
}
#parents
+sub is_parent {
+ my ( $self, $parent_name ) = @_;
+ return grep /$parent_name/, @{ $self->{parents} };
+}
+
sub add_parent {
my ( $self, $parent ) = @_;
my $parent_name = $parent->name;
$self->{has_parent}{$parent_name} = { %{ $parent->{has_method} } };
- push @{ $self->{parents} }, $parent_name unless grep /$parent_name/, @{
$self->{parents} };
+ push @{ $self->{parents} }, $parent_name unless
$self->is_parent($parent_name);
+}
+
+sub add_mixin {
+ my ( $self, $mixin_name ) = @_;
+ push @{ $self->{mixins} }, $mixin_name unless grep /$mixin_name/, @{
$self->{mixins} };
}
@@ -175,6 +186,10 @@
my ( $self) = @_;
return $self->{parents}
}
+sub mixins {
+ my ( $self) = @_;
+ return $self->{mixins}
+}
sub methods {
my ( $self) = @_;
return $self->{methods}
@@ -285,9 +300,9 @@
if ($super_pmc) {
my $super_pmc_name;
if (ref($super_pmc)) {
- $super_pmc_name = $super_pmc->name;
-
my $super_method = $super_pmc->get_method($vt_meth);
+ $super_pmc_name = $super_method->parent_name;
+ $self->add_mixin($super_pmc_name) unless
$self->is_parent($super_pmc_name);
$self->super_attrs($vt_meth, $super_method->attrs);
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm Tue Jun 12 13:40:22 2007
@@ -30,7 +30,10 @@
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
next unless $self->normal_unimplemented_vtable($vt_method_name);
- my $new_default_method = $method->clone();
+ my $new_default_method = $method->clone({
+ parent_name => $self->name,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
my $ret = "";
$ret = gen_ret($method);
@@ -39,7 +42,6 @@
EOC
$output .= $ret if $ret;
$new_default_method->body(Parrot::Pmc2c::Emitter->text($output));
- $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
$self->add_method($new_default_method);
}
return 1;
Added: branches/pmc2c/lib/Parrot/Pmc2c/PMC/ParrotClass.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/ParrotClass.pm Tue Jun 12 13:40:22 2007
@@ -0,0 +1,82 @@
+=head1 Parrot::Pmc2c::ParrotClass Instance Methods
+
+=over 4
+
+=cut
+
+package Parrot::Pmc2c::PMC::ParrotClass;
+use base 'Parrot::Pmc2c::PMC';
+use strict;
+use warnings;
+use Parrot::Pmc2c::ComposedMethod;
+
+=item C<pre_method_gen($self)>
+
+Mixes in delegate.pmc methods for all unimplmented methods except
[EMAIL PROTECTED] which should fall through to the default.pmc
+implementation.
+
+=cut
+
+our @dont_delegate = qw(
+ add_parent
+ assign_pmc
+ assign_string_native
+ can
+ defined
+ defined_keyed_int
+ delete_keyed_int
+ delprop
+ does
+ exists_keyed_int
+ find_method
+ get_attr_str
+ get_integer_keyed_int
+ get_number_keyed_int
+ get_pmc_keyed_int
+ get_pointer
+ get_string_keyed_int
+ getprop
+ getprops
+ is_same
+ morph
+ nextkey_keyed_int
+ set_integer_keyed_int
+ set_number_keyed_int
+ set_pmc_keyed_int
+ set_string_keyed_int
+ setprop
+ subclass
+ type_keyed_int
+);
+
+our $dont_delegate = { map { $_, 1 } (@dont_delegate) };
+
+sub pre_method_gen {
+ my ( $self ) = @_;
+ # vtable methods
+ foreach my $method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $method->name;
+ next if exists $dont_delegate->{ $vt_method_name };
+ next unless $self->normal_unimplemented_vtable($vt_method_name);
+ my $composed_method = Parrot::Pmc2c::ComposedMethod->new(
+ {
+ name => $vt_method_name,
+ parent_name => 'delegate',
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
+ $self->add_method($composed_method);
+ }
+ $self->add_mixin('delegate');
+ return 1;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/RO.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/RO.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/RO.pm Tue Jun 12 13:40:22 2007
@@ -73,6 +73,7 @@
if ( $vt_method_name eq 'find_method' ) {
my $ro_method = Parrot::Pmc2c::Method->new({
name => $vt_method_name,
+ parent_name => $parent->name,
return_type => $vt_method->return_type,
parameters => $vt_method->parameters,
type => Parrot::Pmc2c::Method::VTABLE,
@@ -98,6 +99,7 @@
elsif ( $parent->vtable_method_does_write($vt_method_name) ) {
my $ro_method = Parrot::Pmc2c::Method->new({
name => $vt_method_name,
+ parent_name => $parent->name,
return_type => $vt_method->return_type,
parameters => $vt_method->parameters,
type => Parrot::Pmc2c::Method::VTABLE,
@@ -114,7 +116,8 @@
}
else {
if ( $parent->implements_vtable($vt_method_name) ) {
- $self->{super}{$vt_method_name} = $parent->name;
+ my $parent_method = $parent->get_method($vt_method_name);
+ $self->{super}{$vt_method_name} = $parent_method->parent_name;
}
else {
$self->{super}{$vt_method_name} = $parent->{super}{$vt_method_name};
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm Tue Jun 12 13:40:22 2007
@@ -61,7 +61,10 @@
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
next unless $self->normal_unimplemented_vtable($vt_method_name);
- my $new_default_method = $method->clone();
+ my $new_default_method = $method->clone({
+ parent_name => $self->name,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
my $n = 0;
my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $method->parameters;
@@ -88,7 +91,6 @@
EOC
$new_default_method->body(Parrot::Pmc2c::Emitter->text($body));
- $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
$self->add_method($new_default_method);
}
return 1;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm Tue Jun 12 13:40:22 2007
@@ -25,7 +25,10 @@
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
next unless $self->unimplemented_vtable($vt_method_name);
- my $new_default_method = $method->clone();
+ my $new_default_method = $method->clone({
+ parent_name => $self->name,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
my $ret = "";
$ret = gen_ret($method);
@@ -33,7 +36,6 @@
cant_do_method(interp, pmc, "$vt_method_name");
$ret
EOC
- $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
$self->add_method($new_default_method);
}
return 1;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm Tue Jun 12 13:40:22 2007
@@ -24,7 +24,10 @@
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
next unless $self->normal_unimplemented_vtable($vt_method_name);
- my $new_method = $method->clone();
+ my $new_method = $method->clone({
+ parent_name => $self->name,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
my $n = 0;
my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $method->parameters;
@@ -34,7 +37,6 @@
PMC *attr = get_attrib_num(PMC_data_typed(pmc, SLOTTYPE *), 0);
$ret
EOC
- $new_method->type(Parrot::Pmc2c::Method::VTABLE);
$self->add_method($new_method);
}
return 1;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm Tue Jun 12 13:40:22 2007
@@ -17,12 +17,6 @@
=cut
-our $ok = {
- 'get_bool' =>1,
- 'get_string' =>1,
- 'push_string' =>1,
-};
-
sub pre_method_gen {
my ( $self ) = @_;
@@ -30,9 +24,11 @@
# vtable methods
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
- #next unless exists $ok->{$vt_method_name};
next unless $self->normal_unimplemented_vtable($vt_method_name);
- my $new_default_method = $method->clone();
+ my $new_default_method = $method->clone({
+ parent_name => $self->name,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
my ( $func_ret, $ret_suffix, $args, $sig ) = $self->signature($method);
my $super_args = $args;
$super_args =~ s/^,//;
@@ -41,14 +37,10 @@
STRING *meth = CONST_STRING(interp, "$vt_method_name");
PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth);
- if (PMC_IS_NULL(sub)) {
- PIO_printf(interp, "Delegate %Ss - $vt_method_name\\n",
pmc->vtable->whoami );
- return SUPER($super_args);
- /* vtable_meth_not_found(interp, pmc, "$vt_method_name"); */
- }
+ if (PMC_IS_NULL(sub))
+ vtable_meth_not_found(interp, pmc, "$vt_method_name");
${func_ret}Parrot_run_meth_fromc_args$ret_suffix(interp, sub, pmc, meth,
"$sig"$args);
EOC
- $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
$self->add_method($new_default_method);
}
return 1;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm Tue Jun 12 13:40:22 2007
@@ -28,6 +28,7 @@
use Text::Balanced 'extract_bracketed';
use Parrot::Pmc2c::PCCMETHOD;
use Parrot::Pmc2c::PMC::RO;
+use Parrot::Pmc2c::PMC::ParrotClass;
sub prep_for_emit {
my ( $this, $pmc, $vtable_dump ) = @_;
@@ -175,6 +176,7 @@
my $body = Parrot::Pmc2c::Emitter->text(" return
INTERP->vtables[SELF->vtable->base_type]->_namespace;\n");
$self->add_method( Parrot::Pmc2c::Method->new( {
name => 'pmc_namespace',
+ parent_name => $self->name,
parameters => '',
body => $body,
type => Parrot::Pmc2c::Method::VTABLE,
@@ -206,6 +208,9 @@
foreach my $parent_name ( $self->name, @{ $self->parents } ) {
$c->emit('#include "pmc_' . lc $parent_name . ".h\"\n");
}
+ foreach my $mixin_name ( @{ $self->mixins } ) {
+ $c->emit('#include "pmc_' . lc $mixin_name . ".h\"\n");
+ }
$c->emit('#include "' . lc $self->name . ".str\"\n") unless
$self->is_dynamic;
}
@@ -384,7 +389,8 @@
my $implementor;
if ( $self->implements_vtable($vt_method_name) ) {
- $implementor = $self->name . $self->{variant};
+ return $self->get_method($vt_method_name)->
+ full_method_name($self->name . $self->{variant});
}
elsif ( $self->{super}{$vt_method_name} ) {
$implementor = $self->{super}{$vt_method_name};
@@ -553,7 +559,7 @@
# To make use of the .HLL directive, register any mapping...
if ( $self->{flags}{hll} && $self->{flags}{maps} ) {
- my $hll = ( keys %{ $self->{flags}{hll} } )[0];
+ my $hll = $self->{flags}{hll};
my $maps = ( keys %{ $self->{flags}{maps} } )[0];
$cout .= <<"EOC";
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm Tue Jun 12 13:40:22 2007
@@ -101,6 +101,7 @@
my $method = Parrot::Pmc2c::Method->new( {
name => $methodname,
+ parent_name => $pmc->name,
body => Parrot::Pmc2c::Emitter->text($methodblock,
$filename, $lineno),
return_type => $return_type,
parameters => $parameters,
@@ -166,6 +167,7 @@
else {
my $mmd_method = Parrot::Pmc2c::Method->new( {
name => $method->name . "_$right_type",
+ parent_name => $method->parent_name,
body => Parrot::Pmc2c::Emitter->text($mmd_part,
$filename, $lineno),
return_type => $method->return_type,
parameters => $method->parameters,
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm Tue Jun 12 13:40:22 2007
@@ -23,7 +23,7 @@
use File::Basename;
use Carp;
-#$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
+$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
=head1 NAME
Modified: branches/pmc2c/src/pmc/delegate.pmc
==============================================================================
--- branches/pmc2c/src/pmc/delegate.pmc (original)
+++ branches/pmc2c/src/pmc/delegate.pmc Tue Jun 12 13:40:22 2007
@@ -74,6 +74,7 @@
*/
+
void init() {
STRING *meth = CONST_STRING(interp, "init");
PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
Modified: branches/pmc2c/src/pmc/parrotclass.pmc
==============================================================================
--- branches/pmc2c/src/pmc/parrotclass.pmc (original)
+++ branches/pmc2c/src/pmc/parrotclass.pmc Tue Jun 12 13:40:22 2007
@@ -48,7 +48,7 @@
#include "parrot/parrot.h"
-pmclass ParrotClass extends delegate need_ext {
+pmclass ParrotClass need_ext {
/*
Modified: branches/pmc2c/t/pmc/sarray.t
==============================================================================
--- branches/pmc2c/t/pmc/sarray.t (original)
+++ branches/pmc2c/t/pmc/sarray.t Tue Jun 12 13:40:22 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 33;
+use Parrot::Test tests => 30;
=head1 NAME
@@ -474,54 +474,6 @@
ok 12
OUTPUT
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "const SArray 1" );
- new P0, .ConstSArray
- set P0, 10
- new P1, .Integer
- inc P1
- setprop P0, "_ro", P1
- set P0, 20
- end
-CODE
-/^set_integer_native\(\) in ConstSArray/
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "const SArray 2" );
- new P0, .ConstSArray
- set P0, 2
- push P0, 10
- new P1, .Integer
- inc P1
- setprop P0, "_ro", P1
- set P2, P0[0]
- printerr P2
- printerr "\n"
- getprop P3, "_ro", P0
- printerr P3
- printerr "\n"
- shift I4, P0
- end
-CODE
-/^10
-1
-shift_integer\(\) in ConstSArray/
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "const SArray try to unset _ro"
);
- new P0, .ConstSArray
- set P0, 10
- new P1, .Integer
- inc P1
- setprop P0, "_ro", P1
- printerr "ok\n"
- dec P1
- setprop P0, "_ro", P1
- end
-CODE
-/^ok
-morph\(\) in ConstSArray/
-OUTPUT
-
pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
.sub _main
Modified: branches/pmc2c/t/tools/pmc2c.t
==============================================================================
--- branches/pmc2c/t/tools/pmc2c.t (original)
+++ branches/pmc2c/t/tools/pmc2c.t Tue Jun 12 13:40:22 2007
@@ -28,7 +28,7 @@
use Fatal qw{open close};
use Test::More;
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 9;
use Parrot::Config;
my $pmc2c = join $PConfig{slash}, qw(. tools build pmc2c.pl);
@@ -136,51 +136,24 @@
pmc2c_output_like( <<'END_PMC', <<'END_C', 'need_ext' );
pmclass a need_ext { }
END_PMC
- const VTABLE temp_base_vtable = {
- NULL, /* namespace */
+ const VTABLE temp_ro_vtable = {
+ NULL, /* namespace */
enum_class_a, /* base_type */
- NULL, /* whoami */
- 0|VTABLE_PMC_NEEDS_EXT|VTABLE_HAS_READONLY_FLAG, /* flags */
+ NULL, /* whoami */
+ 0|VTABLE_PMC_NEEDS_EXT|VTABLE_IS_READONLY_FLAG, /* flags */
END_C
-pmc2c_output_like( <<'END_PMC', <<'END_C', 'const_too 1' );
-pmclass a const_too { }
-END_PMC
-void
-Parrot_a_class_init(Parrot_Interp interp, int entry, int pass)
-{
- const VTABLE temp_base_vtable = {
- NULL, /* namespace */
- enum_class_a, /* base_type */
- NULL, /* whoami */
- VTABLE_HAS_CONST_TOO, /* flags */
-END_C
-
-pmc2c_output_like( <<'END_PMC', <<'END_C', 'const_too 2' );
-pmclass a const_too { }
-END_PMC
-void
-Parrot_Consta_class_init(Parrot_Interp interp, int entry, int pass)
-{
- const VTABLE temp_base_vtable = {
- NULL, /* namespace */
- enum_class_Consta, /* base_type */
- NULL, /* whoami */
- VTABLE_IS_CONST_FLAG, /* flags */
-END_C
pmc2c_output_like( <<'END_PMC', <<'END_C', 'maps' );
pmclass a hll dale maps Integer { }
END_PMC
- INTVAL pmc_id = Parrot_get_HLL_id(
- interp, const_string(interp, "dale")
+ INTVAL pmc_id = Parrot_get_HLL_id( interp, const_string(interp,
"dale")
);
if (pmc_id > 0)
- Parrot_register_HLL_type(
- interp, pmc_id, enum_class_Integer, entry
- );
+ Parrot_register_HLL_type( interp, pmc_id, enum_class_Integer,
entry);
END_C
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
