Ticket #1988: master.tt1988_pmcemitter.diff

MANIFEST

@@ -995 +995 @@
 lib/Parrot/Install.pm                                       [devel]lib
 lib/Parrot/Manifest.pm                                      [devel]lib
 lib/Parrot/Pmc2c/Attribute.pm                               [devel]lib
-lib/Parrot/Pmc2c/ComposedMethod.pm                          [devel]lib
 lib/Parrot/Pmc2c/Dumper.pm                                  [devel]lib
 lib/Parrot/Pmc2c/Emitter.pm                                 [devel]lib
 lib/Parrot/Pmc2c/Library.pm                                 [devel]lib
@@ -1007 +1006 @@
 lib/Parrot/Pmc2c/PMC.pm                                     [devel]lib
 lib/Parrot/Pmc2c/PMC/Null.pm                                [devel]lib
 lib/Parrot/Pmc2c/PMC/Object.pm                              [devel]lib
-lib/Parrot/Pmc2c/PMC/ParrotClass.pm                         [devel]lib
 lib/Parrot/Pmc2c/PMC/PrintTree.pm                           [devel]lib
 lib/Parrot/Pmc2c/PMC/RO.pm                                  [devel]lib
 lib/Parrot/Pmc2c/PMC/default.pm                             [devel]lib
-lib/Parrot/Pmc2c/PMCEmitter.pm                              [devel]lib
 lib/Parrot/Pmc2c/Parser.pm                                  [devel]lib
 lib/Parrot/Pmc2c/Pmc2cMain.pm                               [devel]lib
 lib/Parrot/Pmc2c/UtilFunctions.pm                           [devel]lib

config/auto/pmc.pm

@@ -62 +62 @@
     lib/Parrot/Pmc2c/Method.pm \\
     lib/Parrot/Pmc2c/PCCMETHOD.pm \\
     lib/Parrot/Pmc2c/MULTI.pm \\
-    lib/Parrot/Pmc2c/PMCEmitter.pm \\
     lib/Parrot/Pmc2c/MethodEmitter.pm \\
     lib/Parrot/Pmc2c/Library.pm \\
     lib/Parrot/Pmc2c/UtilFunctions.pm \\

lib/Parrot/Pmc2c/Dumper.pm

@@ -1 @@
-# Copyright (C) 2004-2009, Parrot Foundation.
+# Copyright (C) 2004-2011, Parrot Foundation.
 package Parrot::Pmc2c::Dumper;
 
 use strict;
@@ -144 +144 @@
 
 =head2 Subroutines
 
-
 =head3 C<gen_parent_reverse_lookup_info()>
 
     $class = gen_parent_reverse_lookup_info($name, $all, $vt);

lib/Parrot/Pmc2c/Library.pm

@@ -24 +24 @@
 use strict;
 use warnings;
 use File::Basename qw(basename);
-use Parrot::Pmc2c::PMCEmitter ();
+use Parrot::Pmc2c::PMC ();
 use Parrot::Pmc2c::UtilFunctions qw(dont_edit dynext_load_code c_code_coda spew);
 
 =item C<generate_library($library_name, $pmcs)>

lib/Parrot/Pmc2c/Method.pm

@@ -203 +203 @@
 =head1 SEE ALSO
 
     lib/Parrot/Pmc2c/PMC/RO.pm
-    lib/Parrot/Pmc2c/PMCEmitter.pm
     lib/Parrot/Pmc2c/VTable.pm
     lib/Parrot/Pmc2c/PMC.pm
     lib/Parrot/Pmc2c/Parser.pm

lib/Parrot/Pmc2c/PCCMETHOD.pm

@@ -5 +5 @@
 use warnings;
 use Carp qw(longmess croak);
 use Parrot::Pmc2c::PCCMETHOD_BITS;
+use Parrot::Pmc2c::UtilFunctions qw( trim );
 
 =head1 NAME
 
@@ -96 +97 @@
                       at => PARROT_ARG_PMC, },
 };
 
-# Perl trim function to remove whitespace from the start and end of the string
-sub trim {
-    my $string = shift;
-    $string    =~ s/^\s+//;
-    $string    =~ s/\s+$//;
-    return $string;
-}
-
-# Left trim function to remove leading whitespace
-sub ltrim {
-    my $string = shift;
-    $string    =~ s/^\s+//;
-    return $string;
-}
-
-# Right trim function to remove trailing whitespace
-sub rtrim {
-    my $string = shift;
-    $string    =~ s/\s+$//;
-    return $string;
-}
-
 =head3 C<parse_adverb_attributes>
 
   builds and returs an adverb hash from an adverb string such as

lib/Parrot/Pmc2c/PMC.pm

@@ -26 +26 @@
 our @EXPORT_OK = qw();
 use Storable ();
 use Parrot::PMC;
-use Parrot::Pmc2c::Method;
+use Parrot::Pmc2c::Emitter ();
+use Parrot::Pmc2c::Method ();
+use Parrot::Pmc2c::MethodEmitter ();
+use Parrot::Pmc2c::UtilFunctions qw(
+    dont_edit
+    dynext_load_code
+    c_code_coda
+    gen_multi_name
+);
+use Text::Balanced 'extract_bracketed';
+use Parrot::Pmc2c::PCCMETHOD ();
+use Parrot::Pmc2c::MULTI ();
+use Parrot::Pmc2c::PMC::RO ();
 
 sub create {
     my ( $this, $pmc_classname ) = @_;
@@ -443 +455 @@
     return ( stat $dumpfile )[9] >= ( stat $pmcfile )[9];
 }
 
+sub vtable {
+    my ( $self, $value ) = @_;
+    $self->{vtable} = $value if $value;
+    return $self->{vtable};
+}
+
+
+sub prep_for_emit {
+    my ( $this, $pmc, $vtable_dump ) = @_;
+
+    $pmc->vtable($vtable_dump);
+    $pmc->init();
+
+    return $pmc;
+}
+
+sub generate {
+    my ($self) = @_;
+    my $emitter = $self->{emitter} =
+        Parrot::Pmc2c::Emitter->new( $self->filename(".c") );
+
+    $self->generate_c_file;
+    $emitter->write_to_file;
+
+    $emitter = $self->{emitter} =
+        Parrot::Pmc2c::Emitter->new( $self->filename(".h", $self->is_dynamic) );
+
+    $self->generate_h_file;
+    $emitter->write_to_file;
+}
+
+=over 4
+
+=item C<generate_c_file()>
+
+Generates the C implementation file code for the PMC.
+
+=cut
+
+sub generate_c_file {
+    my ($self) = @_;
+    my $c      = $self->{emitter};
+
+    $c->emit( dont_edit( $self->filename ) );
+    if ($self->is_dynamic) {
+        $c->emit("#define PARROT_IN_EXTENSION\n");
+        $c->emit("#define CONST_STRING(i, s) Parrot_str_new_constant((i), s)\n");
+        $c->emit("#define CONST_STRING_GEN(i, s) Parrot_str_new_constant((i), s)\n");
+    }
+
+    $self->gen_includes;
+
+    # The PCC code needs Continuation-related macros from these headers.
+    $c->emit("#include \"pmc_continuation.h\"\n");
+    $c->emit("#include \"pmc_callcontext.h\"\n");
+
+    $c->emit( $self->preamble );
+
+    $c->emit( $self->hdecls );
+    $c->emit( $self->{ro}->hdecls ) if ( $self->{ro} );
+    $self->gen_methods;
+
+    my $ro = $self->ro;
+    if ($ro) {
+        $ro->{emitter} = $self->{emitter};
+        $ro->gen_methods;
+    }
+
+    $c->emit("#include \"pmc_default.h\"\n");
+
+    $c->emit( $self->update_vtable_func );
+    $c->emit( $self->get_vtable_func );
+    $c->emit( $self->get_mro_func );
+    $c->emit( $self->get_isa_func );
+    $c->emit( $self->pmc_class_init_func );
+    $c->emit( $self->init_func );
+    $c->emit( $self->postamble );
+
+    return 1;
+}
+
+=item C<generate_h_file()>
+
+Generates the C header file code for the PMC.
+
+=cut
+
+sub generate_h_file {
+    my ($self)  = @_;
+    my $h       = $self->{emitter};
+    my $uc_name = uc $self->name;
+    my $name    = $self->name;
+
+    $h->emit( dont_edit( $self->filename ) );
+    $h->emit(<<"EOH");
+
+#ifndef PARROT_PMC_${uc_name}_H_GUARD
+#define PARROT_PMC_${uc_name}_H_GUARD
+
+EOH
+
+    $h->emit("#define PARROT_IN_EXTENSION\n") if ( $self->is_dynamic );
+
+    # Emit available functions for work with vtables.
+    my $export = 'PARROT_EXPORT ';
+    if ($self->is_dynamic) {
+        $export = 'PARROT_DYNEXT_EXPORT ';
+        $h->emit("${export}VTABLE* Parrot_${name}_get_vtable_pointer(PARROT_INTERP);\n");
+        $h->emit("${export}void    Parrot_${name}_class_init(PARROT_INTERP, int, int);\n");
+    }
+
+    if ($name ne 'default') {
+        $h->emit("${export}VTABLE* Parrot_${name}_update_vtable(ARGMOD(VTABLE*));\n");
+        $h->emit("${export}VTABLE* Parrot_${name}_ro_update_vtable(ARGMOD(VTABLE*));\n");
+    }
+    $h->emit("${export}VTABLE* Parrot_${name}_get_vtable(PARROT_INTERP);\n");
+    $h->emit("${export}VTABLE* Parrot_${name}_ro_get_vtable(PARROT_INTERP);\n");
+    $h->emit("${export}PMC*    Parrot_${name}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro));\n");
+    $h->emit("${export}Hash*   Parrot_${name}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa));\n");
+
+
+    $self->gen_attributes;
+    $h->emit(<<"EOH");
+
+#endif /* PARROT_PMC_${uc_name}_H_GUARD */
+
+EOH
+    $h->emit( c_code_coda() );
+    return 1;
+}
+
+=item C<hdecls()>
+
+Returns the C code function declarations for all the methods for inclusion
+in the PMC's C header file.
+
+=cut
+
+sub hdecls {
+    my ($self) = @_;
+
+    my $hout;
+    my $name    = $self->name;
+    my $lc_name = $self->name;
+
+    # generate decls for all vtables in this PMC
+    foreach my $vt_method_name ( @{ $self->vtable->names } ) {
+        if ( $self->implements_vtable($vt_method_name) ) {
+            $hout .=
+                $self->get_method($vt_method_name)->generate_headers($self);
+        }
+    }
+
+    # generate decls for all nci methods in this PMC
+    foreach my $method ( @{ $self->{methods} } ) {
+        next if $method->is_vtable;
+        $hout .= $method->generate_headers($self);
+    }
+
+    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : '';
+
+    # class init decl
+    $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(ARGMOD(VTABLE*));\n"
+        unless $name eq 'default';
+
+    $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable(PARROT_INTERP);\n";
+
+    $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable_pointer(PARROT_INTERP);\n"
+        if ($self->is_dynamic);
+
+    $self->{hdecls} .= $hout;
+
+    return $self->{hdecls};
+}
+
+=back
+
+=head2 Instance Methods
+
+=over
+
+=item C<init()>
+
+Initializes the instance.
+
+=cut
+
+sub init {
+    my ($self) = @_;
+
+    #!( singleton or abstract ) everything else gets readonly version of
+    # methods too.
+
+    $self->ro( Parrot::Pmc2c::PMC::RO->new($self) )
+        unless $self->abstract or $self->singleton;
+}
+
+=item C<gen_includes()>
+
+Returns the C C<#include> for the header file of each of the PMC's superclasses.
+
+=cut
+
+sub gen_includes {
+    my ($self) = @_;
+    my $c      = $self->{emitter};
+
+    $c->emit(<<"EOC");
+#include "parrot/parrot.h"
+#include "parrot/extend.h"
+#include "parrot/dynext.h"
+EOC
+
+    $c->emit(qq{#include "pmc_fixedintegerarray.h"\n})
+        if $self->flag('need_fia_header');
+
+    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;
+}
+
+=item C<pre_method_gen>
+
+Generate switch-bases VTABLE for MULTI
+
+=cut
+
+sub pre_method_gen {
+    my ($self) = @_;
+
+    $self->gen_switch_vtable;
+
+    1;
+}
+
+=item C<gen_methods()>
+
+Returns the C code for the pmc methods.
+
+=cut
+
+sub gen_methods {
+    my ($self) = @_;
+
+    # vtables
+    foreach my $method ( @{ $self->vtable->methods } ) {
+        my $vt_method_name = $method->name;
+        next if $vt_method_name eq 'class_init';
+
+        if ( $self->implements_vtable($vt_method_name) ) {
+            $self->get_method($vt_method_name)->generate_body($self);
+        }
+    }
+
+    # methods
+    foreach my $method ( @{ $self->methods } ) {
+        next if $method->is_vtable;
+        $method->generate_body($self);
+    }
+}
+
+=item C<gen_attributes()>
+
+Returns the C code for the attribute struct definition.
+
+=cut
+
+sub gen_attributes {
+    my ($self)     = @_;
+    my $attributes = $self->attributes;
+
+    if ( @{$attributes} ) {
+
+        Parrot::Pmc2c::Attribute::generate_start( $attributes->[0], $self );
+
+        foreach my $attribute ( @{$attributes} ) {
+            $attribute->generate_declaration($self);
+        }
+
+        Parrot::Pmc2c::Attribute::generate_end( $attributes->[0], $self );
+
+        foreach my $attribute ( @{$attributes} ) {
+            $attribute->generate_accessor($self);
+        }
+    }
+}
+
+=item C<find_multi_functions()>
+
+Returns an arrayref of MULTI function names declared in the PMC. Used to
+initialize the multiple dispatch function list.
+
+=cut
+
+sub find_multi_functions {
+    my ($self)  = @_;
+
+    my $pmcname = $self->name;
+    my ( @multi_names );
+
+    foreach my $method ( @{ $self->methods } ) {
+        next unless $method->is_multi;
+        my $short_sig    = $method->{MULTI_short_sig};
+        my $full_sig     = $pmcname . "," . $method->{MULTI_full_sig};
+        my $functionname = 'Parrot_' . $pmcname . '_' . $method->name;
+        push @multi_names, [ $method->symbol, $short_sig, $full_sig,
+                             $pmcname, $functionname, $method ];
+    }
+    return ( \@multi_names );
+}
+
+sub build_full_c_vt_method_name {
+    my ( $self, $vt_method_name ) = @_;
+
+    my $implementor;
+    if ( $self->implements_vtable($vt_method_name) ) {
+        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};
+    }
+    else {
+        $implementor = "default";
+    }
+
+    return "Parrot_${implementor}_$vt_method_name";
+}
+
+=item C<vtable_flags()>
+
+Returns C code to produce a PMC's flags.
+
+=cut
+
+sub vtable_flags {
+    my ($self) = @_;
+
+    my $vtbl_flag = 0;
+    $vtbl_flag .= '|VTABLE_PMC_IS_SINGLETON'  if $self->flag('singleton');
+    $vtbl_flag .= '|VTABLE_IS_SHARED_FLAG'    if $self->flag('is_shared');
+    $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;
+        push @vt_methods,
+            $self->build_full_c_vt_method_name( $vt_method->name );
+    }
+
+    my $methlist = join( ",\n        ", @vt_methods );
+
+    my $cout = <<ENDOFCODE;
+    const VTABLE $temp_struct_name = {
+        NULL,       /* namespace */
+        $enum_name, /* base_type */
+        NULL,       /* whoami */
+        $vtbl_flag, /* flags */
+        NULL,       /* provides_str */
+        NULL,       /* isa_hash */
+        NULL,       /* class */
+        NULL,       /* mro */
+        NULL,       /* attribute_defs */
+        NULL,       /* ro_variant_vtable */
+        $methlist,
+        0           /* attr size */
+    };
+ENDOFCODE
+    return $cout;
+}
+
+=item C<pmc_class_init_func()>
+
+Returns the C code for the PMC's class_init function as a static
+function to be called from the exported class_init.
+
+=cut
+
+sub pmc_class_init_func {
+    my ($self) = @_;
+    my $class_init_code = "";
+
+    if ($self->has_method('class_init')) {
+        $class_init_code .= $self->get_method('class_init')->body;
+
+        $class_init_code =~ s/INTERP/interp/g;
+
+        # fix indenting
+        $class_init_code =~ s/^/    /mg;
+        $class_init_code = <<ENDOFCODE
+static void thispmc_class_init(PARROT_INTERP, int entry)
+{
+$class_init_code
+}
+ENDOFCODE
+    }
+    return $class_init_code;
+}
+
+=item C<init_func()>
+
+Returns the C code for the PMC's initialization method, or an empty
+string if the PMC has a C<no_init> flag.
+
+=cut
+
+sub init_func {
+    my ($self) = @_;
+    return '' if $self->no_init;
+
+    my $cout        = '';
+    my $classname   = $self->name;
+    my $enum_name   = $self->is_dynamic ? -1 : "enum_class_$classname";
+    my $multi_funcs = $self->find_multi_functions();
+
+    my @multi_list;
+    my %strings_seen;
+    my $multi_strings = '';
+    my $cache         = {};
+
+    my $i = 0;
+    for my $multi (@$multi_funcs) {
+        my ($name, $ssig, $fsig, $ns, $func) = @$multi;
+        my ($name_str, $ssig_str, $fsig_str, $ns_name)     =
+            map { gen_multi_name($_, $cache) } ($name, $ssig, $fsig, $ns);
+
+        for my $s ([$name, $name_str],
+                   [$ssig, $ssig_str],
+                   [$fsig, $fsig_str],
+                   [$ns,   $ns_name ]) {
+            my ($raw_string, $name) = @$s;
+            next if $strings_seen{$name}++;
+            $multi_strings .=  "            STRING * const $name = "
+                           . qq|CONST_STRING_GEN(interp, "$raw_string");\n|;
+        }
+
+        push @multi_list, <<END_MULTI_LIST;
+            _temp_multi_func_list[$i].multi_name = $name_str;
+            _temp_multi_func_list[$i].short_sig = $ssig_str;
+            _temp_multi_func_list[$i].full_sig = $fsig_str;
+            _temp_multi_func_list[$i].ns_name = $ns_name;
+            _temp_multi_func_list[$i].func_ptr = (funcptr_t) $func;
+END_MULTI_LIST
+        $i++;
+
+    }
+
+    my $multi_list_size = @multi_list;
+    my $multi_list = join( "\n", @multi_list);
+
+    my $provides        = join( " ", keys( %{ $self->{flags}{provides} } ) );
+    my $class_init_code = "";
+
+    if ($self->has_method('class_init')) {
+        $class_init_code .= "        thispmc_class_init(interp, entry);\n";
+    }
+
+    my %extra_vt;
+    $extra_vt{ro} = $self->{ro} if $self->{ro};
+
+    $cout .= <<"EOC";
+void
+Parrot_${classname}_class_init(PARROT_INTERP, int entry, int pass)
+{
+    static const char attr_defs [] =
+EOC
+    $cout .= '        "';
+
+    my $attributes = $self->attributes;
+    foreach my $attribute ( @$attributes ) {
+        my $attrtype       = $attribute->{type};
+        my $attrname       = $attribute->{name};
+        my $typeid = ':'; # Unhandled
+        if($attrname =~ m/\(*(\w+)\)\(.*?\)/) {
+            $attrname = $1;
+        }
+        elsif ($attrtype eq "INTVAL") {
+            $typeid = 'I';
+        }
+        elsif ($attrtype eq "FLOATVAL") {
+            $typeid = 'F';
+        }
+        elsif ($attrtype =~ /STRING\s*\*$/) {
+            $typeid = 'S';
+        }
+        elsif ($attrtype =~ /PMC\s*\*$/) {
+            $typeid = 'F';
+        }
+
+        $cout .= $typeid;
+        $cout .= $attrname;
+        $cout .= ' ';
+    }
+
+    $cout .= "\";\n";
+
+    my $const = ( $self->{flags}{dynpmc} ) ? " " : " const ";
+
+    my $flags = $self->vtable_flags;
+    $cout .= <<"EOC";
+    if (pass == 0) {
+        VTABLE * const vt  = Parrot_${classname}_get_vtable(interp);
+        vt->base_type      = $enum_name;
+        vt->flags          = $flags;
+        vt->attribute_defs = attr_defs;
+        interp->vtables[entry] = vt;
+
+EOC
+
+    # init vtable slot
+    if ( $self->is_dynamic ) {
+        $cout .= <<"EOC";
+        vt->base_type    = entry;
+        vt->whoami       = Parrot_str_new_init(interp, "$classname", @{[length($classname)]},
+                                       Parrot_ascii_encoding_ptr, PObj_constant_FLAG|PObj_external_FLAG);
+        vt->provides_str = Parrot_str_concat(interp, vt->provides_str,
+            Parrot_str_new_init(interp, "$provides", @{[length($provides)]}, Parrot_ascii_encoding_ptr,
+            PObj_constant_FLAG|PObj_external_FLAG));
+
+EOC
+    }
+    else {
+        $cout .= <<"EOC";
+        vt->whoami       = CONST_STRING_GEN(interp, "$classname");
+        vt->provides_str = CONST_STRING_GEN(interp, "$provides");
+EOC
+    }
+
+    $cout .= <<"EOC";
+        vt->isa_hash     = Parrot_${classname}_get_isa(interp, NULL);
+EOC
+
+    for my $k ( keys %extra_vt ) {
+        my $k_flags = $self->$k->vtable_flags;
+        $cout .= <<"EOC";
+        {
+            VTABLE                   *vt_$k;
+            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;
+
+            vt_${k}->base_type           = entry;
+            vt_${k}->whoami              = vt->whoami;
+            vt_${k}->provides_str        = vt->provides_str;
+            vt->${k}_variant_vtable      = vt_${k};
+            vt_${k}->${k}_variant_vtable = vt;
+            vt_${k}->isa_hash            = vt->isa_hash;
+        }
+
+EOC
+    }
+
+    $cout .= <<"EOC";
+    }
+    else { /* pass */
+EOC
+
+    # To make use of the .HLL directive, register any mapping...
+    if ( $self->{flags}{hll} && $self->{flags}{maps} ) {
+
+        my $hll = $self->{flags}{hll};
+        $cout .= <<"EOC";
+
+        {
+            /* Register this PMC as a HLL mapping */
+            const INTVAL hll_id = Parrot_hll_get_HLL_id( interp, CONST_STRING_GEN(interp, "$hll"));
+            if (hll_id > 0) {
+EOC
+        foreach my $maps ( sort keys %{ $self->{flags}{maps} } ) {
+            $cout .= <<"EOC";
+                Parrot_hll_register_HLL_type( interp, hll_id, enum_class_$maps, entry);
+EOC
+        }
+        $cout .= <<"EOC";
+            }
+        } /* Register */
+EOC
+    }
+
+        $cout .= <<"EOC";
+        {
+            VTABLE * const vt  = interp->vtables[entry];
+
+            vt->mro = Parrot_${classname}_get_mro(interp, PMCNULL);
+
+            if (vt->ro_variant_vtable)
+                vt->ro_variant_vtable->mro = vt->mro;
+        }
+
+        /* set up MRO and _namespace */
+        Parrot_pmc_create_mro(interp, entry);
+EOC
+
+    # declare each nci method for this class
+    foreach my $method ( @{ $self->{methods} } ) {
+        next unless $method->type eq Parrot::Pmc2c::Method::NON_VTABLE;
+
+        #these differ for METHODs
+        my $method_name     = $method->name;
+        my $symbol_name     = $method->symbol;
+        my ($pcc_signature) = $method->pcc_signature;
+
+        $cout .= <<"EOC";
+        {
+            STRING *method_name = CONST_STRING_GEN(interp, "$symbol_name");
+            STRING *signature   = CONST_STRING_GEN(interp, "$pcc_signature");
+            register_native_pcc_method_in_ns(interp, entry,
+                F2DPTR(Parrot_${classname}_${method_name}),
+                method_name, signature);
+        }
+EOC
+        if ( $method->{attrs}{write} ) {
+            $cout .= <<"EOC";
+        Parrot_mark_method_writes(interp, entry, "$symbol_name");
+EOC
+        }
+    }
+
+    # include any class specific init code from the .pmc file
+    if ($class_init_code) {
+        $cout .= <<"EOC";
+
+        /* class_init */
+$class_init_code
+
+EOC
+    }
+
+    $cout .= <<"EOC";
+        {
+EOC
+
+
+    if ( @$multi_funcs ) {
+        # Don't const the list, breaks some older C compilers
+        $cout .= $multi_strings . <<"EOC";
+
+            multi_func_list _temp_multi_func_list[$multi_list_size];
+$multi_list
+            Parrot_mmd_add_multi_list_from_c_args(interp,
+                _temp_multi_func_list, $multi_list_size);
+EOC
+    }
+
+    $cout .= <<"EOC";
+        }
+    } /* pass */
+} /* Parrot_${classname}_class_init */
+EOC
+
+    if ( $self->is_dynamic ) {
+        $cout .= dynext_load_code( $classname, $classname => {} );
+    }
+
+    $cout;
+}
+
+=item C<update_vtable_func()>
+
+Returns the C code for the PMC's update_vtable.
+
+=cut
+
+sub update_vtable_func {
+    my ($self) = @_;
+
+    my $cout      = "";
+    my $classname = $self->name;
+    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
+
+    # Sets the attr_size field:
+    # - If the auto_attrs flag is set, use the current data.
+    # - If manual_attrs is set, set to 0.
+    # - If none is set, check if this PMC has init or init_pmc vtable functions,
+    # setting it to 0 in that case, and keeping the value from the
+    # parent otherwise.
+    my $set_attr_size = '';
+    my $flag_auto_attrs = $self->{flags}{auto_attrs};
+    my $flag_manual_attrs = $self->{flags}{manual_attrs};
+    die 'manual_attrs and auto_attrs can not be used together'
+         . 'in PMC ' . $self->name
+        if ($flag_auto_attrs && $flag_manual_attrs);
+    die 'PMC ' . $self->name . ' has attributes but no auto_attrs or manual_attrs'
+        if (@{$self->attributes} && ! ($flag_auto_attrs || $flag_manual_attrs));
+
+    if ( @{$self->attributes} &&  $flag_auto_attrs) {
+        $set_attr_size .= "sizeof(Parrot_${classname}_attributes)";
+    }
+    else {
+        $set_attr_size .= "0" if $flag_manual_attrs ||
+                                 exists($self->{has_method}{init}) ||
+                                 exists($self->{has_method}{init_pmc});
+    }
+    $set_attr_size =     "    vt->attr_size = " . $set_attr_size . ";\n"
+        if $set_attr_size ne '';
+
+    my $vtable_updates = '';
+    for my $name ( @{ $self->vtable->names } ) {
+        if (exists $self->{has_method}{$name}) {
+            $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n";
+        }
+    }
+
+    $vtable_updates .= $set_attr_size;
+
+    $cout .= <<"EOC";
+
+$export
+VTABLE *Parrot_${classname}_update_vtable(VTABLE *vt) {
+$vtable_updates
+    return vt;
+}
+
+EOC
+
+    # Generate RO vtable for implemented non-updating methods
+    $vtable_updates = '';
+    foreach my $name ( @{ $self->vtable->names} ) {
+        next unless exists $self->{has_method}{$name};
+        if ($self->vtable_method_does_write($name)) {
+            # If we override constantness status of vtable
+            if (!$self->vtable->attrs($name)->{write}) {
+                $vtable_updates .= "    vt->$name = Parrot_${classname}_ro_${name};\n";
+            }
+        }
+        else {
+            $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n";
+        }
+    }
+
+    $vtable_updates .= $set_attr_size;
+
+    $cout .= <<"EOC";
+
+$export
+VTABLE *Parrot_${classname}_ro_update_vtable(ARGMOD(VTABLE *vt)) {
+$vtable_updates
+    return vt;
+}
+
+EOC
+
+    $cout;
+}
+
+=item C<get_mro_func()>
+
+Returns the C code for the PMC's get_mro function.
+
+=cut
+
+sub get_mro_func {
+    my ($self) = @_;
+
+    my $cout      = "";
+    my $classname = $self->name;
+    my $get_mro = '';
+    my @parent_names;
+    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
+
+    if ($classname ne 'default') {
+        for my $dp (reverse @{ $self->direct_parents}) {
+            $get_mro .= "    mro = Parrot_${dp}_get_mro(interp, mro);\n"
+            unless $dp eq 'default';
+        }
+    }
+
+    $cout .= <<"EOC";
+$export
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC* Parrot_${classname}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro)) {
+    if (PMC_IS_NULL(mro)) {
+        mro = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+    }
+$get_mro
+    VTABLE_unshift_string(interp, mro,
+        Parrot_str_new_init(interp, "$classname", @{[length($classname)]},
+            Parrot_default_encoding_ptr, 0));
+    return mro;
+}
+
+EOC
+
+    $cout;
+}
+
+=item C<get_isa_func()>
+
+Returns the C code for the PMC's get_isa function.
+
+=cut
+
+sub get_isa_func {
+    my ($self) = @_;
+
+    my $cout      = "";
+    my $classname = $self->name;
+    my $get_isa = '';
+    my @parent_names;
+    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
+
+    if ($classname ne 'default') {
+        for my $dp (reverse @{ $self->direct_parents}) {
+            $get_isa .= "    isa = Parrot_${dp}_get_isa(interp, isa);\n"
+            unless $dp eq 'default';
+        }
+    }
+
+    $cout .= <<"EOC";
+$export
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+Hash* Parrot_${classname}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa)) {
+EOC
+
+    if ($get_isa ne '') {
+        $cout .= $get_isa;
+    }
+    else {
+        $cout .= <<"EOC";
+    if (isa == NULL) {
+        isa = Parrot_hash_new(interp);
+    }
+EOC
+    }
+    $cout .= <<"EOC";
+    Parrot_hash_put(interp, isa, (void *)(CONST_STRING_GEN(interp, "$classname")), PMCNULL);
+    return isa;
+}
+
+EOC
+
+    $cout;
+}
+
+
+=item C<get_vtable_func()>
+
+Returns the C code for the PMC's update_vtable.
+
+=cut
+
+sub get_vtable_func {
+    my ($self) = @_;
+
+    my $cout      = "";
+    my $classname = $self->name;
+    my @other_parents = reverse @{ $self->direct_parents };
+    my $first_parent = shift @other_parents;
+    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
+
+    my $get_vtable = '';
+
+    if ($first_parent eq 'default') {
+        $get_vtable .= "    vt = Parrot_default_get_vtable(interp);\n";
+    }
+    else {
+        $get_vtable .= "    vt = Parrot_${first_parent}_get_vtable(interp);\n";
+    }
+
+    foreach my $parent_name ( @other_parents) {
+        $get_vtable .= "    Parrot_${parent_name}_update_vtable(vt);\n";
+    }
+
+    $get_vtable .= "    Parrot_${classname}_update_vtable(vt);\n";
+
+    $cout .= <<"EOC";
+$export
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) {
+    VTABLE *vt;
+$get_vtable
+    return vt;
+}
+
+EOC
+
+    my $get_extra_vtable = '';
+
+    if ($first_parent eq 'default') {
+        $get_extra_vtable .= "    vt = Parrot_default_ro_get_vtable(interp);\n";
+    }
+    else {
+        $get_extra_vtable .= "    vt = Parrot_${first_parent}_ro_get_vtable(interp);\n";
+    }
+
+    foreach my $parent_name ( @other_parents ) {
+        $get_extra_vtable .= "    Parrot_${parent_name}_ro_update_vtable(vt);\n";
+    }
+
+    if ($self->is_dynamic) {
+        # The C could be optimized, but the case when Parrot_x_get_vtable_pointer
+        # is needed is very rare.  See TT #898 for more info.
+        $cout .= <<"EOC";
+$export
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+VTABLE* Parrot_${classname}_get_vtable_pointer(PARROT_INTERP) {
+    STRING *type_name = Parrot_str_new_constant(interp, "${classname}");
+    INTVAL  type_num  = Parrot_pmc_get_type_str(interp, type_name);
+    return interp->vtables[type_num];
+}
+
+EOC
+    }
+
+    $get_extra_vtable .= "    Parrot_${classname}_ro_update_vtable(vt);\n";
+
+    $cout .= <<"EOC";
+$export
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+VTABLE* Parrot_${classname}_ro_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);
+    return 0;
+}
+
+=item C<gen_switch_vtable>
+
+Generate switch-bases VTABLE for MULTI
+
+=back
+
+=cut
+
+sub gen_switch_vtable {
+    my ($self) = @_;
+
+    # No cookies for DynPMC. At least not now.
+    return 1 if $self->is_dynamic;
+
+    # Convert list of multis to name->[(type,,ssig,fsig,ns,func)] hash.
+    my %multi_methods;
+    foreach (@{$self->find_multi_functions}) {
+        my ($name, $ssig, $fsig, $ns, $func, $method) = @$_;
+        my @sig = split /,/, $fsig;
+        push @{ $multi_methods{ $name } }, [ $sig[1], $ssig, $fsig, $ns, $func, $method ];
+    }
+
+    # vtables
+    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);
+        next unless exists $multi_methods{$vt_method_name};
+
+        my $multis = $multi_methods{$vt_method_name};
+
+        # Get parameters.      strip type from param
+        my @parameters = map { s/(\s*\S+\s*\*?\s*)//; $_ } split (/,/, $method->parameters);
+
+        # Gather "case :"
+        my @cases = map { $self->generate_single_case($vt_method_name, $_, @parameters) } @$multis;
+        my $cases = join "", @cases;
+
+        my $body = <<"BODY";
+    INTVAL type = VTABLE_type(INTERP, $parameters[0]);
+    /* For dynpmc fallback to MMD */
+    if ((type >= enum_class_core_max) || (SELF.type() >= enum_class_core_max))
+        type = enum_class_core_max;
+    switch(type) {
+$cases
+    }
+BODY
+
+        my $vtable = $method->clone({
+                body => Parrot::Pmc2c::Emitter->text($body),
+            });
+        $self->add_method($vtable);
+    }
+
+    1;
+}
+
+# Generate single case for switch VTABLE
+sub generate_single_case {
+    my ($self, $vt_method_name, $multi, @parameters) = @_;
+
+    my ($type, $ssig, $fsig, $ns, $func, $impl) = @$multi;
+    my $case;
+
+    # Gather parameters names
+    my $parameters = join ', ', @parameters;
+    # ISO C forbids return with expression from void functions.
+    my $return = $impl->return_type =~ /^void\s*$/
+                    ? ''
+                    : 'return ';
+
+    if ($type eq 'DEFAULT' || $type eq 'PMC') {
+        # For default case we have to handle return manually.
+        my ($pcc_signature, $retval, $call_tail, $pcc_return)
+                = $self->gen_defaul_case_wrapping($ssig, @parameters);
+        my $dispatch = "Parrot_mmd_multi_dispatch_from_c_args(INTERP, \"$vt_method_name\", \"$pcc_signature\", SELF, $parameters$call_tail);";
+
+        $case = <<"CASE";
+        case enum_class_core_max:
+CASE
+        if ($retval eq '') {
+        $case .= <<"CASE";
+            $dispatch
+CASE
+        }
+        else {
+        $case .= <<"CASE";
+            {
+                $retval
+                $dispatch
+                $pcc_return
+            }
+CASE
+        }
+        $case .= <<"CASE";
+            break;
+        default:
+            $return$func(INTERP, SELF, $parameters);
+            break;
+CASE
+    }
+    else {
+        $case = <<"CASE";
+        case enum_class_$type:
+            $return$func(INTERP, SELF, $parameters);
+            break;
+CASE
+    }
+
+    $case;
+}
+
+# Generate (pcc_signature, retval holder, pcc_call_tail, return statement)
+# for default case in switch.
+sub gen_defaul_case_wrapping {
+    my ($self, $ssig, @parameters) = @_;
+
+    my $letter = substr($ssig, 0, 1);
+    if ($letter eq 'I') {
+        return (
+            "PP->" . $letter,
+            "INTVAL retval;",
+            ', &retval',
+            'return retval;',
+        );
+    }
+    elsif ($letter eq 'S') {
+        return (
+            "PP->" . $letter,
+            "STRING *retval;",
+            ', &retval',
+            'return retval;',
+        );
+    }
+    elsif ($letter eq 'P') {
+        return (
+            'PPP->P',
+            'PMC *retval = PMCNULL;',
+            ", &retval",
+            "return retval;",
+        );
+    }
+    elsif ($letter eq 'v') {
+        return (
+            'PP->',
+            '',
+            '',
+            'return;',
+        );
+    }
+    else {
+        die "Can't handle signature $ssig!";
+    }
+}
 1;
 
 # Local Variables:

lib/Parrot/Pmc2c/PMC/RO.pm

@@ -25 +25 @@
 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';

(a) a/lib/Parrot/Pmc2c/PMCEmitter.pm vs. (b) /dev/null

@@ -1 @@
-# Copyright (C) 2007-2011, Parrot Foundation.
-
-=head1 NAME
-
-Parrot::Pmc2c::PMCEmitter - PMC to C Code Generation
-
-=head1 SYNOPSIS
-
-    use Parrot::Pmc2c::PMCEmitter;
-
-=head1 DESCRIPTION
-
-C<Parrot::Pmc2c::PMCEmitter> 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;
-use Parrot::Pmc2c::Emitter ();
-use Parrot::Pmc2c::Method ();
-use Parrot::Pmc2c::MethodEmitter ();
-use Parrot::Pmc2c::UtilFunctions qw( dont_edit dynext_load_code c_code_coda );
-use Text::Balanced 'extract_bracketed';
-use Parrot::Pmc2c::PCCMETHOD ();
-use Parrot::Pmc2c::MULTI ();
-use Parrot::Pmc2c::PMC::RO ();
-use Parrot::Pmc2c::PMC::ParrotClass ();
-
-sub prep_for_emit {
-    my ( $this, $pmc, $vtable_dump ) = @_;
-
-    $pmc->vtable($vtable_dump);
-    $pmc->init();
-
-    return $pmc;
-}
-
-sub generate {
-    my ($self) = @_;
-    my $emitter = $self->{emitter} =
-        Parrot::Pmc2c::Emitter->new( $self->filename(".c") );
-
-    $self->generate_c_file;
-    $emitter->write_to_file;
-
-    $emitter = $self->{emitter} =
-        Parrot::Pmc2c::Emitter->new( $self->filename(".h", $self->is_dynamic) );
-
-    $self->generate_h_file;
-    $emitter->write_to_file;
-}
-
-=item C<generate_c_file()>
-
-Generates the C implementation file code for the PMC.
-
-=cut
-
-sub generate_c_file {
-    my ($self) = @_;
-    my $c      = $self->{emitter};
-
-    $c->emit( dont_edit( $self->filename ) );
-    if ($self->is_dynamic) {
-        $c->emit("#define PARROT_IN_EXTENSION\n");
-        $c->emit("#define CONST_STRING(i, s) Parrot_str_new_constant((i), s)\n");
-        $c->emit("#define CONST_STRING_GEN(i, s) Parrot_str_new_constant((i), s)\n");
-    }
-
-    $self->gen_includes;
-
-    # The PCC code needs Continuation-related macros from these headers.
-    $c->emit("#include \"pmc_continuation.h\"\n");
-    $c->emit("#include \"pmc_callcontext.h\"\n");
-
-    $c->emit( $self->preamble );
-
-    $c->emit( $self->hdecls );
-    $c->emit( $self->{ro}->hdecls ) if ( $self->{ro} );
-    $self->gen_methods;
-
-    my $ro = $self->ro;
-    if ($ro) {
-        $ro->{emitter} = $self->{emitter};
-        $ro->gen_methods;
-    }
-
-    $c->emit("#include \"pmc_default.h\"\n");
-
-    $c->emit( $self->update_vtable_func );
-    $c->emit( $self->get_vtable_func );
-    $c->emit( $self->get_mro_func );
-    $c->emit( $self->get_isa_func );
-    $c->emit( $self->pmc_class_init_func );
-    $c->emit( $self->init_func );
-    $c->emit( $self->postamble );
-
-    return 1;
-}
-
-=item C<generate_h_file()>
-
-Generates the C header file code for the PMC.
-
-=cut
-
-sub generate_h_file {
-    my ($self)  = @_;
-    my $h       = $self->{emitter};
-    my $uc_name = uc $self->name;
-    my $name    = $self->name;
-
-    $h->emit( dont_edit( $self->filename ) );
-    $h->emit(<<"EOH");
-
-#ifndef PARROT_PMC_${uc_name}_H_GUARD
-#define PARROT_PMC_${uc_name}_H_GUARD
-
-EOH
-
-    $h->emit("#define PARROT_IN_EXTENSION\n") if ( $self->is_dynamic );
-
-    # Emit available functions for work with vtables.
-    my $export = 'PARROT_EXPORT ';
-    if ($self->is_dynamic) {
-        $export = 'PARROT_DYNEXT_EXPORT ';
-        $h->emit("${export}VTABLE* Parrot_${name}_get_vtable_pointer(PARROT_INTERP);\n");
-        $h->emit("${export}void    Parrot_${name}_class_init(PARROT_INTERP, int, int);\n");
-    }
-
-    if ($name ne 'default') {
-        $h->emit("${export}VTABLE* Parrot_${name}_update_vtable(ARGMOD(VTABLE*));\n");
-        $h->emit("${export}VTABLE* Parrot_${name}_ro_update_vtable(ARGMOD(VTABLE*));\n");
-    }
-    $h->emit("${export}VTABLE* Parrot_${name}_get_vtable(PARROT_INTERP);\n");
-    $h->emit("${export}VTABLE* Parrot_${name}_ro_get_vtable(PARROT_INTERP);\n");
-    $h->emit("${export}PMC*    Parrot_${name}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro));\n");
-    $h->emit("${export}Hash*   Parrot_${name}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa));\n");
-
-
-    $self->gen_attributes;
-    $h->emit(<<"EOH");
-
-#endif /* PARROT_PMC_${uc_name}_H_GUARD */
-
-EOH
-    $h->emit( c_code_coda() );
-    return 1;
-}
-
-=item C<hdecls()>
-
-Returns the C code function declarations for all the methods for inclusion
-in the PMC's C header file.
-
-=cut
-
-sub hdecls {
-    my ($self) = @_;
-
-    my $hout;
-    my $name    = $self->name;
-    my $lc_name = $self->name;
-
-    # generate decls for all vtables in this PMC
-    foreach my $vt_method_name ( @{ $self->vtable->names } ) {
-        if ( $self->implements_vtable($vt_method_name) ) {
-            $hout .=
-                $self->get_method($vt_method_name)->generate_headers($self);
-        }
-    }
-
-    # generate decls for all nci methods in this PMC
-    foreach my $method ( @{ $self->{methods} } ) {
-        next if $method->is_vtable;
-        $hout .= $method->generate_headers($self);
-    }
-
-    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : '';
-
-    # class init decl
-    $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(ARGMOD(VTABLE*));\n"
-        unless $name eq 'default';
-
-    $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable(PARROT_INTERP);\n";
-
-    $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable_pointer(PARROT_INTERP);\n"
-        if ($self->is_dynamic);
-
-    $self->{hdecls} .= $hout;
-
-    return $self->{hdecls};
-}
-
-=back
-
-=head2 Instance Methods
-
-=over
-
-=item C<init()>
-
-Initializes the instance.
-
-=cut
-
-sub init {
-    my ($self) = @_;
-
-    #!( singleton or abstract ) everything else gets readonly version of
-    # methods too.
-
-    $self->ro( Parrot::Pmc2c::PMC::RO->new($self) )
-        unless $self->abstract or $self->singleton;
-}
-
-=item C<gen_includes()>
-
-Returns the C C<#include> for the header file of each of the PMC's superclasses.
-
-=cut
-
-sub gen_includes {
-    my ($self) = @_;
-    my $c      = $self->{emitter};
-
-    $c->emit(<<"EOC");
-#include "parrot/parrot.h"
-#include "parrot/extend.h"
-#include "parrot/dynext.h"
-EOC
-
-    $c->emit(qq{#include "pmc_fixedintegerarray.h"\n})
-        if $self->flag('need_fia_header');
-
-    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;
-}
-
-=item C<pre_method_gen>
-
-Generate switch-bases VTABLE for MULTI
-
-=cut
-
-sub pre_method_gen {
-    my ($self) = @_;
-
-    $self->gen_switch_vtable;
-
-    1;
-}
-
-=item C<gen_methods()>
-
-Returns the C code for the pmc methods.
-
-=cut
-
-sub gen_methods {
-    my ($self) = @_;
-
-    # vtables
-    foreach my $method ( @{ $self->vtable->methods } ) {
-        my $vt_method_name = $method->name;
-        next if $vt_method_name eq 'class_init';
-
-        if ( $self->implements_vtable($vt_method_name) ) {
-            $self->get_method($vt_method_name)->generate_body($self);
-        }
-    }
-
-    # methods
-    foreach my $method ( @{ $self->methods } ) {
-        next if $method->is_vtable;
-        $method->generate_body($self);
-    }
-}
-
-=item C<gen_attributes()>
-
-Returns the C code for the attribute struct definition.
-
-=cut
-
-sub gen_attributes {
-    my ($self)     = @_;
-    my $attributes = $self->attributes;
-
-    if ( @{$attributes} ) {
-
-        Parrot::Pmc2c::Attribute::generate_start( $attributes->[0], $self );
-
-        foreach my $attribute ( @{$attributes} ) {
-            $attribute->generate_declaration($self);
-        }
-
-        Parrot::Pmc2c::Attribute::generate_end( $attributes->[0], $self );
-
-        foreach my $attribute ( @{$attributes} ) {
-            $attribute->generate_accessor($self);
-        }
-    }
-}
-
-=item C<find_multi_functions()>
-
-Returns an arrayref of MULTI function names declared in the PMC. Used to
-initialize the multiple dispatch function list.
-
-=cut
-
-sub find_multi_functions {
-    my ($self)  = @_;
-
-    my $pmcname = $self->name;
-    my ( @multi_names );
-
-    foreach my $method ( @{ $self->methods } ) {
-        next unless $method->is_multi;
-        my $short_sig    = $method->{MULTI_short_sig};
-        my $full_sig     = $pmcname . "," . $method->{MULTI_full_sig};
-        my $functionname = 'Parrot_' . $pmcname . '_' . $method->name;
-        push @multi_names, [ $method->symbol, $short_sig, $full_sig,
-                             $pmcname, $functionname, $method ];
-    }
-    return ( \@multi_names );
-}
-
-sub build_full_c_vt_method_name {
-    my ( $self, $vt_method_name ) = @_;
-
-    my $implementor;
-    if ( $self->implements_vtable($vt_method_name) ) {
-        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};
-    }
-    else {
-        $implementor = "default";
-    }
-
-    return "Parrot_${implementor}_$vt_method_name";
-}
-
-=item C<vtable_flags()>
-
-Returns C code to produce a PMC's flags.
-
-=cut
-
-sub vtable_flags {
-    my ($self) = @_;
-
-    my $vtbl_flag = 0;
-    $vtbl_flag .= '|VTABLE_PMC_IS_SINGLETON'  if $self->flag('singleton');
-    $vtbl_flag .= '|VTABLE_IS_SHARED_FLAG'    if $self->flag('is_shared');
-    $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;
-        push @vt_methods,
-            $self->build_full_c_vt_method_name( $vt_method->name );
-    }
-
-    my $methlist = join( ",\n        ", @vt_methods );
-
-    my $cout = <<ENDOFCODE;
-    const VTABLE $temp_struct_name = {
-        NULL,       /* namespace */
-        $enum_name, /* base_type */
-        NULL,       /* whoami */
-        $vtbl_flag, /* flags */
-        NULL,       /* provides_str */
-        NULL,       /* isa_hash */
-        NULL,       /* class */
-        NULL,       /* mro */
-        NULL,       /* attribute_defs */
-        NULL,       /* ro_variant_vtable */
-        $methlist,
-        0           /* attr size */
-    };
-ENDOFCODE
-    return $cout;
-}
-
-sub gen_multi_name
-{
-    my ($name, $cache) = @_;
-
-    return $cache->{$name} if exists $cache->{$name};
-    my $count              = keys %$cache;
-    return $cache->{$name} = "mfl_$count";
-}
-
-=item C<pmc_class_init_func()>
-
-Returns the C code for the PMC's class_init function as a static
-function to be called from the exported class_init.
-
-=cut
-
-sub pmc_class_init_func {
-    my ($self) = @_;
-    my $class_init_code = "";
-
-    if ($self->has_method('class_init')) {
-        $class_init_code .= $self->get_method('class_init')->body;
-
-        $class_init_code =~ s/INTERP/interp/g;
-
-        # fix indenting
-        $class_init_code =~ s/^/    /mg;
-        $class_init_code = <<ENDOFCODE
-static void thispmc_class_init(PARROT_INTERP, int entry)
-{
-$class_init_code
-}
-ENDOFCODE
-    }
-    return $class_init_code;
-}
-
-=item C<init_func()>
-
-Returns the C code for the PMC's initialization method, or an empty
-string if the PMC has a C<no_init> flag.
-
-=cut
-
-sub init_func {
-    my ($self) = @_;
-    return '' if $self->no_init;
-
-    my $cout        = '';
-    my $classname   = $self->name;
-    my $enum_name   = $self->is_dynamic ? -1 : "enum_class_$classname";
-    my $multi_funcs = $self->find_multi_functions();
-
-    my @multi_list;
-    my %strings_seen;
-    my $multi_strings = '';
-    my $cache         = {};
-
-    my $i = 0;
-    for my $multi (@$multi_funcs) {
-        my ($name, $ssig, $fsig, $ns, $func) = @$multi;
-        my ($name_str, $ssig_str, $fsig_str, $ns_name)     =
-            map { gen_multi_name($_, $cache) } ($name, $ssig, $fsig, $ns);
-
-        for my $s ([$name, $name_str],
-                   [$ssig, $ssig_str],
-                   [$fsig, $fsig_str],
-                   [$ns,   $ns_name ]) {
-            my ($raw_string, $name) = @$s;
-            next if $strings_seen{$name}++;
-            $multi_strings .=  "            STRING * const $name = "
-                           . qq|CONST_STRING_GEN(interp, "$raw_string");\n|;
-        }
-
-        push @multi_list, <<END_MULTI_LIST;
-            _temp_multi_func_list[$i].multi_name = $name_str;
-            _temp_multi_func_list[$i].short_sig = $ssig_str;
-            _temp_multi_func_list[$i].full_sig = $fsig_str;
-            _temp_multi_func_list[$i].ns_name = $ns_name;
-            _temp_multi_func_list[$i].func_ptr = (funcptr_t) $func;
-END_MULTI_LIST
-        $i++;
-
-    }
-
-    my $multi_list_size = @multi_list;
-    my $multi_list = join( "\n", @multi_list);
-
-    my $provides        = join( " ", keys( %{ $self->{flags}{provides} } ) );
-    my $class_init_code = "";
-
-    if ($self->has_method('class_init')) {
-        $class_init_code .= "        thispmc_class_init(interp, entry);\n";
-    }
-
-    my %extra_vt;
-    $extra_vt{ro} = $self->{ro} if $self->{ro};
-
-    $cout .= <<"EOC";
-void
-Parrot_${classname}_class_init(PARROT_INTERP, int entry, int pass)
-{
-    static const char attr_defs [] =
-EOC
-    $cout .= '        "';
-
-    my $attributes = $self->attributes;
-    foreach my $attribute ( @$attributes ) {
-        my $attrtype       = $attribute->{type};
-        my $attrname       = $attribute->{name};
-        my $typeid = ':'; # Unhandled
-        if($attrname =~ m/\(*(\w+)\)\(.*?\)/) {
-            $attrname = $1;
-        }
-        elsif ($attrtype eq "INTVAL") {
-            $typeid = 'I';
-        }
-        elsif ($attrtype eq "FLOATVAL") {
-            $typeid = 'F';
-        }
-        elsif ($attrtype =~ /STRING\s*\*$/) {
-            $typeid = 'S';
-        }
-        elsif ($attrtype =~ /PMC\s*\*$/) {
-            $typeid = 'F';
-        }
-
-        $cout .= $typeid;
-        $cout .= $attrname;
-        $cout .= ' ';
-    }
-
-    $cout .= "\";\n";
-
-    my $const = ( $self->{flags}{dynpmc} ) ? " " : " const ";
-
-    my $flags = $self->vtable_flags;
-    $cout .= <<"EOC";
-    if (pass == 0) {
-        VTABLE * const vt  = Parrot_${classname}_get_vtable(interp);
-        vt->base_type      = $enum_name;
-        vt->flags          = $flags;
-        vt->attribute_defs = attr_defs;
-        interp->vtables[entry] = vt;
-
-EOC
-
-    # init vtable slot
-    if ( $self->is_dynamic ) {
-        $cout .= <<"EOC";
-        vt->base_type    = entry;
-        vt->whoami       = Parrot_str_new_init(interp, "$classname", @{[length($classname)]},
-                                       Parrot_ascii_encoding_ptr, PObj_constant_FLAG|PObj_external_FLAG);
-        vt->provides_str = Parrot_str_concat(interp, vt->provides_str,
-            Parrot_str_new_init(interp, "$provides", @{[length($provides)]}, Parrot_ascii_encoding_ptr,
-            PObj_constant_FLAG|PObj_external_FLAG));
-
-EOC
-    }
-    else {
-        $cout .= <<"EOC";
-        vt->whoami       = CONST_STRING_GEN(interp, "$classname");
-        vt->provides_str = CONST_STRING_GEN(interp, "$provides");
-EOC
-    }
-
-    $cout .= <<"EOC";
-        vt->isa_hash     = Parrot_${classname}_get_isa(interp, NULL);
-EOC
-
-    for my $k ( keys %extra_vt ) {
-        my $k_flags = $self->$k->vtable_flags;
-        $cout .= <<"EOC";
-        {
-            VTABLE                   *vt_$k;
-            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;
-
-            vt_${k}->base_type           = entry;
-            vt_${k}->whoami              = vt->whoami;
-            vt_${k}->provides_str        = vt->provides_str;
-            vt->${k}_variant_vtable      = vt_${k};
-            vt_${k}->${k}_variant_vtable = vt;
-            vt_${k}->isa_hash            = vt->isa_hash;
-        }
-
-EOC
-    }
-
-    $cout .= <<"EOC";
-    }
-    else { /* pass */
-EOC
-
-    # To make use of the .HLL directive, register any mapping...
-    if ( $self->{flags}{hll} && $self->{flags}{maps} ) {
-
-        my $hll = $self->{flags}{hll};
-        $cout .= <<"EOC";
-
-        {
-            /* Register this PMC as a HLL mapping */
-            const INTVAL hll_id = Parrot_hll_get_HLL_id( interp, CONST_STRING_GEN(interp, "$hll"));
-            if (hll_id > 0) {
-EOC
-        foreach my $maps ( sort keys %{ $self->{flags}{maps} } ) {
-            $cout .= <<"EOC";
-                Parrot_hll_register_HLL_type( interp, hll_id, enum_class_$maps, entry);
-EOC
-        }
-        $cout .= <<"EOC";
-            }
-        } /* Register */
-EOC
-    }
-
-        $cout .= <<"EOC";
-        {
-            VTABLE * const vt  = interp->vtables[entry];
-
-            vt->mro = Parrot_${classname}_get_mro(interp, PMCNULL);
-
-            if (vt->ro_variant_vtable)
-                vt->ro_variant_vtable->mro = vt->mro;
-        }
-
-        /* set up MRO and _namespace */
-        Parrot_pmc_create_mro(interp, entry);
-EOC
-
-    # declare each nci method for this class
-    foreach my $method ( @{ $self->{methods} } ) {
-        next unless $method->type eq Parrot::Pmc2c::Method::NON_VTABLE;
-
-        #these differ for METHODs
-        my $method_name     = $method->name;
-        my $symbol_name     = $method->symbol;
-        my ($pcc_signature) = $method->pcc_signature;
-
-        $cout .= <<"EOC";
-        {
-            STRING *method_name = CONST_STRING_GEN(interp, "$symbol_name");
-            STRING *signature   = CONST_STRING_GEN(interp, "$pcc_signature");
-            register_native_pcc_method_in_ns(interp, entry,
-                F2DPTR(Parrot_${classname}_${method_name}),
-                method_name, signature);
-        }
-EOC
-        if ( $method->{attrs}{write} ) {
-            $cout .= <<"EOC";
-        Parrot_mark_method_writes(interp, entry, "$symbol_name");
-EOC
-        }
-    }
-
-    # include any class specific init code from the .pmc file
-    if ($class_init_code) {
-        $cout .= <<"EOC";
-
-        /* class_init */
-$class_init_code
-
-EOC
-    }
-
-    $cout .= <<"EOC";
-        {
-EOC
-
-
-    if ( @$multi_funcs ) {
-        # Don't const the list, breaks some older C compilers
-        $cout .= $multi_strings . <<"EOC";
-
-            multi_func_list _temp_multi_func_list[$multi_list_size];
-$multi_list
-            Parrot_mmd_add_multi_list_from_c_args(interp,
-                _temp_multi_func_list, $multi_list_size);
-EOC
-    }
-
-    $cout .= <<"EOC";
-        }
-    } /* pass */
-} /* Parrot_${classname}_class_init */
-EOC
-
-    if ( $self->is_dynamic ) {
-        $cout .= dynext_load_code( $classname, $classname => {} );
-    }
-
-    $cout;
-}
-
-=item C<update_vtable_func()>
-
-Returns the C code for the PMC's update_vtable.
-
-=cut
-
-sub update_vtable_func {
-    my ($self) = @_;
-
-    my $cout      = "";
-    my $classname = $self->name;
-    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
-
-    # Sets the attr_size field:
-    # - If the auto_attrs flag is set, use the current data.
-    # - If manual_attrs is set, set to 0.
-    # - If none is set, check if this PMC has init or init_pmc vtable functions,
-    # setting it to 0 in that case, and keeping the value from the
-    # parent otherwise.
-    my $set_attr_size = '';
-    my $flag_auto_attrs = $self->{flags}{auto_attrs};
-    my $flag_manual_attrs = $self->{flags}{manual_attrs};
-    die 'manual_attrs and auto_attrs can not be used together'
-         . 'in PMC ' . $self->name
-        if ($flag_auto_attrs && $flag_manual_attrs);
-    die 'PMC ' . $self->name . ' has attributes but no auto_attrs or manual_attrs'
-        if (@{$self->attributes} && ! ($flag_auto_attrs || $flag_manual_attrs));
-
-    if ( @{$self->attributes} &&  $flag_auto_attrs) {
-        $set_attr_size .= "sizeof(Parrot_${classname}_attributes)";
-    }
-    else {
-        $set_attr_size .= "0" if $flag_manual_attrs ||
-                                 exists($self->{has_method}{init}) ||
-                                 exists($self->{has_method}{init_pmc});
-    }
-    $set_attr_size =     "    vt->attr_size = " . $set_attr_size . ";\n"
-        if $set_attr_size ne '';
-
-    my $vtable_updates = '';
-    for my $name ( @{ $self->vtable->names } ) {
-        if (exists $self->{has_method}{$name}) {
-            $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n";
-        }
-    }
-
-    $vtable_updates .= $set_attr_size;
-
-    $cout .= <<"EOC";
-
-$export
-VTABLE *Parrot_${classname}_update_vtable(VTABLE *vt) {
-$vtable_updates
-    return vt;
-}
-
-EOC
-
-    # Generate RO vtable for implemented non-updating methods
-    $vtable_updates = '';
-    foreach my $name ( @{ $self->vtable->names} ) {
-        next unless exists $self->{has_method}{$name};
-        if ($self->vtable_method_does_write($name)) {
-            # If we override constantness status of vtable
-            if (!$self->vtable->attrs($name)->{write}) {
-                $vtable_updates .= "    vt->$name = Parrot_${classname}_ro_${name};\n";
-            }
-        }
-        else {
-            $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n";
-        }
-    }
-
-    $vtable_updates .= $set_attr_size;
-
-    $cout .= <<"EOC";
-
-$export
-VTABLE *Parrot_${classname}_ro_update_vtable(ARGMOD(VTABLE *vt)) {
-$vtable_updates
-    return vt;
-}
-
-EOC
-
-    $cout;
-}
-
-=item C<get_mro_func()>
-
-Returns the C code for the PMC's get_mro function.
-
-=cut
-
-sub get_mro_func {
-    my ($self) = @_;
-
-    my $cout      = "";
-    my $classname = $self->name;
-    my $get_mro = '';
-    my @parent_names;
-    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
-
-    if ($classname ne 'default') {
-        for my $dp (reverse @{ $self->direct_parents}) {
-            $get_mro .= "    mro = Parrot_${dp}_get_mro(interp, mro);\n"
-            unless $dp eq 'default';
-        }
-    }
-
-    $cout .= <<"EOC";
-$export
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC* Parrot_${classname}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro)) {
-    if (PMC_IS_NULL(mro)) {
-        mro = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
-    }
-$get_mro
-    VTABLE_unshift_string(interp, mro,
-        Parrot_str_new_init(interp, "$classname", @{[length($classname)]},
-            Parrot_default_encoding_ptr, 0));
-    return mro;
-}
-
-EOC
-
-    $cout;
-}
-
-=item C<get_isa_func()>
-
-Returns the C code for the PMC's get_isa function.
-
-=cut
-
-sub get_isa_func {
-    my ($self) = @_;
-
-    my $cout      = "";
-    my $classname = $self->name;
-    my $get_isa = '';
-    my @parent_names;
-    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
-
-    if ($classname ne 'default') {
-        for my $dp (reverse @{ $self->direct_parents}) {
-            $get_isa .= "    isa = Parrot_${dp}_get_isa(interp, isa);\n"
-            unless $dp eq 'default';
-        }
-    }
-
-    $cout .= <<"EOC";
-$export
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-Hash* Parrot_${classname}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa)) {
-EOC
-
-    if ($get_isa ne '') {
-        $cout .= $get_isa;
-    }
-    else {
-        $cout .= <<"EOC";
-    if (isa == NULL) {
-        isa = Parrot_hash_new(interp);
-    }
-EOC
-    }
-    $cout .= <<"EOC";
-    Parrot_hash_put(interp, isa, (void *)(CONST_STRING_GEN(interp, "$classname")), PMCNULL);
-    return isa;
-}
-
-EOC
-
-    $cout;
-}
-
-
-=item C<get_vtable_func()>
-
-Returns the C code for the PMC's update_vtable.
-
-=cut
-
-sub get_vtable_func {
-    my ($self) = @_;
-
-    my $cout      = "";
-    my $classname = $self->name;
-    my @other_parents = reverse @{ $self->direct_parents };
-    my $first_parent = shift @other_parents;
-    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT';
-
-    my $get_vtable = '';
-
-    if ($first_parent eq 'default') {
-        $get_vtable .= "    vt = Parrot_default_get_vtable(interp);\n";
-    }
-    else {
-        $get_vtable .= "    vt = Parrot_${first_parent}_get_vtable(interp);\n";
-    }
-
-    foreach my $parent_name ( @other_parents) {
-        $get_vtable .= "    Parrot_${parent_name}_update_vtable(vt);\n";
-    }
-
-    $get_vtable .= "    Parrot_${classname}_update_vtable(vt);\n";
-
-    $cout .= <<"EOC";
-$export
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) {
-    VTABLE *vt;
-$get_vtable
-    return vt;
-}
-
-EOC
-
-    my $get_extra_vtable = '';
-
-    if ($first_parent eq 'default') {
-        $get_extra_vtable .= "    vt = Parrot_default_ro_get_vtable(interp);\n";
-    }
-    else {
-        $get_extra_vtable .= "    vt = Parrot_${first_parent}_ro_get_vtable(interp);\n";
-    }
-
-    foreach my $parent_name ( @other_parents ) {
-        $get_extra_vtable .= "    Parrot_${parent_name}_ro_update_vtable(vt);\n";
-    }
-
-    if ($self->is_dynamic) {
-        # The C could be optimized, but the case when Parrot_x_get_vtable_pointer
-        # is needed is very rare.  See TT #898 for more info.
-        $cout .= <<"EOC";
-$export
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-VTABLE* Parrot_${classname}_get_vtable_pointer(PARROT_INTERP) {
-    STRING *type_name = Parrot_str_new_constant(interp, "${classname}");
-    INTVAL  type_num  = Parrot_pmc_get_type_str(interp, type_name);
-    return interp->vtables[type_num];
-}
-
-EOC
-    }
-
-    $get_extra_vtable .= "    Parrot_${classname}_ro_update_vtable(vt);\n";
-
-    $cout .= <<"EOC";
-$export
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-VTABLE* Parrot_${classname}_ro_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);
-    return 0;
-}
-
-sub vtable {
-    my ( $self, $value ) = @_;
-    $self->{vtable} = $value if $value;
-    return $self->{vtable};
-}
-
-=item C<gen_switch_vtable>
-
-Generate switch-bases VTABLE for MULTI
-
-=cut
-
-sub gen_switch_vtable {
-    my ($self) = @_;
-
-    # No cookies for DynPMC. At least not now.
-    return 1 if $self->is_dynamic;
-
-    # Convert list of multis to name->[(type,,ssig,fsig,ns,func)] hash.
-    my %multi_methods;
-    foreach (@{$self->find_multi_functions}) {
-        my ($name, $ssig, $fsig, $ns, $func, $method) = @$_;
-        my @sig = split /,/, $fsig;
-        push @{ $multi_methods{ $name } }, [ $sig[1], $ssig, $fsig, $ns, $func, $method ];
-    }
-
-    # vtables
-    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);
-        next unless exists $multi_methods{$vt_method_name};
-
-        my $multis = $multi_methods{$vt_method_name};
-
-        # Get parameters.      strip type from param
-        my @parameters = map { s/(\s*\S+\s*\*?\s*)//; $_ } split (/,/, $method->parameters);
-
-        # Gather "case :"
-        my @cases = map { $self->generate_single_case($vt_method_name, $_, @parameters) } @$multis;
-        my $cases = join "", @cases;
-
-        my $body = <<"BODY";
-    INTVAL type = VTABLE_type(INTERP, $parameters[0]);
-    /* For dynpmc fallback to MMD */
-    if ((type >= enum_class_core_max) || (SELF.type() >= enum_class_core_max))
-        type = enum_class_core_max;
-    switch(type) {
-$cases
-    }
-BODY
-
-        my $vtable = $method->clone({
-                body => Parrot::Pmc2c::Emitter->text($body),
-            });
-        $self->add_method($vtable);
-    }
-
-    1;
-}
-
-# Generate single case for switch VTABLE
-sub generate_single_case {
-    my ($self, $vt_method_name, $multi, @parameters) = @_;
-
-    my ($type, $ssig, $fsig, $ns, $func, $impl) = @$multi;
-    my $case;
-
-    # Gather parameters names
-    my $parameters = join ', ', @parameters;
-    # ISO C forbids return with expression from void functions.
-    my $return = $impl->return_type =~ /^void\s*$/
-                    ? ''
-                    : 'return ';
-
-    if ($type eq 'DEFAULT' || $type eq 'PMC') {
-        # For default case we have to handle return manually.
-        my ($pcc_signature, $retval, $call_tail, $pcc_return)
-                = $self->gen_defaul_case_wrapping($ssig, @parameters);
-        my $dispatch = "Parrot_mmd_multi_dispatch_from_c_args(INTERP, \"$vt_method_name\", \"$pcc_signature\", SELF, $parameters$call_tail);";
-
-        $case = <<"CASE";
-        case enum_class_core_max:
-CASE
-        if ($retval eq '') {
-        $case .= <<"CASE";
-            $dispatch
-CASE
-        }
-        else {
-        $case .= <<"CASE";
-            {
-                $retval
-                $dispatch
-                $pcc_return
-            }
-CASE
-        }
-        $case .= <<"CASE";
-            break;
-        default:
-            $return$func(INTERP, SELF, $parameters);
-            break;
-CASE
-    }
-    else {
-        $case = <<"CASE";
-        case enum_class_$type:
-            $return$func(INTERP, SELF, $parameters);
-            break;
-CASE
-    }
-
-    $case;
-}
-
-# Generate (pcc_signature, retval holder, pcc_call_tail, return statement)
-# for default case in switch.
-sub gen_defaul_case_wrapping {
-    my ($self, $ssig, @parameters) = @_;
-
-    my $letter = substr($ssig, 0, 1);
-    if ($letter eq 'I') {
-        return (
-            "PP->" . $letter,
-            "INTVAL retval;",
-            ', &retval',
-            'return retval;',
-        );
-    }
-    elsif ($letter eq 'S') {
-        return (
-            "PP->" . $letter,
-            "STRING *retval;",
-            ', &retval',
-            'return retval;',
-        );
-    }
-    elsif ($letter eq 'P') {
-        return (
-            'PPP->P',
-            'PMC *retval = PMCNULL;',
-            ", &retval",
-            "return retval;",
-        );
-    }
-    elsif ($letter eq 'v') {
-        return (
-            'PP->',
-            '',
-            '',
-            'return;',
-        );
-    }
-    else {
-        die "Can't handle signature $ssig!";
-    }
-}
-
-
-1;
-
-# Local Variables:
-#   mode: cperl
-#   cperl-indent-level: 4
-#   fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:

lib/Parrot/Pmc2c/Parser.pm

@@ -1 @@
-# Copyright (C) 2004-2008, Parrot Foundation.
-
 package Parrot::Pmc2c::Parser;
-
+# Copyright (C) 2004-2011, Parrot Foundation.
 use strict;
 use warnings;
-
 use base qw( Exporter );
-
 our @EXPORT_OK = qw( parse_pmc extract_balanced );
 use Parrot::Pmc2c::PMC ();
 use Parrot::Pmc2c::Attribute ();
@@ -22 +18 @@
 
 =head1 SYNOPSIS
 
-    use Parrot::Pmc2c::Parser;
+    use Parrot::Pmc2c::Parser qw(
+        parse_pmc
+        extract_balanced
+    );
 
 =head1 DESCRIPTION
 
-Parrot::Pmc2c::Parser parses a sudo C syntax into a perl hash that is then dumped.
+Parrot::Pmc2c::Parser parses a pseudo-C syntax into a perl hash that is then dumped.
+
+=head1 SUBROUTINES
 
+This package exports two subroutines on request only.
 
 =head2 C<parse_pmc()>
 
@@ -51 +53 @@
 
 B<Return Values:>  Reference to a Parrot::Pmc2c::PMC object
 
-B<Comments:>  Called by C<dump_pmc()>.
+B<Comments:>  Called by C<Parrot::Pmc2c::Dumper::dump_pmc()>.
 
 =cut
 

lib/Parrot/Pmc2c/UtilFunctions.pm

@@ -1 @@
-# Copyright (C) 2007-2008, Parrot Foundation.
+# Copyright (C) 2007-2011, Parrot Foundation.
 
 package Parrot::Pmc2c::UtilFunctions;
 use strict;
@@ -11 +11 @@
     c_code_coda slurp spew filename
     args_from_parameter_list
     passable_args_from_parameter_list
+    gen_multi_name
+    trim
 );
 
 =head1 NAME
@@ -19 +21 @@
 
 =head1 DESCRIPTION
 
-Various utility functions used in PMC to C transformations.  All functionas
+Various utility functions used in PMC to C transformations.  All functions
 are exported on request only.
 
 =head1 SUBROUTINES
@@ -298 +300 @@
     $filename =~ s/\.\w+$/.pmc/          if ( $type eq ".pmc" );
     return $filename;
 }
+
+sub gen_multi_name {
+    my ($name, $cache) = @_;
+
+    return $cache->{$name} if exists $cache->{$name};
+    my $count              = keys %$cache;
+    return $cache->{$name} = "mfl_$count";
+}
+
+# Perl trim function to remove whitespace from the start and end of the string
+sub trim {
+    my $string = shift;
+    $string    =~ s/^\s+//;
+    $string    =~ s/\s+$//;
+    return $string;
+}
+
 1;
 
 # Local Variables:

tools/build/h2inc.pl

@@ -1 @@
-# Copyright (C) 2009, Parrot Foundation.
+# Copyright (C) 2011, Parrot Foundation.
 
 =head1 NAME
 
@@ -14 +14 @@
 
     perl tools/build/h2inc.pl <input_file> <output_file>
 
+Example (from F<make> output):
+
+    /usr/local/bin/perl tools/build/h2inc.pl include/parrot/enums.h \
+        lib/Parrot/Pmc2c/PCCMETHOD_BITS.pm
+
 =cut
 
 use strict;