Author: tewk
Date: Fri Jun 1 16:14:38 2007
New Revision: 18737
Added:
branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm (contents, props changed)
- copied, changed from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Null.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm (contents, props changed)
- copied, changed from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Ref.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/STMRef.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/SharedRef.pm (contents, props changed)
- copied, changed from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm (contents, props changed)
- copied, changed from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/default.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm (contents, props changed)
- copied, changed from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm (contents, props changed)
- copied, changed from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm
Removed:
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Null.pm
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/default.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm
Modified:
branches/pmc2c/MANIFEST
branches/pmc2c/MANIFEST.SKIP
branches/pmc2c/config/gen/makefiles/dynpmc_pl.in
branches/pmc2c/config/inter/pmc.pm
branches/pmc2c/languages/lisp/t/atoms.t (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/CodeFragment.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/Dumper.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/Library.pm
branches/pmc2c/lib/Parrot/Pmc2c/Method.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/PMC/RO.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm (contents, props changed)
branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Standard.pm (contents, props
changed)
branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm
branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm
branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm
branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm (contents, props changed)
Log:
[Pmc2c] Branch checkpoint
Modified: branches/pmc2c/MANIFEST
==============================================================================
--- branches/pmc2c/MANIFEST (original)
+++ branches/pmc2c/MANIFEST Fri Jun 1 16:14:38 2007
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Wed May 30 22:23:36 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Jun 1 22:09:22 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2303,7 +2303,14 @@
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/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/PMCEmitter/Null.pm [devel]
lib/Parrot/Pmc2c/PMCEmitter/Ref.pm [devel]
Modified: branches/pmc2c/MANIFEST.SKIP
==============================================================================
--- branches/pmc2c/MANIFEST.SKIP (original)
+++ branches/pmc2c/MANIFEST.SKIP Fri Jun 1 16:14:38 2007
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Wed May 30 22:23:36 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri Jun 1 22:09:22 2007 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
Modified: branches/pmc2c/config/gen/makefiles/dynpmc_pl.in
==============================================================================
--- branches/pmc2c/config/gen/makefiles/dynpmc_pl.in (original)
+++ branches/pmc2c/config/gen/makefiles/dynpmc_pl.in Fri Jun 1 16:14:38 2007
@@ -204,7 +204,6 @@
# There should be at most a single group
my $group = $class->{flags}{group}
or next;
- ($group) = keys %$group;
$pmc_group{$pmc} = $group;
push @{ $group_files{$group} }, $pmc;
$group_libs{$group} ||= {};
Modified: branches/pmc2c/config/inter/pmc.pm
==============================================================================
--- branches/pmc2c/config/inter/pmc.pm (original)
+++ branches/pmc2c/config/inter/pmc.pm Fri Jun 1 16:14:38 2007
@@ -144,16 +144,14 @@
\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/default.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/delegate.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/deleg_pmc.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/Null.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/Ref.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/SharedRef.pm \\
+\t\tlib/Parrot/Pmc2c/PMC/STMRef.pm \\
\t\tlib/Parrot/Pmc2c/PMC/RO.pm
-
END
foreach my $pmc ( split( /\s+/, $pmc_list ) ) {
@@ -170,7 +168,7 @@
src/pmc/$pmc.c : src/pmc/$pmc.dump
\t\$(PMC2CC) src/pmc/$pmc.pmc
-src/pmc/$pmc.dump : \$(PMC2C_FILES) vtable.dump $parent_dumps src/pmc/$pmc.pmc
+src/pmc/$pmc.dump : vtable.dump $parent_dumps src/pmc/$pmc.pmc \$(PMC2C_FILES)
\t\$(PMC2CD) src/pmc/$pmc.pmc
src/pmc/pmc_$pmc.h: src/pmc/$pmc.c
Modified: branches/pmc2c/languages/lisp/t/atoms.t
==============================================================================
--- branches/pmc2c/languages/lisp/t/atoms.t (original)
+++ branches/pmc2c/languages/lisp/t/atoms.t Fri Jun 1 16:14:38 2007
@@ -1,4 +1,4 @@
-# $Id: hello.t 18515 2007-05-12 12:19:34Z bernhard $
+# $Id$
=head1 NAME
Modified: branches/pmc2c/lib/Parrot/Pmc2c/CodeFragment.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/CodeFragment.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/CodeFragment.pm Fri Jun 1 16:14:38 2007
@@ -1,5 +1,5 @@
# Copyright (C) 2004-2006, The Perl Foundation.
-# $Id: Parser.pm 18503 2007-05-11 07:39:22Z paultcochrane $
+# $Id$
package Parrot::Pmc2c::CodeFragment;
use strict;
use warnings;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Dumper.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Dumper.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Dumper.pm Fri Jun 1 16:14:38 2007
@@ -1,5 +1,5 @@
# Copyright (C) 2004-2006, The Perl Foundation.
-# $Id: Pmc2cMain.pm 18495 2007-05-11 00:50:42Z tewk $
+# $Id$
package Parrot::Pmc2c::Pmc2cMain;
use strict;
use warnings;
@@ -56,7 +56,7 @@
}
foreach my $pmc ( values %{$pmcs} ) {
- next if ( $pmc->name =~ /default\.dump$/ && $pmc->dump_is_current );
+ next if ( $pmc->name =~ /default$/ && $pmc->dump_is_current );
gen_parent_lookup_info( $pmc, $pmc2cMain, $pmcs);
gen_parent_reverse_lookup_info( $pmc, $pmcs, $vtable_dump );
@@ -124,30 +124,6 @@
=head2 Subroutines
-These are auxiliary subroutines called inside the methods described above.
-
-=head3 C<dump_is_newer()>
-
- dump_is_newer($existing);
-
-B<Purpose:> Determines whether the dump of a file is newer than the PMC file.
-(If it's not, then the PMC file has changed and the dump has not been updated.)
-
-B<Arguments:> String holding filename.
-
-B<Return Values:> Returns true if timestamp of existing is more recent than
-that of PMC.
-
-B<Comments:> Called within C<find_and_parse_pmc()>.
-
-=cut
-
-sub dump_is_newer {
- my $dumpfile = shift;
- my $pmcfile = filename($dumpfile, '.pmc');
- return 0 unless -e $dumpfile;
- return ( stat $dumpfile )[9] > ( stat $pmcfile )[9];
-}
=head3 C<gen_parent_reverse_lookup_info()>
@@ -195,16 +171,6 @@
last;
}
}
- unless ( $pmc->super_method($vt_method_name) ) {
- # XXX This is a quick hack to get the inheritance ParrotClass isa
delegate
- # delegate has everything autogenerated, so these methods aren't
seen and
- # not inherited properly. The correct way would be to look at
$class->implements
- # but when dumping there isn't a $class object
- my $super_method = ( $pmc->name eq 'ParrotObject' || $pmc->name eq
'ParrotClass' )
- ? 'delegate' : 'default';
-
- $pmc->super_method($vt_method_name, $super_method);
- }
}
return 1;
}
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Emitter.pm Fri Jun 1 16:14:38 2007
@@ -1,5 +1,5 @@
# Copyright (C) 2004-2006, The Perl Foundation.
-# $Id: Parser.pm 18503 2007-05-11 07:39:22Z paultcochrane $
+# $Id$
package Parrot::Pmc2c::Emitter;
use strict;
use warnings;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Library.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Library.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Library.pm Fri Jun 1 16:14:38 2007
@@ -48,8 +48,7 @@
my %emitters;
foreach my $pmc ( values %pmcs ) {
- my $pmc_copy = $pmc->new($pmc);
- $emitters{$pmc->filename} = Parrot::Pmc2c::PMCEmitter->new( $pmc_copy,
$vtable_dump, $opt );
+ $emitters{$pmc->filename} = Parrot::Pmc2c::PMC->prep_for_emit($pmc,
$vtable_dump);
}
return bless {
@@ -59,7 +58,7 @@
}, $class;
}
-sub generate_libarary($$) {
+sub generate_library($$) {
my ( $self, $library_name ) = @_;
my $h_name = "$library_name.h";
my $c_name = "$library_name.c";
@@ -90,7 +89,7 @@
my $library_name = $self->{opt}{library};
if ($library_name) {
- generate_library( $self, $library_name);
+ generate_library($self, $library_name);
}
else {
for my $emitter ( values %{ $self->{emitters} } ) {
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Method.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Method.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Method.pm Fri Jun 1 16:14:38 2007
@@ -1,5 +1,5 @@
# Copyright (C) 2004-2006, The Perl Foundation.
-# $Id: Parser.pm 18503 2007-05-11 07:39:22Z paultcochrane $
+# $Id$
package Parrot::Pmc2c::Method;
use strict;
use warnings;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/MethodEmitter.pm Fri Jun 1 16:14:38 2007
@@ -1,6 +1,6 @@
# Copyright (C) 2004-2007, The Perl Foundation.
-# $Id: Pmc2c.pm 18426 2007-05-05 14:41:57Z bernhard $
+# $Id$
=head1 NAME
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC.pm Fri Jun 1 16:14:38 2007
@@ -1,5 +1,25 @@
# Copyright (C) 2004-2006, The Perl Foundation.
-# $Id: Parser.pm 18503 2007-05-11 07:39:22Z paultcochrane $
+# $Id: PMC
+# PMC.pm 18503 2007-05-11 07:39:22Z paultcochrane $
+#
+=head1 NAME
+
+Parrot::Pmc2c::PMC - PMC model object
+
+=head1 SYNOPSIS
+
+ use Parrot::Pmc2c::PMC;
+
+=head1 DESCRIPTION
+
+C<Parrot::Pmc2c::PMC> is used by F<tools/build/pmc2c.pl> to generate C code
from PMC files.
+
+=head2 Functions
+
+=over
+
+=cut
+
package Parrot::Pmc2c::PMC;
use strict;
use warnings;
@@ -10,6 +30,19 @@
use Parrot::Pmc2c::UtilFunctions qw(spew);
use Parrot::Pmc2c::Method;
+sub create {
+ my ( $this, $pmc_classname ) = @_;
+
+ my $classname = ref($this) || $this;
+
+ #test to see if specific subclass exists
+ eval "use ${classname}::$pmc_classname";
+ $classname = $@ ? "$classname" : "${classname}::${pmc_classname}";
+ my $self = Parrot::Pmc2c::PMC->new;
+ bless $self, $classname;
+ $self;
+}
+
sub new {
my ( $class, $self ) = @_;
$self = {} unless $self;
@@ -59,7 +92,7 @@
sub parent_has_method {
my ( $self, $parent_name, $vt_meth) = @_;
- return $self->{has_parent}{$parent_name}{$vt_meth};
+ return exists $self->{'has_parent'}{$parent_name}{$vt_meth};
}
#parents
@@ -75,7 +108,7 @@
Determines if a given PMC type is dynamically loaded or not.
-=item C<implements($method)>
+=item C<implements_vtable($method)>
True if pmc generates code for vtable method C<$method>.
@@ -166,7 +199,7 @@
}
sub set_flag {
my ( $self, $name, $value ) = @_;
- $self->{flags}->{$name} = ($value or 1);
+ $self->{flags}{$name} = ($value or 1);
return $self->flag($name);
}
sub set_flags {
@@ -194,7 +227,7 @@
}
sub flag {
my ( $self, $name ) = @_;
- return $self->{flags}->{$name};
+ return $self->{flags}{$name};
}
sub preamble {
my ( $self, $value ) = @_;
@@ -234,6 +267,8 @@
Returns true if the vtable method C<$method> writes our value.
+=back
+
=cut
sub vtable_method_does_write {
@@ -251,15 +286,13 @@
my $super_pmc_name;
if (ref($super_pmc)) {
$super_pmc_name = $super_pmc->name;
- #print "---- $vt_meth $super_pmc_name\n";
- #copy over the supers vt_meth attributes
+
my $super_method = $super_pmc->get_method($vt_meth);
$self->super_attrs($vt_meth, $super_method->attrs);
$self->inherit_attrs($vt_meth) if $self->get_method($vt_meth);
- #print Dumper($super_method);
my $super_mmd_rights = $super_method->mmd_rights;
if ( $super_mmd_rights && scalar @{$super_mmd_rights} ) {
$self->{super_mmd_rights}{$vt_meth}->{$super_pmc_name} =
$super_mmd_rights;
@@ -295,6 +328,7 @@
B<Comments:> Called within C<gen_super_meths()>.
+
=cut
sub inherit_attrs {
@@ -310,6 +344,31 @@
return $;
}
+=head2 These are auxiliary subroutines called inside the methods described
above.
+
+=head3 C<dump_is_current()>
+
+ dump_is_current($existing);
+
+B<Purpose:> Determines whether the dump of a file is newer than the PMC file.
+(If it's not, then the PMC file has changed and the dump has not been updated.)
+
+B<Arguments:> String holding filename.
+
+B<Return Values:> Returns true if timestamp of existing is more recent than
+that of PMC.
+
+B<Comments:> Called within C<dump_pmc()>.
+
+=cut
+
+sub dump_is_current {
+ my ( $self ) = @_;
+ my $dumpfile = $self->filename('.dump');
+ my $pmcfile = $self->filename('.pmc');
+ return 0 unless -e $dumpfile;
+ return ( stat $dumpfile )[9] > ( stat $pmcfile )[9];
+}
1;
Copied: branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm (from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Null.pm)
==============================================================================
--- /branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Null.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/Null.pm Fri Jun 1 16:14:38 2007
@@ -5,8 +5,8 @@
=cut
-package Parrot::Pmc2c::PMCEmitter::Null;
-use base 'Parrot::Pmc2c::PMCEmitter';
+package Parrot::Pmc2c::PMC::Null;
+use base 'Parrot::Pmc2c::PMC';
use strict;
use warnings;
use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
@@ -35,7 +35,7 @@
my $ret = "";
$ret = gen_ret($method);
my $output = <<EOC;
- real_exception(interp, NULL, NULL_REG_ACCESS, "Null PMC access in
$meth()");
+ real_exception(interp, NULL, NULL_REG_ACCESS, "Null PMC access in
$vt_method_name()");
EOC
$output .= $ret if $ret;
$new_default_method->body(Parrot::Pmc2c::Emitter->text($output));
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 Fri Jun 1 16:14:38 2007
@@ -1,6 +1,6 @@
# Copyright (C) 2004-2007, The Perl Foundation.
-# $Id: Pmc2c.pm 18426 2007-05-05 14:41:57Z bernhard $
+# $Id$
=head1 NAME
@@ -31,10 +31,9 @@
use Parrot::Pmc2c::Method;
use Parrot::Pmc2c::MethodEmitter;
use Parrot::Pmc2c::UtilFunctions
- qw( gen_ret dont_edit count_newlines dynext_load_code c_code_coda );
+qw( gen_ret dont_edit count_newlines dynext_load_code c_code_coda );
use Text::Balanced 'extract_bracketed';
use Parrot::Pmc2c::PCCMETHOD;
-use Parrot::Pmc2c::PMCEmitter::default;
=item C<make_RO($type)>
@@ -43,80 +42,87 @@
=cut
sub new {
- my ( $class, $parent ) = @_;
- my $classname = ref($parent) || $class;;
+ my ( $class, $parent ) = @_;
+ my $classname = ref($parent) || $class;;
- my $self = bless Parrot::Pmc2c::PMC->new(
+ my $self = bless Parrot::Pmc2c::PMC->new(
{
- parents => [ $parent->name, @{ $parent->parents } ], # prepend
self to parrent
- flags => { (%{ $parent->get_flags }), 'is_ro' => 1}, # copy
flags, set is_const
- name => $parent->name . "_ro", # set
pmcname
- vtable => $parent->vtable, # and
alias vtable
- parentname => $parent->name, # set
parentname
- super => { %{ $parent->{super} } },
+ parents => [ $parent->name, @{ $parent->parents } ], # prepend
self to parrent
+ flags => { (%{ $parent->get_flags }), 'is_ro' => 1}, # copy
flags, set is_const
+ name => $parent->name . "_ro", # set pmcname
+ vtable => $parent->vtable, # and alias
vtable
+ parentname => $parent->name, # set
parentname
}), $classname;
- $parent->set_flag('has_ro');
- {
- # autogenerate for nonstandard types
- # (XXX is this appropriate or do we want them to each be explicitly
cleared to have RO ?)
- no strict 'refs';
- if ( [EMAIL PROTECTED] ref($self) . '::ISA' } ) {
- @{ ref($self) . '::ISA' } =
"Parrot::Pmc2c::PMCEmitter::Standard::RO";
- }
+ $parent->set_flag('has_ro');
+
+ {
+ # autogenerate for nonstandard types
+ # (XXX is this appropriate or do we want them to each be explicitly
cleared to have RO ?)
+ no strict 'refs';
+ if ( [EMAIL PROTECTED] ref($self) . '::ISA' } ) {
+ @{ ref($self) . '::ISA' } = "Parrot::Pmc2c::PMC::RO";
}
-
- # FIXME support getting implementations from central superclass instead
- # (e.g. some ro_fail pseudoclass that generates an exception)
- foreach my $vt_method ( @{ $self->vtable->methods } ) {
- my $vt_method_name = $vt_method->name;
- if ( $vt_method_name eq 'find_method' ) {
- my $ro_method = Parrot::Pmc2c::Method->new({
- name => $vt_method_name,
- return_type => $vt_method->return_type,
- parameters => $vt_method->parameters,
- type => Parrot::Pmc2c::Method::VTABLE,
- });
- my $real_findmethod = 'Parrot_' . $self->{super}{find_method} .
'_find_method';
- my $body = <<"EOC";
+ }
+
+ # FIXME support getting implementations from central superclass instead
+ # (e.g. some ro_fail pseudoclass that generates an exception)
+ foreach my $vt_method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $vt_method->name;
+ if ( $vt_method_name eq 'find_method' ) {
+ my $ro_method = Parrot::Pmc2c::Method->new({
+ name => $vt_method_name,
+ return_type => $vt_method->return_type,
+ parameters => $vt_method->parameters,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
+ my $find_method_parent;
+ if ( $parent->implements_vtable($vt_method_name) ) {
+ $find_method_parent = $parent->name;
+ }
+ else {
+ $find_method_parent = $parent->{super}{$vt_method_name};
+ }
+ my $real_findmethod = 'Parrot_' . $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(interp,
"write"))))
return PMCNULL;
else
return method;
EOC
- $ro_method->body(Parrot::Pmc2c::Emitter->text($body));
- $self->add_method($ro_method);
- }
- elsif ( $parent->vtable_method_does_write($vt_method_name) ) {
- my $ro_method = Parrot::Pmc2c::Method->new({
- name => $vt_method_name,
- return_type => $vt_method->return_type,
- parameters => $vt_method->parameters,
- type => Parrot::Pmc2c::Method::VTABLE,
- });
- my $pmcname = $parent->name;
- my $ret = gen_ret($ro_method);
- my $body = <<EOC;
+ $ro_method->body(Parrot::Pmc2c::Emitter->text($body));
+ $self->add_method($ro_method);
+ }
+ elsif ( $parent->vtable_method_does_write($vt_method_name) ) {
+ my $ro_method = Parrot::Pmc2c::Method->new({
+ name => $vt_method_name,
+ return_type => $vt_method->return_type,
+ parameters => $vt_method->parameters,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ });
+ my $pmcname = $parent->name;
+ my $ret = gen_ret($ro_method);
+ my $body = <<EOC;
internal_exception(WRITE_TO_CONSTCLASS,
"$vt_method_name() in read-only instance of $pmcname");
EOC
- $body .= " $ret\n" if $ret;
- $ro_method->body(Parrot::Pmc2c::Emitter->text($body));
- $self->add_method($ro_method);
- }
- else {
- if ( $parent->implements_vtable($vt_method_name) ) {
- $self->{super}{$vt_method_name} = $parent->name;
- }
- else {
- $self->{super}{$vt_method_name} =
$parent->{super}{$vt_method_name};
- }
- }
+ $body .= " $ret\n" if $ret;
+ $ro_method->body(Parrot::Pmc2c::Emitter->text($body));
+ $self->add_method($ro_method);
+ }
+ else {
+ if ( $parent->implements_vtable($vt_method_name) ) {
+ $self->{super}{$vt_method_name} = $parent->name;
+ }
+ else {
+ $self->{super}{$vt_method_name} = $parent->{super}{$vt_method_name};
+ }
}
+ }
- return $self;
+ return $self;
}
1;
Copied: branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm (from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Ref.pm)
==============================================================================
--- /branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/Ref.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/Ref.pm Fri Jun 1 16:14:38 2007
@@ -5,8 +5,8 @@
=cut
-package Parrot::Pmc2c::PMCEmitter::Ref;
-use base 'Parrot::Pmc2c::PMCEmitter';
+package Parrot::Pmc2c::PMC::Ref;
+use base 'Parrot::Pmc2c::PMC';
use strict;
use warnings;
use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
Added: branches/pmc2c/lib/Parrot/Pmc2c/PMC/STMRef.pm
==============================================================================
--- (empty file)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/STMRef.pm Fri Jun 1 16:14:38 2007
@@ -0,0 +1,44 @@
+package Parrot::Pmc2c::PMC::STMRef;
+use base 'Parrot::Pmc2c::PMC::Ref';
+use strict;
+use warnings;
+
+=head1 Parrot::Pmc2c::STMRef Instance Methods
+
+=cut
+
+sub prederef {
+ my ( $self, $method ) = @_;
+ my $name = $method->name;
+
+ my $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->vtable_method_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:
Copied: branches/pmc2c/lib/Parrot/Pmc2c/PMC/SharedRef.pm (from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm)
==============================================================================
--- /branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/SharedRef.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/SharedRef.pm Fri Jun 1 16:14:38 2007
@@ -5,8 +5,8 @@
=cut
-package Parrot::Pmc2c::PMCEmitter::SharedRef;
-use base 'Parrot::Pmc2c::PMCEmitter::Ref';
+package Parrot::Pmc2c::PMC::SharedRef;
+use base 'Parrot::Pmc2c::PMC::Ref';
use strict;
use warnings;
Copied: branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm (from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/default.pm)
==============================================================================
--- /branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/default.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/default.pm Fri Jun 1 16:14:38 2007
@@ -1,16 +1,16 @@
-=head1 Parrot::Pmc2c::default Instance Methods
+=head1 Parrot::Pmc2c::PMC::default Instance Methods
=over 4
=cut
-package Parrot::Pmc2c::PMCEmitter::default;
+package Parrot::Pmc2c::PMC::default;
use strict;
use warnings;
use Data::Dumper;
use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
-use base qw( Parrot::Pmc2c::PMCEmitter );
+use base qw( Parrot::Pmc2c::PMC );
=item C<pre_method_gen()>
Copied: branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm (from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm)
==============================================================================
--- /branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/deleg_pmc.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm Fri Jun 1 16:14:38 2007
@@ -1,12 +1,14 @@
-package Parrot::Pmc2c::PMCEmitter::deleg_pmc;
-use base 'Parrot::Pmc2c::PMCEmitter';
+package Parrot::Pmc2c::PMC::deleg_pmc;
+use base 'Parrot::Pmc2c::PMC';
use strict;
use warnings;
use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
-=item C<body($method,)>
+=over 4
-Returns the C code for the method body.
+=item C<pre_method_gen()>
+
+Autogenerates a PMC deleg_pmc method.
Overrides the default implementation to direct all unknown methods to
the PMC in the first attribute slot.
@@ -22,21 +24,20 @@
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_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_$vt_method_name(interp,
attr$arg)" );
- $new_default_method->body(Parrot::Pmc2c::Emitter->text(<<"EOC"));
+ $new_method->body(Parrot::Pmc2c::Emitter->text(<<"EOC"));
PMC *attr = get_attrib_num(PMC_data_typed(pmc, SLOTTYPE *), 0);
$ret
EOC
-
- $new_default_method->type(Parrot::Pmc2c::Method::VTABLE);
- $self->add_method($new_default_method);
+ $new_method->type(Parrot::Pmc2c::Method::VTABLE);
+ $self->add_method($new_method);
}
-return 1;
+ return 1;
}
1;
Copied: branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm (from r18719,
/branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm)
==============================================================================
--- /branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter/delegate.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMC/delegate.pm Fri Jun 1 16:14:38 2007
@@ -1,12 +1,11 @@
-
=head1 Parrot::Pmc2c::delegate Instance Methods
=over 4
=cut
-package Parrot::Pmc2c::PMCEmitter::delegate;
-use base 'Parrot::Pmc2c::PMCEmitter';
+package Parrot::Pmc2c::PMC::delegate;
+use base 'Parrot::Pmc2c::PMC';
use strict;
use warnings;
@@ -16,8 +15,6 @@
The C<delegate> PMC redirects all methods to bytecode.
-=back
-
=cut
sub pre_method_gen {
@@ -29,13 +26,16 @@
next unless $self->normal_unimplemented_vtable($vt_method_name);
my $new_default_method = $method->clone();
my ( $func_ret, $ret_suffix, $args, $sig ) = $self->signature($method);
+ my $super_args = $args;
+ $super_args =~ s/^,//;
$new_default_method->body(Parrot::Pmc2c::Emitter->text(<<"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");
+ return SUPER($super_args);
+ /* 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);
@@ -76,6 +76,8 @@
Returns the method signature for C<$params>.
+=back
+
=cut
sub signature {
Modified: branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/PMCEmitter.pm Fri Jun 1 16:14:38 2007
@@ -1,14 +1,14 @@
=head1 NAME
-Parrot::Pmc2c - PMC to C Code Generation
+Parrot::Pmc2c::PMCEmitter - PMC to C Code Generation
=head1 SYNOPSIS
- use Parrot::Pmc2c;
+ use Parrot::Pmc2c::PMCEmitter;
=head1 DESCRIPTION
-C<Parrot::Pmc2c> is used by F<tools/build/pmc2c.pl> to generate C code from
PMC files.
+C<Parrot::Pmc2c::PMCEmitter> is used by F<tools/build/pmc2c.pl> to generate C
code from PMC files.
=head2 Functions
@@ -16,11 +16,9 @@
=cut
-package Parrot::Pmc2c::PMCEmitter;
+package Parrot::Pmc2c::PMC;
use strict;
use warnings;
-use base qw( Exporter Parrot::Pmc2c::PMC);
-our @EXPORT_OK = qw( );
use Data::Dumper;
use Parrot::Pmc2c::Emitter;
use Parrot::Pmc2c::Method;
@@ -30,28 +28,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 ) = @_;
-
- #determine blessed classname
- my $classname = ref($this) || $this;
- my $pmc_classname = $pmc_dump->name;
- #test to see if specific subclass exists
- eval "use ${classname}::$pmc_classname";
- $classname = $@ ? "${classname}::Standard" :
"${classname}::${pmc_classname}";
-
- bless $pmc_dump, $classname;
- $pmc_dump->vtable($vtable_dump);
- $pmc_dump->init();
- $pmc_dump;
+
+sub prep_for_emit {
+ my ( $this, $pmc, $vtable_dump ) = @_;
+
+ $pmc->vtable($vtable_dump);
+ $pmc->init();
+ $pmc;
}
sub generate {
@@ -80,7 +63,6 @@
$c->emit( "#define PARROT_IN_EXTENSION\n" ) if ( $self->is_dynamic );
$c->emit( $self->preamble );
$self->gen_includes;
- $self->pre_method_gen;
$self->gen_methods;
my $ro = $self->ro;
if ( $ro ) {
@@ -190,7 +172,7 @@
# (because the MRO will still be shared).
unless ( $self->implements_vtable('pmc_namespace')
or $self->super_method('pmc_namespace') ne 'default' ) {
- my $body = Parrot::Pmc2c::Emitter->text('{ return
INTERP->vtables[SELF->vtable->base_type]->_namespace; }');
+ 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',
parameters => '',
@@ -482,6 +464,7 @@
my $class_init_code = "";
$class_init_code = $self->get_method('class_init')->body if
$self->has_method('class_init');
$class_init_code =~ s/INTERP/interp/g;
+ $class_init_code =~ s/^/ /mg; #fix indenting
my %extra_vt;
@@ -618,7 +601,11 @@
$cout .= <<"EOC";
/* class_init */
EOC
- $cout .= " $class_init_code\n" if $class_init_code;
+ $cout .= <<"EOC" if $class_init_code;
+ {
+$class_init_code
+ }
+EOC
$cout .= <<"EOC";
{
@@ -678,10 +665,13 @@
True if this class generates code for the method C<$method>.
=cut
+
=item C<implements_vtable($method)>
True if this class generates code for VTABLE method C<$method>.
+=back
+
=cut
sub is_vtable_method {
@@ -696,21 +686,6 @@
return $self->{vtable};
}
-=back
-
-=cut
-=pod
-require Parrot::Pmc2c::default;
-require Parrot::Pmc2c::delegate;
-require Parrot::Pmc2c::deleg_pmc;
-require Parrot::Pmc2c::Null;
-require Parrot::Pmc2c::Ref;
-require Parrot::Pmc2c::SharedRef;
-require Parrot::Pmc2c::Standard;
-require Parrot::Pmc2c::StandardConst;
-require Parrot::Pmc2c::StandardRO;
-require Parrot::Pmc2c::StmRef;
-=cut
1;
# Local Variables:
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 Fri Jun 1
16:14:38 2007
@@ -1,10 +1,7 @@
-
=head1 Parrot::Pmc2c::Standard Instance Methods
Standard behavior.
-=over 4
-
=cut
package Parrot::Pmc2c::PMCEmitter::Standard;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Parser.pm Fri Jun 1 16:14:38 2007
@@ -60,7 +60,7 @@
my ($preamble, $pmcname, $flags, $parents, $pmcbody, $post, $chewed_lines)
= parse_top_level( $code );
- my $pmc = Parrot::Pmc2c::PMC->new();
+ my $pmc = Parrot::Pmc2c::PMC->create($pmcname);
$pmc->preamble( Parrot::Pmc2c::Emitter->text($preamble, $filename, 1));
$pmc->name($pmcname);
$pmc->set_filename($filename);
@@ -95,7 +95,9 @@
= ( $2, $3, $4, $5, parse_method_attrs($6));
( my $methodblock, $pmcbody ) = extract_balanced($pmcbody);
$methodblock = strip_outer_brackets($methodblock);
- $methodblock =~ s/^[ ]{4}//mg;
+ $methodblock =~ s/^[ ]{4}//mg; #remove pmclass 4 space indent
+ $methodblock =~ s/\n\s+$/\n/g; #trim trailing whitespace from lastline
+
my $method = Parrot::Pmc2c::Method->new( {
name => $methodname,
@@ -136,6 +138,8 @@
$pmc->postamble(Parrot::Pmc2c::Emitter->text($post, $filename, $lineno));
#ensure class_init is the last method in the method list
$pmc->add_method($class_init) if $class_init;
+ $pmc->vtable($pmc2cMain->read_dump("vtable.pmc"));
+ $pmc->pre_method_gen();
return $pmc;
}
@@ -151,13 +155,12 @@
$lineno += count_newlines($1);
my $right_type = $2;
$method->add_mmd_rights($right_type);
- my $mmd_part = extract_bracketed_body_text( \$body_text, '{' );
+ ( my $mmd_part, $body_text ) = extract_bracketed_body_text(
$body_text, '{' );
die "Empty MMD body near '$body_text'" if ( !$mmd_part );
my $mmd_part_lines = count_newlines($mmd_part);
- #$mmd_part =~ s/(\n\s*)$//s;
+ $mmd_part =~ s/\n\s*$/\n/s; #remove whitespace at end of last line
if ( $right_type eq 'DEFAULT' ) {
$default_body = $mmd_part;
- print "$right_type $default_body \n";
$default_body_lineno = $lineno;
}
else {
@@ -189,7 +192,8 @@
sub extract_bracketed_body_text {
my ( $body_text, $bracketed ) = @_;
- return strip_outer_brackets( extract_bracketed( $$body_text, $bracketed )
);
+ my ( $extracted, $remaining ) = extract_bracketed( $body_text, $bracketed
);
+ return ( strip_outer_brackets( $extracted ), $remaining );
}
@@ -265,8 +269,8 @@
return ($preamble, $pmcname, $flags, $parents, $body, $postamble,
$chewed_lines);
}
-our %has_value = map { $_ => 1 } qw(group lib hll);
-our %has_values = map { $_ => 1 } qw(does extends maps);
+our %has_value = map { $_ => 1 } qw(group hll);
+our %has_values = map { $_ => 1 } qw(does extends maps lib);
sub parse_flags {
my ( $data, $pmcname ) = @_;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/Pmc2cMain.pm Fri Jun 1 16:14:38 2007
@@ -12,6 +12,13 @@
use Parrot::Pmc2c::Library;
use Parrot::Pmc2c::UtilFunctions qw( slurp spew filename );
use Parrot::Pmc2c::PCCMETHOD;
+use Parrot::Pmc2c::PMC::default;
+use Parrot::Pmc2c::PMC::delegate;
+use Parrot::Pmc2c::PMC::deleg_pmc;
+use Parrot::Pmc2c::PMC::Null;
+use Parrot::Pmc2c::PMC::Ref;
+use Parrot::Pmc2c::PMC::SharedRef;
+use Parrot::Pmc2c::PMC::STMRef;
use Cwd qw(cwd realpath);
use File::Basename;
use Carp;
Modified: branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/UtilFunctions.pm Fri Jun 1 16:14:38 2007
@@ -96,7 +96,7 @@
Parrot_PMC pmc;
EOC
while ( my ( $class, $info ) = each %classes ) {
- next if $info->{flags}->{noinit};
+ next if $info->{flags}{noinit};
$cout .= <<"EOC";
Parrot_Int type${class};
EOC
@@ -118,7 +118,7 @@
*/
EOC
while ( my ( $class, $info ) = each %classes ) {
- my $lhs = $info->{flags}->{noinit} ? "" : "type$class = ";
+ my $lhs = $info->{flags}{noinit} ? "" : "type$class = ";
$cout .= <<"EOC";
whoami = const_string(interp, "$class");
${lhs}pmc_register(interp, whoami);
@@ -130,7 +130,7 @@
for (pass = 0; pass <= 1; ++pass) {
EOC
while ( my ( $class, $info ) = each %classes ) {
- next if $info->{flags}->{noinit};
+ next if $info->{flags}{noinit};
$cout .= <<"EOC";
Parrot_${class}_class_init(interp, type$class, pass);
EOC
Modified: branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm
==============================================================================
--- branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm (original)
+++ branches/pmc2c/lib/Parrot/Pmc2c/VTable.pm Fri Jun 1 16:14:38 2007
@@ -1,5 +1,5 @@
# Copyright (C) 2004-2006, The Perl Foundation.
-# $Id: Parser.pm 18503 2007-05-11 07:39:22Z paultcochrane $
+# $Id$
package Parrot::Pmc2c::VTable;
use strict;
use warnings;
