[svn:parrot] r49303 - branches/generational_gc/lib/Parrot/Pmc2c/PMC

bacek at svn.parrot.org bacek at svn.parrot.org
Sat Sep 25 00:56:52 UTC 2010


Author: bacek
Date: Sat Sep 25 00:56:52 2010
New Revision: 49303
URL: https://trac.parrot.org/parrot/changeset/49303

Log:
Add stub for WB vtable generator.

Added:
   branches/generational_gc/lib/Parrot/Pmc2c/PMC/WB.pm

Added: branches/generational_gc/lib/Parrot/Pmc2c/PMC/WB.pm
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/generational_gc/lib/Parrot/Pmc2c/PMC/WB.pm	Sat Sep 25 00:56:52 2010	(r49303)
@@ -0,0 +1,107 @@
+# Copyright (C) 2004-2009, Parrot Foundation.
+
+# $Id$
+
+=head1 NAME
+
+Parrot::Pmc2c - PMC to C Code Generation
+
+=head1 SYNOPSIS
+
+    use Parrot::Pmc2c;
+
+=head1 DESCRIPTION
+
+C<Parrot::Pmc2c> is used by F<tools/build/pmc2c.pl> to generate C code from PMC files.
+
+=head2 Functions
+
+=over
+
+=cut
+
+package Parrot::Pmc2c::PMC::WB;
+use strict;
+use warnings;
+use base qw( Parrot::Pmc2c::PMC );
+
+use Parrot::Pmc2c::Emitter ();
+use Parrot::Pmc2c::PMCEmitter ();
+use Parrot::Pmc2c::Method ();
+use Parrot::Pmc2c::UtilFunctions qw( return_statement );
+use Text::Balanced 'extract_bracketed';
+
+=item C<make_RO($type)>
+
+Create a RO version of the PMC
+
+=cut
+
+sub new {
+    my ( $class, $parent ) = @_;
+    my $classname = ref($parent) || $class;
+
+    my $self = bless Parrot::Pmc2c::PMC->new(
+        {
+            # prepend self to parent
+            parents => [ $parent->name, @{ $parent->parents } ],
+            # and alias vtable
+            vtable     => $parent->vtable,
+            # set parentname
+            parentname => $parent->name,
+        }
+    ), $classname;
+
+    {
+
+      # autogenerate for nonstandard types
+      # (TT #1240: is this appropriate or do we want them to each be
+      # explicitly cleared to have RO ?)
+        no strict 'refs';
+        if ( !@{ ref($self) . '::ISA' } ) {
+            @{ ref($self) . '::ISA' } = "Parrot::Pmc2c::PMC::WB";
+        }
+    }
+
+    foreach my $vt_method ( @{ $self->vtable->methods } ) {
+        my $name = $vt_method->name;
+
+        # Generate RO variant only if we override method constantness
+        # with ":write"
+        next unless $parent->{has_method}{$name}
+                    && $parent->vtable_method_does_write($name)
+                    && !$parent->vtable->attrs($name)->{write};
+
+        my $ro_method = Parrot::Pmc2c::Method->new(
+            {
+                name        => $name,
+                parent_name => $parent->name,
+                return_type => $vt_method->return_type,
+                parameters  => $vt_method->parameters,
+                type        => Parrot::Pmc2c::Method::VTABLE,
+                pmc_unused  => 1,
+            }
+        );
+        my $pmcname = $parent->name;
+        my $ret     = return_statement($ro_method);
+        my $body    = <<EOC;
+        /* Switch vtable here and redispatch to original method */
+EOC
+
+        # don't return after a Parrot_ex_throw_from_c_args
+        $ro_method->body( Parrot::Pmc2c::Emitter->text($body) );
+        $self->add_method($ro_method);
+    }
+
+    return $self;
+}
+
+
+1;
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:


More information about the parrot-commits mailing list