Author: tewk
Date: Wed May 23 08:03:11 2007
New Revision: 18634
Added:
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Ref.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/StmRef.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm
Removed:
branches/pmc2c/lib/Parrot/Pmc2c/Null.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/StandardRO.pm
branches/pmc2c/lib/Parrot/Pmc2c/Ref.pm
branches/pmc2c/lib/Parrot/Pmc2c/SharedRef.pm
branches/pmc2c/lib/Parrot/Pmc2c/Standard.pm
branches/pmc2c/lib/Parrot/Pmc2c/StandardConst.pm
branches/pmc2c/lib/Parrot/Pmc2c/StandardRO.pm
branches/pmc2c/lib/Parrot/Pmc2c/StmRef.pm
branches/pmc2c/lib/Parrot/Pmc2c/default.pm
branches/pmc2c/lib/Parrot/Pmc2c/deleg_pmc.pm
branches/pmc2c/lib/Parrot/Pmc2c/delegate.pm
Modified:
branches/pmc2c/config/inter/pmc.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Standard.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm
Log:
[Pmc2c] Checkpoint
Modified: branches/pmc2c/config/inter/pmc.pm
==============================================================================
--- branches/pmc2c/config/inter/pmc.pm (original)
+++ branches/pmc2c/config/inter/pmc.pm Wed May 23 08:03:11 2007
@@ -132,6 +132,30 @@
E_NOTE
+ $TEMP_pmc_build .= <<END;
+PMC2C_FILES = \\
+\t\tlib/Parrot/Pmc2c/Pmc2cMain.pm \\
+\t\tlib/Parrot/Pmc2c/Parser.pm \\
+\t\tlib/Parrot/Pmc2c/Dumper.pm \\
+\t\tlib/Parrot/Pmc2c/PMC.pm \\
+\t\tlib/Parrot/Pmc2c/Method.pm \\
+\t\tlib/Parrot/Pmc2c/PCCMETHOD.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter.pm \\
+\t\tlib/Parrot/Pmc2c/MethodEmitter.pm \\
+\t\tlib/Parrot/Pmc2c/Library.pm \\
+\t\tlib/Parrot/Pmc2c/UtilFunctions.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/default.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/delegate.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/Standard.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/Null.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/Ref.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm \\
+\t\tlib/Parrot/Pmc2c/PMCEmitter/StmRef.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/RO.pm
+
+END
+
foreach my $pmc ( split( /\s+/, $pmc_list ) ) {
$pmc =~ s/\.pmc$//;
next if ( $pmc =~ /^const/ );
@@ -146,15 +170,7 @@
src/pmc/$pmc.c : src/pmc/$pmc.dump
\t\$(PMC2CC) src/pmc/$pmc.pmc
-src/pmc/$pmc.dump : vtable.dump $parent_dumps src/pmc/$pmc.pmc \\
-\t\tlib/Parrot/Pmc2c/StmRef.pm \\
-\t\tlib/Parrot/Pmc2c/default.pm lib/Parrot/Pmc2c/Library.pm \\
-\t\tlib/Parrot/Pmc2c/Ref.pm lib/Parrot/Pmc2c/SharedRef.pm \\
-\t\tlib/Parrot/Pmc2c/Standard.pm lib/Parrot/Pmc2c/UtilFunctions.pm \\
-\t\tlib/Parrot/Pmc2c/delegate.pm lib/Parrot/Pmc2c/Null.pm \\
-\t\tlib/Parrot/Pmc2c/StandardRO.pm lib/Parrot/Pmc2c/Pmc2cMain.pm \\
-\t\tlib/Parrot/Pmc2c/deleg_pmc.pm lib/Parrot/Pmc2c/PCCMETHOD.pm \\
-\t\tlib/Parrot/Pmc2c/StandardConst.pm
+src/pmc/$pmc.dump : \$(PMC2C_FILES) vtable.dump $parent_dumps src/pmc/$pmc.pmc
\t\$(PMC2CD) src/pmc/$pmc.pmc
src/pmc/pmc_$pmc.h: src/pmc/$pmc.c
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm Wed May 23 08:03:11 2007
@@ -30,8 +30,13 @@
use Text::Balanced 'extract_bracketed';
use Parrot::Pmc2c::PCCMETHOD;
use Parrot::Pmc2c::PMC::RO;
+use Parrot::Pmc2c::PMCEmitter::Standard;
use Parrot::Pmc2c::PMCEmitter::default;
use Parrot::Pmc2c::PMCEmitter::delegate;
+use Parrot::Pmc2c::PMCEmitter::deleg_pmc;
+use Parrot::Pmc2c::PMCEmitter::Ref;
+use Parrot::Pmc2c::PMCEmitter::SharedRef;
+use Parrot::Pmc2c::PMCEmitter::StmRef;
sub new {
my ( $this, $pmc_dump, $vtable_dump, $options ) = @_;
@@ -155,10 +160,6 @@
$self->{hdecls};
}
-use Parrot::Pmc2c::PMCEmitter::Standard;
-use Parrot::Pmc2c::PMCEmitter::StandardRO;
-use Parrot::Pmc2c::PMCEmitter::default;
-
=back
=head2 Instance Methods
Added: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Ref.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Ref.pm Wed May 23 08:03:11 2007
@@ -0,0 +1,109 @@
+
+=head1 Parrot::Pmc2c::Ref Instance Methods
+
+=over 4
+
+=cut
+
+package Parrot::Pmc2c::PMCEmitter::Ref;
+use base 'Parrot::Pmc2c::PMCEmitter';
+use strict;
+use warnings;
+use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
+
+=item C<prederef($method)>
+
+Returns C code to be executed before executing a delegated method.
+Default versions always returns an empty string.
+
+=cut
+
+sub prederef {
+ return '';
+}
+
+=item C<postderef($method)>
+
+Returns C code to be executed after executing a delegated method
+through this reference. Default version returns an empty string.
+
+=cut
+
+sub postderef {
+ return '';
+}
+
+=item C<raw_deref($method)>
+
+Returns C code that can be used to access the underlying PMC in the
+delegated methods. Defualt is PMC_pmc_val(pmc)
+
+=cut
+
+sub raw_deref {
+ my ( $self, $method ) = @_;
+ return '(PMC *)PMC_pmc_val(pmc)';
+}
+
+=item C<body($method, $line, $out_name)>
+
+Returns the C code for the method body.
+
+Overrides the default implementation to direct all unknown methods to
+the thing referred to.
+
+=cut
+
+sub pre_method_gen {
+ my ( $self ) = @_;
+
+ # vtable methods
+ foreach my $method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $method->name;
+ next if $vt_method_name eq 'class_init';
+ next if $self->implements_vtable($vt_method_name);
+ my $new_default_method = $method->clone();
+
+ my $n = 0;
+ my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $method->parameters;
+ my $arg = @args ? ", " . join( ' ', @args ) : '';
+
+ my $pre = $self->prederef($method);
+ my $post = $self->postderef($method);
+ my $deref = $self->raw_deref($method);
+ my $ret_def = '';
+ my $ret_assign = '';
+ my $ret = '';
+
+ if ( $method->return_type ne 'void' ) {
+ $ret_def = $method->return_type . ' ret_val;';
+ $ret_assign = 'ret_val = ';
+ $ret = gen_ret( $method, 'ret_val' );
+ }
+ my $body = <<EOC;
+ $ret_def
+ $pre
+ $ret_assign VTABLE_$vt_method_name(interp, $deref$arg);
+ $post
+ $ret
+EOC
+
+ $new_default_method->body($body);
+ $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
+ $self->add_method($new_default_method);
+ }
+ return 1;
+}
+
+1;
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Added: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm Wed May 23
08:03:11 2007
@@ -0,0 +1,47 @@
+
+=head1 Parrot::Pmc2c::SharedRef Instance Methods
+
+=over 4
+
+=cut
+
+package Parrot::Pmc2c::PMCEmitter::SharedRef;
+use base 'Parrot::Pmc2c::PMCEmitter::Ref';
+use strict;
+use warnings;
+
+=item C<prederef($method)>
+
+Returns code that will lock the PMC for calling the underlying
+implementation of $method.
+
+=cut
+
+sub prederef {
+ my ( $self, $method ) = @_;
+ return 'LOCK_PMC(interp, pmc);';
+}
+
+=item C<postderef($method)>
+
+Returns the unlocking code.
+
+=cut
+
+sub postderef {
+ my ( $self, $method ) = @_;
+ return 'UNLOCK_PMC(interp, pmc);';
+}
+
+=back
+
+=cut
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Standard.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Standard.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Standard.pm Wed May 23
08:03:11 2007
@@ -12,16 +12,6 @@
use strict;
use warnings;
-=item C<body($method, $line, $out_name)>
-
-Returns the C code for the method body. C<$line> is used to accumulate
-the number of lines, C<$out_name> is the name of the output file we are
-generating.
-
-=back
-
-=cut
-
1;
# Local Variables:
Added: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/StmRef.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/StmRef.pm Wed May 23
08:03:11 2007
@@ -0,0 +1,45 @@
+package Parrot::Pmc2c::PMCEmitter::STMRef;
+use base 'Parrot::Pmc2c::PMCEmitter::Ref';
+use strict;
+use warnings;
+
+=head1 Parrot::Pmc2c::STMRef Instance Methods
+
+=cut
+
+sub prederef {
+ my ( $self, $method ) = @_;
+ my $name = $method->{meth};
+ my $code = '';
+ $code .= <<'EOC';
+PMC *real_pmc;
+ Parrot_STM_PMC_handle handle;
+
+ assert(pmc->vtable->pmc_class != pmc);
+
+ handle = (Parrot_STM_PMC_handle)PMC_struct_val(pmc);
+EOC
+ if ( $self->does_write($name) ) { # XXX is this good enough?
+ $code .= <<'EOC';
+ real_pmc = Parrot_STM_begin_update(interp, handle);
+EOC
+ }
+ else {
+ $code .= <<'EOC';
+ real_pmc = Parrot_STM_read(interp, handle);
+EOC
+ }
+}
+
+sub raw_deref {
+ return 'real_pmc';
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Added: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm Wed May 23
08:03:11 2007
@@ -0,0 +1,51 @@
+package Parrot::Pmc2c::PMCEmitter::deleg_pmc;
+use base 'Parrot::Pmc2c::PMCEmitter';
+use strict;
+use warnings;
+use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
+
+=item C<body($method,)>
+
+Returns the C code for the method body.
+
+Overrides the default implementation to direct all unknown methods to
+the PMC in the first attribute slot.
+
+=back
+
+=cut
+
+sub pre_method_gen {
+ my ( $self ) = @_;
+
+ # vtable methods
+ foreach my $method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $method->name;
+ next if $vt_method_name eq 'class_init';
+ next if $self->implements_vtable($vt_method_name);
+ my $new_default_method = $method->clone();
+
+ my $n = 0;
+ my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $method->parameters;
+ my $arg = @args ? ", " . join( ' ', @args ) : '';
+ my $ret = gen_ret( $method, "VTABLE_$method->name(interp, attr$arg)"
);
+ my $body = <<EOC;
+ PMC *attr = get_attrib_num(PMC_data_typed(pmc, SLOTTYPE *), 0);
+ $ret
+EOC
+
+ $new_default_method->body($body);
+ $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
+ $self->add_method($new_default_method);
+ }
+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/PMCEmitter/delegate.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm Wed May 23
08:03:11 2007
@@ -10,6 +10,43 @@
use strict;
use warnings;
+=item C<pre_method_gen($self)>
+
+Returns the C code for the method body.
+
+The C<delegate> PMC redirects all methods to bytecode.
+
+=back
+
+=cut
+
+sub pre_method_gen {
+ my ( $self ) = @_;
+
+ # vtable methods
+ foreach my $method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $method->name;
+ next if $vt_method_name eq 'class_init';
+ next if $self->implements_vtable($vt_method_name);
+ my $new_default_method = $method->clone();
+ my ( $func_ret, $ret_suffix, $args, $sig ) = $self->signature($method);
+
+ my $body = <<EOC;
+
+ STRING *meth = CONST_STRING(interp, "$vt_method_name");
+ PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth);
+ 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->body($body);
+ $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
+ $self->add_method($new_default_method);
+ }
+ return 1;
+}
+
+
=item C<implements($method)>
True for vtables.
@@ -69,44 +106,6 @@
return ( $func_ret, $method_suffix, $args, $sig );
}
-=item C<body($self)>
-
-Returns the C code for the method body. C<$line> is used to accumulate
-the number of lines, C<$out_name> is the name of the output file we are
-generating.
-
-The C<delegate> PMC redirects all methods to bytecode.
-
-=back
-
-=cut
-sub pre_method_gen {
- my ( $self ) = @_;
-
- # vtable methods
- foreach my $method ( @{ $self->vtable->methods } ) {
- my $vt_method_name = $method->name;
- next if $vt_method_name eq 'class_init';
- unless ( $self->implements_vtable($vt_method_name) ) {
- my $new_default_method = $method->clone();
- my ( $func_ret, $ret_suffix, $args, $sig ) =
$self->signature($method);
-
- my $body = <<EOC;
-
- STRING *meth = CONST_STRING(interp, "$vt_method_name");
- PMC *sub = Parrot_find_vtable_meth(interp, pmc, meth);
- 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->body($body);
- $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
- $self->add_method($new_default_method);
- }
- }
- return 1;
-}
-
1;
# Local Variables:
