Ticket #1988: master.tt1988_pmcemitter.diff

File master.tt1988_pmcemitter.diff, 68.9 KB (added by jkeenan, 3 years ago)

Current diff between master and tt1988_pmcemitter branch

  • MANIFEST

    diff --git a/MANIFEST b/MANIFEST
    index 6068e04..1972416 100644
    a b  
    995995lib/Parrot/Install.pm                                       [devel]lib 
    996996lib/Parrot/Manifest.pm                                      [devel]lib 
    997997lib/Parrot/Pmc2c/Attribute.pm                               [devel]lib 
    998 lib/Parrot/Pmc2c/ComposedMethod.pm                          [devel]lib 
    999998lib/Parrot/Pmc2c/Dumper.pm                                  [devel]lib 
    1000999lib/Parrot/Pmc2c/Emitter.pm                                 [devel]lib 
    10011000lib/Parrot/Pmc2c/Library.pm                                 [devel]lib 
     
    10071006lib/Parrot/Pmc2c/PMC.pm                                     [devel]lib 
    10081007lib/Parrot/Pmc2c/PMC/Null.pm                                [devel]lib 
    10091008lib/Parrot/Pmc2c/PMC/Object.pm                              [devel]lib 
    1010 lib/Parrot/Pmc2c/PMC/ParrotClass.pm                         [devel]lib 
    10111009lib/Parrot/Pmc2c/PMC/PrintTree.pm                           [devel]lib 
    10121010lib/Parrot/Pmc2c/PMC/RO.pm                                  [devel]lib 
    10131011lib/Parrot/Pmc2c/PMC/default.pm                             [devel]lib 
    1014 lib/Parrot/Pmc2c/PMCEmitter.pm                              [devel]lib 
    10151012lib/Parrot/Pmc2c/Parser.pm                                  [devel]lib 
    10161013lib/Parrot/Pmc2c/Pmc2cMain.pm                               [devel]lib 
    10171014lib/Parrot/Pmc2c/UtilFunctions.pm                           [devel]lib 
  • config/auto/pmc.pm

    diff --git a/config/auto/pmc.pm b/config/auto/pmc.pm
    index 2fd7688..d0ee0ea 100644
    a b  
    6262    lib/Parrot/Pmc2c/Method.pm \\ 
    6363    lib/Parrot/Pmc2c/PCCMETHOD.pm \\ 
    6464    lib/Parrot/Pmc2c/MULTI.pm \\ 
    65     lib/Parrot/Pmc2c/PMCEmitter.pm \\ 
    6665    lib/Parrot/Pmc2c/MethodEmitter.pm \\ 
    6766    lib/Parrot/Pmc2c/Library.pm \\ 
    6867    lib/Parrot/Pmc2c/UtilFunctions.pm \\ 
  • lib/Parrot/Pmc2c/Dumper.pm

    diff --git a/lib/Parrot/Pmc2c/Dumper.pm b/lib/Parrot/Pmc2c/Dumper.pm
    index 30da966..80c91f4 100644
    a b  
    1 # Copyright (C) 2004-2009, Parrot Foundation. 
     1# Copyright (C) 2004-2011, Parrot Foundation. 
    22package Parrot::Pmc2c::Dumper; 
    33 
    44use strict; 
     
    144144 
    145145=head2 Subroutines 
    146146 
    147  
    148147=head3 C<gen_parent_reverse_lookup_info()> 
    149148 
    150149    $class = gen_parent_reverse_lookup_info($name, $all, $vt); 
  • lib/Parrot/Pmc2c/Library.pm

    diff --git a/lib/Parrot/Pmc2c/Library.pm b/lib/Parrot/Pmc2c/Library.pm
    index fd1f71c..a2fab44 100644
    a b  
    2424use strict; 
    2525use warnings; 
    2626use File::Basename qw(basename); 
    27 use Parrot::Pmc2c::PMCEmitter (); 
     27use Parrot::Pmc2c::PMC (); 
    2828use Parrot::Pmc2c::UtilFunctions qw(dont_edit dynext_load_code c_code_coda spew); 
    2929 
    3030=item C<generate_library($library_name, $pmcs)> 
  • lib/Parrot/Pmc2c/Method.pm

    diff --git a/lib/Parrot/Pmc2c/Method.pm b/lib/Parrot/Pmc2c/Method.pm
    index d884909..6b05872 100644
    a b  
    203203=head1 SEE ALSO 
    204204 
    205205    lib/Parrot/Pmc2c/PMC/RO.pm 
    206     lib/Parrot/Pmc2c/PMCEmitter.pm 
    207206    lib/Parrot/Pmc2c/VTable.pm 
    208207    lib/Parrot/Pmc2c/PMC.pm 
    209208    lib/Parrot/Pmc2c/Parser.pm 
  • lib/Parrot/Pmc2c/PCCMETHOD.pm

    diff --git a/lib/Parrot/Pmc2c/PCCMETHOD.pm b/lib/Parrot/Pmc2c/PCCMETHOD.pm
    index 0af7665..105dac7 100644
    a b  
    55use warnings; 
    66use Carp qw(longmess croak); 
    77use Parrot::Pmc2c::PCCMETHOD_BITS; 
     8use Parrot::Pmc2c::UtilFunctions qw( trim ); 
    89 
    910=head1 NAME 
    1011 
     
    9697                      at => PARROT_ARG_PMC, }, 
    9798}; 
    9899 
    99 # Perl trim function to remove whitespace from the start and end of the string 
    100 sub trim { 
    101     my $string = shift; 
    102     $string    =~ s/^\s+//; 
    103     $string    =~ s/\s+$//; 
    104     return $string; 
    105 } 
    106  
    107 # Left trim function to remove leading whitespace 
    108 sub ltrim { 
    109     my $string = shift; 
    110     $string    =~ s/^\s+//; 
    111     return $string; 
    112 } 
    113  
    114 # Right trim function to remove trailing whitespace 
    115 sub rtrim { 
    116     my $string = shift; 
    117     $string    =~ s/\s+$//; 
    118     return $string; 
    119 } 
    120  
    121100=head3 C<parse_adverb_attributes> 
    122101 
    123102  builds and returs an adverb hash from an adverb string such as 
  • lib/Parrot/Pmc2c/PMC.pm

    diff --git a/lib/Parrot/Pmc2c/PMC.pm b/lib/Parrot/Pmc2c/PMC.pm
    index 2ff4bd2..b65a321 100644
    a b  
    2626our @EXPORT_OK = qw(); 
    2727use Storable (); 
    2828use Parrot::PMC; 
    29 use Parrot::Pmc2c::Method; 
     29use Parrot::Pmc2c::Emitter (); 
     30use Parrot::Pmc2c::Method (); 
     31use Parrot::Pmc2c::MethodEmitter (); 
     32use Parrot::Pmc2c::UtilFunctions qw( 
     33    dont_edit 
     34    dynext_load_code 
     35    c_code_coda 
     36    gen_multi_name 
     37); 
     38use Text::Balanced 'extract_bracketed'; 
     39use Parrot::Pmc2c::PCCMETHOD (); 
     40use Parrot::Pmc2c::MULTI (); 
     41use Parrot::Pmc2c::PMC::RO (); 
    3042 
    3143sub create { 
    3244    my ( $this, $pmc_classname ) = @_; 
     
    443455    return ( stat $dumpfile )[9] >= ( stat $pmcfile )[9]; 
    444456} 
    445457 
     458sub vtable { 
     459    my ( $self, $value ) = @_; 
     460    $self->{vtable} = $value if $value; 
     461    return $self->{vtable}; 
     462} 
     463 
     464 
     465sub prep_for_emit { 
     466    my ( $this, $pmc, $vtable_dump ) = @_; 
     467 
     468    $pmc->vtable($vtable_dump); 
     469    $pmc->init(); 
     470 
     471    return $pmc; 
     472} 
     473 
     474sub generate { 
     475    my ($self) = @_; 
     476    my $emitter = $self->{emitter} = 
     477        Parrot::Pmc2c::Emitter->new( $self->filename(".c") ); 
     478 
     479    $self->generate_c_file; 
     480    $emitter->write_to_file; 
     481 
     482    $emitter = $self->{emitter} = 
     483        Parrot::Pmc2c::Emitter->new( $self->filename(".h", $self->is_dynamic) ); 
     484 
     485    $self->generate_h_file; 
     486    $emitter->write_to_file; 
     487} 
     488 
     489=over 4 
     490 
     491=item C<generate_c_file()> 
     492 
     493Generates the C implementation file code for the PMC. 
     494 
     495=cut 
     496 
     497sub generate_c_file { 
     498    my ($self) = @_; 
     499    my $c      = $self->{emitter}; 
     500 
     501    $c->emit( dont_edit( $self->filename ) ); 
     502    if ($self->is_dynamic) { 
     503        $c->emit("#define PARROT_IN_EXTENSION\n"); 
     504        $c->emit("#define CONST_STRING(i, s) Parrot_str_new_constant((i), s)\n"); 
     505        $c->emit("#define CONST_STRING_GEN(i, s) Parrot_str_new_constant((i), s)\n"); 
     506    } 
     507 
     508    $self->gen_includes; 
     509 
     510    # The PCC code needs Continuation-related macros from these headers. 
     511    $c->emit("#include \"pmc_continuation.h\"\n"); 
     512    $c->emit("#include \"pmc_callcontext.h\"\n"); 
     513 
     514    $c->emit( $self->preamble ); 
     515 
     516    $c->emit( $self->hdecls ); 
     517    $c->emit( $self->{ro}->hdecls ) if ( $self->{ro} ); 
     518    $self->gen_methods; 
     519 
     520    my $ro = $self->ro; 
     521    if ($ro) { 
     522        $ro->{emitter} = $self->{emitter}; 
     523        $ro->gen_methods; 
     524    } 
     525 
     526    $c->emit("#include \"pmc_default.h\"\n"); 
     527 
     528    $c->emit( $self->update_vtable_func ); 
     529    $c->emit( $self->get_vtable_func ); 
     530    $c->emit( $self->get_mro_func ); 
     531    $c->emit( $self->get_isa_func ); 
     532    $c->emit( $self->pmc_class_init_func ); 
     533    $c->emit( $self->init_func ); 
     534    $c->emit( $self->postamble ); 
     535 
     536    return 1; 
     537} 
     538 
     539=item C<generate_h_file()> 
     540 
     541Generates the C header file code for the PMC. 
     542 
     543=cut 
     544 
     545sub generate_h_file { 
     546    my ($self)  = @_; 
     547    my $h       = $self->{emitter}; 
     548    my $uc_name = uc $self->name; 
     549    my $name    = $self->name; 
     550 
     551    $h->emit( dont_edit( $self->filename ) ); 
     552    $h->emit(<<"EOH"); 
     553 
     554#ifndef PARROT_PMC_${uc_name}_H_GUARD 
     555#define PARROT_PMC_${uc_name}_H_GUARD 
     556 
     557EOH 
     558 
     559    $h->emit("#define PARROT_IN_EXTENSION\n") if ( $self->is_dynamic ); 
     560 
     561    # Emit available functions for work with vtables. 
     562    my $export = 'PARROT_EXPORT '; 
     563    if ($self->is_dynamic) { 
     564        $export = 'PARROT_DYNEXT_EXPORT '; 
     565        $h->emit("${export}VTABLE* Parrot_${name}_get_vtable_pointer(PARROT_INTERP);\n"); 
     566        $h->emit("${export}void    Parrot_${name}_class_init(PARROT_INTERP, int, int);\n"); 
     567    } 
     568 
     569    if ($name ne 'default') { 
     570        $h->emit("${export}VTABLE* Parrot_${name}_update_vtable(ARGMOD(VTABLE*));\n"); 
     571        $h->emit("${export}VTABLE* Parrot_${name}_ro_update_vtable(ARGMOD(VTABLE*));\n"); 
     572    } 
     573    $h->emit("${export}VTABLE* Parrot_${name}_get_vtable(PARROT_INTERP);\n"); 
     574    $h->emit("${export}VTABLE* Parrot_${name}_ro_get_vtable(PARROT_INTERP);\n"); 
     575    $h->emit("${export}PMC*    Parrot_${name}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro));\n"); 
     576    $h->emit("${export}Hash*   Parrot_${name}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa));\n"); 
     577 
     578 
     579    $self->gen_attributes; 
     580    $h->emit(<<"EOH"); 
     581 
     582#endif /* PARROT_PMC_${uc_name}_H_GUARD */ 
     583 
     584EOH 
     585    $h->emit( c_code_coda() ); 
     586    return 1; 
     587} 
     588 
     589=item C<hdecls()> 
     590 
     591Returns the C code function declarations for all the methods for inclusion 
     592in the PMC's C header file. 
     593 
     594=cut 
     595 
     596sub hdecls { 
     597    my ($self) = @_; 
     598 
     599    my $hout; 
     600    my $name    = $self->name; 
     601    my $lc_name = $self->name; 
     602 
     603    # generate decls for all vtables in this PMC 
     604    foreach my $vt_method_name ( @{ $self->vtable->names } ) { 
     605        if ( $self->implements_vtable($vt_method_name) ) { 
     606            $hout .= 
     607                $self->get_method($vt_method_name)->generate_headers($self); 
     608        } 
     609    } 
     610 
     611    # generate decls for all nci methods in this PMC 
     612    foreach my $method ( @{ $self->{methods} } ) { 
     613        next if $method->is_vtable; 
     614        $hout .= $method->generate_headers($self); 
     615    } 
     616 
     617    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : ''; 
     618 
     619    # class init decl 
     620    $hout .= "${export}void    Parrot_${name}_class_init(PARROT_INTERP, int, int);\n"; 
     621 
     622    $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT '; 
     623 
     624    $hout .= "${export}VTABLE* Parrot_${lc_name}_update_vtable(ARGMOD(VTABLE*));\n" 
     625        unless $name eq 'default'; 
     626 
     627    $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable(PARROT_INTERP);\n"; 
     628 
     629    $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable_pointer(PARROT_INTERP);\n" 
     630        if ($self->is_dynamic); 
     631 
     632    $self->{hdecls} .= $hout; 
     633 
     634    return $self->{hdecls}; 
     635} 
     636 
     637=back 
     638 
     639=head2 Instance Methods 
     640 
     641=over 
     642 
     643=item C<init()> 
     644 
     645Initializes the instance. 
     646 
     647=cut 
     648 
     649sub init { 
     650    my ($self) = @_; 
     651 
     652    #!( singleton or abstract ) everything else gets readonly version of 
     653    # methods too. 
     654 
     655    $self->ro( Parrot::Pmc2c::PMC::RO->new($self) ) 
     656        unless $self->abstract or $self->singleton; 
     657} 
     658 
     659=item C<gen_includes()> 
     660 
     661Returns the C C<#include> for the header file of each of the PMC's superclasses. 
     662 
     663=cut 
     664 
     665sub gen_includes { 
     666    my ($self) = @_; 
     667    my $c      = $self->{emitter}; 
     668 
     669    $c->emit(<<"EOC"); 
     670#include "parrot/parrot.h" 
     671#include "parrot/extend.h" 
     672#include "parrot/dynext.h" 
     673EOC 
     674 
     675    $c->emit(qq{#include "pmc_fixedintegerarray.h"\n}) 
     676        if $self->flag('need_fia_header'); 
     677 
     678    foreach my $parent_name ( $self->name, @{ $self->parents } ) { 
     679        $c->emit( '#include "pmc_' . lc $parent_name . ".h\"\n" ); 
     680    } 
     681 
     682    foreach my $mixin_name ( @{ $self->mixins } ) { 
     683        $c->emit( '#include "pmc_' . lc $mixin_name . ".h\"\n" ); 
     684    } 
     685 
     686    $c->emit( '#include "' . lc $self->name . ".str\"\n" ) 
     687        unless $self->is_dynamic; 
     688} 
     689 
     690=item C<pre_method_gen> 
     691 
     692Generate switch-bases VTABLE for MULTI 
     693 
     694=cut 
     695 
     696sub pre_method_gen { 
     697    my ($self) = @_; 
     698 
     699    $self->gen_switch_vtable; 
     700 
     701    1; 
     702} 
     703 
     704=item C<gen_methods()> 
     705 
     706Returns the C code for the pmc methods. 
     707 
     708=cut 
     709 
     710sub gen_methods { 
     711    my ($self) = @_; 
     712 
     713    # vtables 
     714    foreach my $method ( @{ $self->vtable->methods } ) { 
     715        my $vt_method_name = $method->name; 
     716        next if $vt_method_name eq 'class_init'; 
     717 
     718        if ( $self->implements_vtable($vt_method_name) ) { 
     719            $self->get_method($vt_method_name)->generate_body($self); 
     720        } 
     721    } 
     722 
     723    # methods 
     724    foreach my $method ( @{ $self->methods } ) { 
     725        next if $method->is_vtable; 
     726        $method->generate_body($self); 
     727    } 
     728} 
     729 
     730=item C<gen_attributes()> 
     731 
     732Returns the C code for the attribute struct definition. 
     733 
     734=cut 
     735 
     736sub gen_attributes { 
     737    my ($self)     = @_; 
     738    my $attributes = $self->attributes; 
     739 
     740    if ( @{$attributes} ) { 
     741 
     742        Parrot::Pmc2c::Attribute::generate_start( $attributes->[0], $self ); 
     743 
     744        foreach my $attribute ( @{$attributes} ) { 
     745            $attribute->generate_declaration($self); 
     746        } 
     747 
     748        Parrot::Pmc2c::Attribute::generate_end( $attributes->[0], $self ); 
     749 
     750        foreach my $attribute ( @{$attributes} ) { 
     751            $attribute->generate_accessor($self); 
     752        } 
     753    } 
     754} 
     755 
     756=item C<find_multi_functions()> 
     757 
     758Returns an arrayref of MULTI function names declared in the PMC. Used to 
     759initialize the multiple dispatch function list. 
     760 
     761=cut 
     762 
     763sub find_multi_functions { 
     764    my ($self)  = @_; 
     765 
     766    my $pmcname = $self->name; 
     767    my ( @multi_names ); 
     768 
     769    foreach my $method ( @{ $self->methods } ) { 
     770        next unless $method->is_multi; 
     771        my $short_sig    = $method->{MULTI_short_sig}; 
     772        my $full_sig     = $pmcname . "," . $method->{MULTI_full_sig}; 
     773        my $functionname = 'Parrot_' . $pmcname . '_' . $method->name; 
     774        push @multi_names, [ $method->symbol, $short_sig, $full_sig, 
     775                             $pmcname, $functionname, $method ]; 
     776    } 
     777    return ( \@multi_names ); 
     778} 
     779 
     780sub build_full_c_vt_method_name { 
     781    my ( $self, $vt_method_name ) = @_; 
     782 
     783    my $implementor; 
     784    if ( $self->implements_vtable($vt_method_name) ) { 
     785        return $self->get_method($vt_method_name) 
     786            ->full_method_name( $self->name . $self->{variant} ); 
     787    } 
     788    elsif ( $self->{super}{$vt_method_name} ) { 
     789        $implementor = $self->{super}{$vt_method_name}; 
     790    } 
     791    else { 
     792        $implementor = "default"; 
     793    } 
     794 
     795    return "Parrot_${implementor}_$vt_method_name"; 
     796} 
     797 
     798=item C<vtable_flags()> 
     799 
     800Returns C code to produce a PMC's flags. 
     801 
     802=cut 
     803 
     804sub vtable_flags { 
     805    my ($self) = @_; 
     806 
     807    my $vtbl_flag = 0; 
     808    $vtbl_flag .= '|VTABLE_PMC_IS_SINGLETON'  if $self->flag('singleton'); 
     809    $vtbl_flag .= '|VTABLE_IS_SHARED_FLAG'    if $self->flag('is_shared'); 
     810    $vtbl_flag .= '|VTABLE_IS_READONLY_FLAG'  if $self->flag('is_ro'); 
     811    $vtbl_flag .= '|VTABLE_HAS_READONLY_FLAG' if $self->flag('has_ro'); 
     812 
     813    return $vtbl_flag; 
     814} 
     815 
     816=item C<vtable_decl($name)> 
     817 
     818Returns the C code for the declaration of a vtable temporary named 
     819C<$name> with the functions for this class. 
     820 
     821=cut 
     822 
     823sub vtable_decl { 
     824    my ( $self, $temp_struct_name, $enum_name ) = @_; 
     825 
     826    # gen vtable flags 
     827    my $vtbl_flag = $self->vtable_flags; 
     828 
     829    my @vt_methods; 
     830    foreach my $vt_method ( @{ $self->vtable->methods } ) { 
     831        next if $vt_method->is_mmd; 
     832        push @vt_methods, 
     833            $self->build_full_c_vt_method_name( $vt_method->name ); 
     834    } 
     835 
     836    my $methlist = join( ",\n        ", @vt_methods ); 
     837 
     838    my $cout = <<ENDOFCODE; 
     839    const VTABLE $temp_struct_name = { 
     840        NULL,       /* namespace */ 
     841        $enum_name, /* base_type */ 
     842        NULL,       /* whoami */ 
     843        $vtbl_flag, /* flags */ 
     844        NULL,       /* provides_str */ 
     845        NULL,       /* isa_hash */ 
     846        NULL,       /* class */ 
     847        NULL,       /* mro */ 
     848        NULL,       /* attribute_defs */ 
     849        NULL,       /* ro_variant_vtable */ 
     850        $methlist, 
     851        0           /* attr size */ 
     852    }; 
     853ENDOFCODE 
     854    return $cout; 
     855} 
     856 
     857=item C<pmc_class_init_func()> 
     858 
     859Returns the C code for the PMC's class_init function as a static 
     860function to be called from the exported class_init. 
     861 
     862=cut 
     863 
     864sub pmc_class_init_func { 
     865    my ($self) = @_; 
     866    my $class_init_code = ""; 
     867 
     868    if ($self->has_method('class_init')) { 
     869        $class_init_code .= $self->get_method('class_init')->body; 
     870 
     871        $class_init_code =~ s/INTERP/interp/g; 
     872 
     873        # fix indenting 
     874        $class_init_code =~ s/^/    /mg; 
     875        $class_init_code = <<ENDOFCODE 
     876static void thispmc_class_init(PARROT_INTERP, int entry) 
     877{ 
     878$class_init_code 
     879} 
     880ENDOFCODE 
     881    } 
     882    return $class_init_code; 
     883} 
     884 
     885=item C<init_func()> 
     886 
     887Returns the C code for the PMC's initialization method, or an empty 
     888string if the PMC has a C<no_init> flag. 
     889 
     890=cut 
     891 
     892sub init_func { 
     893    my ($self) = @_; 
     894    return '' if $self->no_init; 
     895 
     896    my $cout        = ''; 
     897    my $classname   = $self->name; 
     898    my $enum_name   = $self->is_dynamic ? -1 : "enum_class_$classname"; 
     899    my $multi_funcs = $self->find_multi_functions(); 
     900 
     901    my @multi_list; 
     902    my %strings_seen; 
     903    my $multi_strings = ''; 
     904    my $cache         = {}; 
     905 
     906    my $i = 0; 
     907    for my $multi (@$multi_funcs) { 
     908        my ($name, $ssig, $fsig, $ns, $func) = @$multi; 
     909        my ($name_str, $ssig_str, $fsig_str, $ns_name)     = 
     910            map { gen_multi_name($_, $cache) } ($name, $ssig, $fsig, $ns); 
     911 
     912        for my $s ([$name, $name_str], 
     913                   [$ssig, $ssig_str], 
     914                   [$fsig, $fsig_str], 
     915                   [$ns,   $ns_name ]) { 
     916            my ($raw_string, $name) = @$s; 
     917            next if $strings_seen{$name}++; 
     918            $multi_strings .=  "            STRING * const $name = " 
     919                           . qq|CONST_STRING_GEN(interp, "$raw_string");\n|; 
     920        } 
     921 
     922        push @multi_list, <<END_MULTI_LIST; 
     923            _temp_multi_func_list[$i].multi_name = $name_str; 
     924            _temp_multi_func_list[$i].short_sig = $ssig_str; 
     925            _temp_multi_func_list[$i].full_sig = $fsig_str; 
     926            _temp_multi_func_list[$i].ns_name = $ns_name; 
     927            _temp_multi_func_list[$i].func_ptr = (funcptr_t) $func; 
     928END_MULTI_LIST 
     929        $i++; 
     930 
     931    } 
     932 
     933    my $multi_list_size = @multi_list; 
     934    my $multi_list = join( "\n", @multi_list); 
     935 
     936    my $provides        = join( " ", keys( %{ $self->{flags}{provides} } ) ); 
     937    my $class_init_code = ""; 
     938 
     939    if ($self->has_method('class_init')) { 
     940        $class_init_code .= "        thispmc_class_init(interp, entry);\n"; 
     941    } 
     942 
     943    my %extra_vt; 
     944    $extra_vt{ro} = $self->{ro} if $self->{ro}; 
     945 
     946    $cout .= <<"EOC"; 
     947void 
     948Parrot_${classname}_class_init(PARROT_INTERP, int entry, int pass) 
     949{ 
     950    static const char attr_defs [] = 
     951EOC 
     952    $cout .= '        "'; 
     953 
     954    my $attributes = $self->attributes; 
     955    foreach my $attribute ( @$attributes ) { 
     956        my $attrtype       = $attribute->{type}; 
     957        my $attrname       = $attribute->{name}; 
     958        my $typeid = ':'; # Unhandled 
     959        if($attrname =~ m/\(*(\w+)\)\(.*?\)/) { 
     960            $attrname = $1; 
     961        } 
     962        elsif ($attrtype eq "INTVAL") { 
     963            $typeid = 'I'; 
     964        } 
     965        elsif ($attrtype eq "FLOATVAL") { 
     966            $typeid = 'F'; 
     967        } 
     968        elsif ($attrtype =~ /STRING\s*\*$/) { 
     969            $typeid = 'S'; 
     970        } 
     971        elsif ($attrtype =~ /PMC\s*\*$/) { 
     972            $typeid = 'F'; 
     973        } 
     974 
     975        $cout .= $typeid; 
     976        $cout .= $attrname; 
     977        $cout .= ' '; 
     978    } 
     979 
     980    $cout .= "\";\n"; 
     981 
     982    my $const = ( $self->{flags}{dynpmc} ) ? " " : " const "; 
     983 
     984    my $flags = $self->vtable_flags; 
     985    $cout .= <<"EOC"; 
     986    if (pass == 0) { 
     987        VTABLE * const vt  = Parrot_${classname}_get_vtable(interp); 
     988        vt->base_type      = $enum_name; 
     989        vt->flags          = $flags; 
     990        vt->attribute_defs = attr_defs; 
     991        interp->vtables[entry] = vt; 
     992 
     993EOC 
     994 
     995    # init vtable slot 
     996    if ( $self->is_dynamic ) { 
     997        $cout .= <<"EOC"; 
     998        vt->base_type    = entry; 
     999        vt->whoami       = Parrot_str_new_init(interp, "$classname", @{[length($classname)]}, 
     1000                                       Parrot_ascii_encoding_ptr, PObj_constant_FLAG|PObj_external_FLAG); 
     1001        vt->provides_str = Parrot_str_concat(interp, vt->provides_str, 
     1002            Parrot_str_new_init(interp, "$provides", @{[length($provides)]}, Parrot_ascii_encoding_ptr, 
     1003            PObj_constant_FLAG|PObj_external_FLAG)); 
     1004 
     1005EOC 
     1006    } 
     1007    else { 
     1008        $cout .= <<"EOC"; 
     1009        vt->whoami       = CONST_STRING_GEN(interp, "$classname"); 
     1010        vt->provides_str = CONST_STRING_GEN(interp, "$provides"); 
     1011EOC 
     1012    } 
     1013 
     1014    $cout .= <<"EOC"; 
     1015        vt->isa_hash     = Parrot_${classname}_get_isa(interp, NULL); 
     1016EOC 
     1017 
     1018    for my $k ( keys %extra_vt ) { 
     1019        my $k_flags = $self->$k->vtable_flags; 
     1020        $cout .= <<"EOC"; 
     1021        { 
     1022            VTABLE                   *vt_$k; 
     1023            vt_${k}                 = Parrot_${classname}_${k}_get_vtable(interp); 
     1024            vt_${k}->base_type      = $enum_name; 
     1025            vt_${k}->flags          = $k_flags; 
     1026 
     1027            vt_${k}->attribute_defs = attr_defs; 
     1028 
     1029            vt_${k}->base_type           = entry; 
     1030            vt_${k}->whoami              = vt->whoami; 
     1031            vt_${k}->provides_str        = vt->provides_str; 
     1032            vt->${k}_variant_vtable      = vt_${k}; 
     1033            vt_${k}->${k}_variant_vtable = vt; 
     1034            vt_${k}->isa_hash            = vt->isa_hash; 
     1035        } 
     1036 
     1037EOC 
     1038    } 
     1039 
     1040    $cout .= <<"EOC"; 
     1041    } 
     1042    else { /* pass */ 
     1043EOC 
     1044 
     1045    # To make use of the .HLL directive, register any mapping... 
     1046    if ( $self->{flags}{hll} && $self->{flags}{maps} ) { 
     1047 
     1048        my $hll = $self->{flags}{hll}; 
     1049        $cout .= <<"EOC"; 
     1050 
     1051        { 
     1052            /* Register this PMC as a HLL mapping */ 
     1053            const INTVAL hll_id = Parrot_hll_get_HLL_id( interp, CONST_STRING_GEN(interp, "$hll")); 
     1054            if (hll_id > 0) { 
     1055EOC 
     1056        foreach my $maps ( sort keys %{ $self->{flags}{maps} } ) { 
     1057            $cout .= <<"EOC"; 
     1058                Parrot_hll_register_HLL_type( interp, hll_id, enum_class_$maps, entry); 
     1059EOC 
     1060        } 
     1061        $cout .= <<"EOC"; 
     1062            } 
     1063        } /* Register */ 
     1064EOC 
     1065    } 
     1066 
     1067        $cout .= <<"EOC"; 
     1068        { 
     1069            VTABLE * const vt  = interp->vtables[entry]; 
     1070 
     1071            vt->mro = Parrot_${classname}_get_mro(interp, PMCNULL); 
     1072 
     1073            if (vt->ro_variant_vtable) 
     1074                vt->ro_variant_vtable->mro = vt->mro; 
     1075        } 
     1076 
     1077        /* set up MRO and _namespace */ 
     1078        Parrot_pmc_create_mro(interp, entry); 
     1079EOC 
     1080 
     1081    # declare each nci method for this class 
     1082    foreach my $method ( @{ $self->{methods} } ) { 
     1083        next unless $method->type eq Parrot::Pmc2c::Method::NON_VTABLE; 
     1084 
     1085        #these differ for METHODs 
     1086        my $method_name     = $method->name; 
     1087        my $symbol_name     = $method->symbol; 
     1088        my ($pcc_signature) = $method->pcc_signature; 
     1089 
     1090        $cout .= <<"EOC"; 
     1091        { 
     1092            STRING *method_name = CONST_STRING_GEN(interp, "$symbol_name"); 
     1093            STRING *signature   = CONST_STRING_GEN(interp, "$pcc_signature"); 
     1094            register_native_pcc_method_in_ns(interp, entry, 
     1095                F2DPTR(Parrot_${classname}_${method_name}), 
     1096                method_name, signature); 
     1097        } 
     1098EOC 
     1099        if ( $method->{attrs}{write} ) { 
     1100            $cout .= <<"EOC"; 
     1101        Parrot_mark_method_writes(interp, entry, "$symbol_name"); 
     1102EOC 
     1103        } 
     1104    } 
     1105 
     1106    # include any class specific init code from the .pmc file 
     1107    if ($class_init_code) { 
     1108        $cout .= <<"EOC"; 
     1109 
     1110        /* class_init */ 
     1111$class_init_code 
     1112 
     1113EOC 
     1114    } 
     1115 
     1116    $cout .= <<"EOC"; 
     1117        { 
     1118EOC 
     1119 
     1120 
     1121    if ( @$multi_funcs ) { 
     1122        # Don't const the list, breaks some older C compilers 
     1123        $cout .= $multi_strings . <<"EOC"; 
     1124 
     1125            multi_func_list _temp_multi_func_list[$multi_list_size]; 
     1126$multi_list 
     1127            Parrot_mmd_add_multi_list_from_c_args(interp, 
     1128                _temp_multi_func_list, $multi_list_size); 
     1129EOC 
     1130    } 
     1131 
     1132    $cout .= <<"EOC"; 
     1133        } 
     1134    } /* pass */ 
     1135} /* Parrot_${classname}_class_init */ 
     1136EOC 
     1137 
     1138    if ( $self->is_dynamic ) { 
     1139        $cout .= dynext_load_code( $classname, $classname => {} ); 
     1140    } 
     1141 
     1142    $cout; 
     1143} 
     1144 
     1145=item C<update_vtable_func()> 
     1146 
     1147Returns the C code for the PMC's update_vtable. 
     1148 
     1149=cut 
     1150 
     1151sub update_vtable_func { 
     1152    my ($self) = @_; 
     1153 
     1154    my $cout      = ""; 
     1155    my $classname = $self->name; 
     1156    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
     1157 
     1158    # Sets the attr_size field: 
     1159    # - If the auto_attrs flag is set, use the current data. 
     1160    # - If manual_attrs is set, set to 0. 
     1161    # - If none is set, check if this PMC has init or init_pmc vtable functions, 
     1162    # setting it to 0 in that case, and keeping the value from the 
     1163    # parent otherwise. 
     1164    my $set_attr_size = ''; 
     1165    my $flag_auto_attrs = $self->{flags}{auto_attrs}; 
     1166    my $flag_manual_attrs = $self->{flags}{manual_attrs}; 
     1167    die 'manual_attrs and auto_attrs can not be used together' 
     1168         . 'in PMC ' . $self->name 
     1169        if ($flag_auto_attrs && $flag_manual_attrs); 
     1170    die 'PMC ' . $self->name . ' has attributes but no auto_attrs or manual_attrs' 
     1171        if (@{$self->attributes} && ! ($flag_auto_attrs || $flag_manual_attrs)); 
     1172 
     1173    if ( @{$self->attributes} &&  $flag_auto_attrs) { 
     1174        $set_attr_size .= "sizeof(Parrot_${classname}_attributes)"; 
     1175    } 
     1176    else { 
     1177        $set_attr_size .= "0" if $flag_manual_attrs || 
     1178                                 exists($self->{has_method}{init}) || 
     1179                                 exists($self->{has_method}{init_pmc}); 
     1180    } 
     1181    $set_attr_size =     "    vt->attr_size = " . $set_attr_size . ";\n" 
     1182        if $set_attr_size ne ''; 
     1183 
     1184    my $vtable_updates = ''; 
     1185    for my $name ( @{ $self->vtable->names } ) { 
     1186        if (exists $self->{has_method}{$name}) { 
     1187            $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n"; 
     1188        } 
     1189    } 
     1190 
     1191    $vtable_updates .= $set_attr_size; 
     1192 
     1193    $cout .= <<"EOC"; 
     1194 
     1195$export 
     1196VTABLE *Parrot_${classname}_update_vtable(VTABLE *vt) { 
     1197$vtable_updates 
     1198    return vt; 
     1199} 
     1200 
     1201EOC 
     1202 
     1203    # Generate RO vtable for implemented non-updating methods 
     1204    $vtable_updates = ''; 
     1205    foreach my $name ( @{ $self->vtable->names} ) { 
     1206        next unless exists $self->{has_method}{$name}; 
     1207        if ($self->vtable_method_does_write($name)) { 
     1208            # If we override constantness status of vtable 
     1209            if (!$self->vtable->attrs($name)->{write}) { 
     1210                $vtable_updates .= "    vt->$name = Parrot_${classname}_ro_${name};\n"; 
     1211            } 
     1212        } 
     1213        else { 
     1214            $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n"; 
     1215        } 
     1216    } 
     1217 
     1218    $vtable_updates .= $set_attr_size; 
     1219 
     1220    $cout .= <<"EOC"; 
     1221 
     1222$export 
     1223VTABLE *Parrot_${classname}_ro_update_vtable(ARGMOD(VTABLE *vt)) { 
     1224$vtable_updates 
     1225    return vt; 
     1226} 
     1227 
     1228EOC 
     1229 
     1230    $cout; 
     1231} 
     1232 
     1233=item C<get_mro_func()> 
     1234 
     1235Returns the C code for the PMC's get_mro function. 
     1236 
     1237=cut 
     1238 
     1239sub get_mro_func { 
     1240    my ($self) = @_; 
     1241 
     1242    my $cout      = ""; 
     1243    my $classname = $self->name; 
     1244    my $get_mro = ''; 
     1245    my @parent_names; 
     1246    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
     1247 
     1248    if ($classname ne 'default') { 
     1249        for my $dp (reverse @{ $self->direct_parents}) { 
     1250            $get_mro .= "    mro = Parrot_${dp}_get_mro(interp, mro);\n" 
     1251            unless $dp eq 'default'; 
     1252        } 
     1253    } 
     1254 
     1255    $cout .= <<"EOC"; 
     1256$export 
     1257PARROT_CANNOT_RETURN_NULL 
     1258PARROT_WARN_UNUSED_RESULT 
     1259PMC* Parrot_${classname}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro)) { 
     1260    if (PMC_IS_NULL(mro)) { 
     1261        mro = Parrot_pmc_new(interp, enum_class_ResizableStringArray); 
     1262    } 
     1263$get_mro 
     1264    VTABLE_unshift_string(interp, mro, 
     1265        Parrot_str_new_init(interp, "$classname", @{[length($classname)]}, 
     1266            Parrot_default_encoding_ptr, 0)); 
     1267    return mro; 
     1268} 
     1269 
     1270EOC 
     1271 
     1272    $cout; 
     1273} 
     1274 
     1275=item C<get_isa_func()> 
     1276 
     1277Returns the C code for the PMC's get_isa function. 
     1278 
     1279=cut 
     1280 
     1281sub get_isa_func { 
     1282    my ($self) = @_; 
     1283 
     1284    my $cout      = ""; 
     1285    my $classname = $self->name; 
     1286    my $get_isa = ''; 
     1287    my @parent_names; 
     1288    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
     1289 
     1290    if ($classname ne 'default') { 
     1291        for my $dp (reverse @{ $self->direct_parents}) { 
     1292            $get_isa .= "    isa = Parrot_${dp}_get_isa(interp, isa);\n" 
     1293            unless $dp eq 'default'; 
     1294        } 
     1295    } 
     1296 
     1297    $cout .= <<"EOC"; 
     1298$export 
     1299PARROT_CANNOT_RETURN_NULL 
     1300PARROT_WARN_UNUSED_RESULT 
     1301Hash* Parrot_${classname}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa)) { 
     1302EOC 
     1303 
     1304    if ($get_isa ne '') { 
     1305        $cout .= $get_isa; 
     1306    } 
     1307    else { 
     1308        $cout .= <<"EOC"; 
     1309    if (isa == NULL) { 
     1310        isa = Parrot_hash_new(interp); 
     1311    } 
     1312EOC 
     1313    } 
     1314    $cout .= <<"EOC"; 
     1315    Parrot_hash_put(interp, isa, (void *)(CONST_STRING_GEN(interp, "$classname")), PMCNULL); 
     1316    return isa; 
     1317} 
     1318 
     1319EOC 
     1320 
     1321    $cout; 
     1322} 
     1323 
     1324 
     1325=item C<get_vtable_func()> 
     1326 
     1327Returns the C code for the PMC's update_vtable. 
     1328 
     1329=cut 
     1330 
     1331sub get_vtable_func { 
     1332    my ($self) = @_; 
     1333 
     1334    my $cout      = ""; 
     1335    my $classname = $self->name; 
     1336    my @other_parents = reverse @{ $self->direct_parents }; 
     1337    my $first_parent = shift @other_parents; 
     1338    my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
     1339 
     1340    my $get_vtable = ''; 
     1341 
     1342    if ($first_parent eq 'default') { 
     1343        $get_vtable .= "    vt = Parrot_default_get_vtable(interp);\n"; 
     1344    } 
     1345    else { 
     1346        $get_vtable .= "    vt = Parrot_${first_parent}_get_vtable(interp);\n"; 
     1347    } 
     1348 
     1349    foreach my $parent_name ( @other_parents) { 
     1350        $get_vtable .= "    Parrot_${parent_name}_update_vtable(vt);\n"; 
     1351    } 
     1352 
     1353    $get_vtable .= "    Parrot_${classname}_update_vtable(vt);\n"; 
     1354 
     1355    $cout .= <<"EOC"; 
     1356$export 
     1357PARROT_CANNOT_RETURN_NULL 
     1358PARROT_WARN_UNUSED_RESULT 
     1359VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) { 
     1360    VTABLE *vt; 
     1361$get_vtable 
     1362    return vt; 
     1363} 
     1364 
     1365EOC 
     1366 
     1367    my $get_extra_vtable = ''; 
     1368 
     1369    if ($first_parent eq 'default') { 
     1370        $get_extra_vtable .= "    vt = Parrot_default_ro_get_vtable(interp);\n"; 
     1371    } 
     1372    else { 
     1373        $get_extra_vtable .= "    vt = Parrot_${first_parent}_ro_get_vtable(interp);\n"; 
     1374    } 
     1375 
     1376    foreach my $parent_name ( @other_parents ) { 
     1377        $get_extra_vtable .= "    Parrot_${parent_name}_ro_update_vtable(vt);\n"; 
     1378    } 
     1379 
     1380    if ($self->is_dynamic) { 
     1381        # The C could be optimized, but the case when Parrot_x_get_vtable_pointer 
     1382        # is needed is very rare.  See TT #898 for more info. 
     1383        $cout .= <<"EOC"; 
     1384$export 
     1385PARROT_CANNOT_RETURN_NULL 
     1386PARROT_WARN_UNUSED_RESULT 
     1387VTABLE* Parrot_${classname}_get_vtable_pointer(PARROT_INTERP) { 
     1388    STRING *type_name = Parrot_str_new_constant(interp, "${classname}"); 
     1389    INTVAL  type_num  = Parrot_pmc_get_type_str(interp, type_name); 
     1390    return interp->vtables[type_num]; 
     1391} 
     1392 
     1393EOC 
     1394    } 
     1395 
     1396    $get_extra_vtable .= "    Parrot_${classname}_ro_update_vtable(vt);\n"; 
     1397 
     1398    $cout .= <<"EOC"; 
     1399$export 
     1400PARROT_CANNOT_RETURN_NULL 
     1401PARROT_WARN_UNUSED_RESULT 
     1402VTABLE* Parrot_${classname}_ro_get_vtable(PARROT_INTERP) { 
     1403    VTABLE *vt; 
     1404$get_extra_vtable 
     1405    return vt; 
     1406} 
     1407 
     1408EOC 
     1409 
     1410    $cout; 
     1411} 
     1412 
     1413sub is_vtable_method { 
     1414    my ( $self, $vt_method_name ) = @_; 
     1415    return 1 if $self->vtable->has_method($vt_method_name); 
     1416    return 0; 
     1417} 
     1418 
     1419=item C<gen_switch_vtable> 
     1420 
     1421Generate switch-bases VTABLE for MULTI 
     1422 
     1423=back 
     1424 
     1425=cut 
     1426 
     1427sub gen_switch_vtable { 
     1428    my ($self) = @_; 
     1429 
     1430    # No cookies for DynPMC. At least not now. 
     1431    return 1 if $self->is_dynamic; 
     1432 
     1433    # Convert list of multis to name->[(type,,ssig,fsig,ns,func)] hash. 
     1434    my %multi_methods; 
     1435    foreach (@{$self->find_multi_functions}) { 
     1436        my ($name, $ssig, $fsig, $ns, $func, $method) = @$_; 
     1437        my @sig = split /,/, $fsig; 
     1438        push @{ $multi_methods{ $name } }, [ $sig[1], $ssig, $fsig, $ns, $func, $method ]; 
     1439    } 
     1440 
     1441    # vtables 
     1442    foreach my $method ( @{ $self->vtable->methods } ) { 
     1443        my $vt_method_name = $method->name; 
     1444        next if $vt_method_name eq 'class_init'; 
     1445 
     1446        next if $self->implements_vtable($vt_method_name); 
     1447        next unless exists $multi_methods{$vt_method_name}; 
     1448 
     1449        my $multis = $multi_methods{$vt_method_name}; 
     1450 
     1451        # Get parameters.      strip type from param 
     1452        my @parameters = map { s/(\s*\S+\s*\*?\s*)//; $_ } split (/,/, $method->parameters); 
     1453 
     1454        # Gather "case :" 
     1455        my @cases = map { $self->generate_single_case($vt_method_name, $_, @parameters) } @$multis; 
     1456        my $cases = join "", @cases; 
     1457 
     1458        my $body = <<"BODY"; 
     1459    INTVAL type = VTABLE_type(INTERP, $parameters[0]); 
     1460    /* For dynpmc fallback to MMD */ 
     1461    if ((type >= enum_class_core_max) || (SELF.type() >= enum_class_core_max)) 
     1462        type = enum_class_core_max; 
     1463    switch(type) { 
     1464$cases 
     1465    } 
     1466BODY 
     1467 
     1468        my $vtable = $method->clone({ 
     1469                body => Parrot::Pmc2c::Emitter->text($body), 
     1470            }); 
     1471        $self->add_method($vtable); 
     1472    } 
     1473 
     1474    1; 
     1475} 
     1476 
     1477# Generate single case for switch VTABLE 
     1478sub generate_single_case { 
     1479    my ($self, $vt_method_name, $multi, @parameters) = @_; 
     1480 
     1481    my ($type, $ssig, $fsig, $ns, $func, $impl) = @$multi; 
     1482    my $case; 
     1483 
     1484    # Gather parameters names 
     1485    my $parameters = join ', ', @parameters; 
     1486    # ISO C forbids return with expression from void functions. 
     1487    my $return = $impl->return_type =~ /^void\s*$/ 
     1488                    ? '' 
     1489                    : 'return '; 
     1490 
     1491    if ($type eq 'DEFAULT' || $type eq 'PMC') { 
     1492        # For default case we have to handle return manually. 
     1493        my ($pcc_signature, $retval, $call_tail, $pcc_return) 
     1494                = $self->gen_defaul_case_wrapping($ssig, @parameters); 
     1495        my $dispatch = "Parrot_mmd_multi_dispatch_from_c_args(INTERP, \"$vt_method_name\", \"$pcc_signature\", SELF, $parameters$call_tail);"; 
     1496 
     1497        $case = <<"CASE"; 
     1498        case enum_class_core_max: 
     1499CASE 
     1500        if ($retval eq '') { 
     1501        $case .= <<"CASE"; 
     1502            $dispatch 
     1503CASE 
     1504        } 
     1505        else { 
     1506        $case .= <<"CASE"; 
     1507            { 
     1508                $retval 
     1509                $dispatch 
     1510                $pcc_return 
     1511            } 
     1512CASE 
     1513        } 
     1514        $case .= <<"CASE"; 
     1515            break; 
     1516        default: 
     1517            $return$func(INTERP, SELF, $parameters); 
     1518            break; 
     1519CASE 
     1520    } 
     1521    else { 
     1522        $case = <<"CASE"; 
     1523        case enum_class_$type: 
     1524            $return$func(INTERP, SELF, $parameters); 
     1525            break; 
     1526CASE 
     1527    } 
     1528 
     1529    $case; 
     1530} 
     1531 
     1532# Generate (pcc_signature, retval holder, pcc_call_tail, return statement) 
     1533# for default case in switch. 
     1534sub gen_defaul_case_wrapping { 
     1535    my ($self, $ssig, @parameters) = @_; 
     1536 
     1537    my $letter = substr($ssig, 0, 1); 
     1538    if ($letter eq 'I') { 
     1539        return ( 
     1540            "PP->" . $letter, 
     1541            "INTVAL retval;", 
     1542            ', &retval', 
     1543            'return retval;', 
     1544        ); 
     1545    } 
     1546    elsif ($letter eq 'S') { 
     1547        return ( 
     1548            "PP->" . $letter, 
     1549            "STRING *retval;", 
     1550            ', &retval', 
     1551            'return retval;', 
     1552        ); 
     1553    } 
     1554    elsif ($letter eq 'P') { 
     1555        return ( 
     1556            'PPP->P', 
     1557            'PMC *retval = PMCNULL;', 
     1558            ", &retval", 
     1559            "return retval;", 
     1560        ); 
     1561    } 
     1562    elsif ($letter eq 'v') { 
     1563        return ( 
     1564            'PP->', 
     1565            '', 
     1566            '', 
     1567            'return;', 
     1568        ); 
     1569    } 
     1570    else { 
     1571        die "Can't handle signature $ssig!"; 
     1572    } 
     1573} 
    44615741; 
    4471575 
    4481576# Local Variables: 
  • lib/Parrot/Pmc2c/PMC/RO.pm

    diff --git a/lib/Parrot/Pmc2c/PMC/RO.pm b/lib/Parrot/Pmc2c/PMC/RO.pm
    index 27ecd21..94ea217 100644
    a b  
    2525use base qw( Parrot::Pmc2c::PMC ); 
    2626 
    2727use Parrot::Pmc2c::Emitter (); 
    28 use Parrot::Pmc2c::PMCEmitter (); 
    2928use Parrot::Pmc2c::Method (); 
    3029use Parrot::Pmc2c::UtilFunctions qw( return_statement ); 
    3130use Text::Balanced 'extract_bracketed'; 
  • (a) a/lib/Parrot/Pmc2c/PMCEmitter.pm vs. (b) /dev/null

    diff --git a/lib/Parrot/Pmc2c/PMCEmitter.pm b/lib/Parrot/Pmc2c/PMCEmitter.pm
    deleted file mode 100644
    index 66c35da..0000000
    a b  
    1 # Copyright (C) 2007-2011, Parrot Foundation. 
    2  
    3 =head1 NAME 
    4  
    5 Parrot::Pmc2c::PMCEmitter - PMC to C Code Generation 
    6  
    7 =head1 SYNOPSIS 
    8  
    9     use Parrot::Pmc2c::PMCEmitter; 
    10  
    11 =head1 DESCRIPTION 
    12  
    13 C<Parrot::Pmc2c::PMCEmitter> is used by F<tools/build/pmc2c.pl> to generate C code from PMC files. 
    14  
    15 =head2 Functions 
    16  
    17 =over 
    18  
    19 =cut 
    20  
    21 package Parrot::Pmc2c::PMC; 
    22 use strict; 
    23 use warnings; 
    24 use Parrot::Pmc2c::Emitter (); 
    25 use Parrot::Pmc2c::Method (); 
    26 use Parrot::Pmc2c::MethodEmitter (); 
    27 use Parrot::Pmc2c::UtilFunctions qw( dont_edit dynext_load_code c_code_coda ); 
    28 use Text::Balanced 'extract_bracketed'; 
    29 use Parrot::Pmc2c::PCCMETHOD (); 
    30 use Parrot::Pmc2c::MULTI (); 
    31 use Parrot::Pmc2c::PMC::RO (); 
    32 use Parrot::Pmc2c::PMC::ParrotClass (); 
    33  
    34 sub prep_for_emit { 
    35     my ( $this, $pmc, $vtable_dump ) = @_; 
    36  
    37     $pmc->vtable($vtable_dump); 
    38     $pmc->init(); 
    39  
    40     return $pmc; 
    41 } 
    42  
    43 sub generate { 
    44     my ($self) = @_; 
    45     my $emitter = $self->{emitter} = 
    46         Parrot::Pmc2c::Emitter->new( $self->filename(".c") ); 
    47  
    48     $self->generate_c_file; 
    49     $emitter->write_to_file; 
    50  
    51     $emitter = $self->{emitter} = 
    52         Parrot::Pmc2c::Emitter->new( $self->filename(".h", $self->is_dynamic) ); 
    53  
    54     $self->generate_h_file; 
    55     $emitter->write_to_file; 
    56 } 
    57  
    58 =item C<generate_c_file()> 
    59  
    60 Generates the C implementation file code for the PMC. 
    61  
    62 =cut 
    63  
    64 sub generate_c_file { 
    65     my ($self) = @_; 
    66     my $c      = $self->{emitter}; 
    67  
    68     $c->emit( dont_edit( $self->filename ) ); 
    69     if ($self->is_dynamic) { 
    70         $c->emit("#define PARROT_IN_EXTENSION\n"); 
    71         $c->emit("#define CONST_STRING(i, s) Parrot_str_new_constant((i), s)\n"); 
    72         $c->emit("#define CONST_STRING_GEN(i, s) Parrot_str_new_constant((i), s)\n"); 
    73     } 
    74  
    75     $self->gen_includes; 
    76  
    77     # The PCC code needs Continuation-related macros from these headers. 
    78     $c->emit("#include \"pmc_continuation.h\"\n"); 
    79     $c->emit("#include \"pmc_callcontext.h\"\n"); 
    80  
    81     $c->emit( $self->preamble ); 
    82  
    83     $c->emit( $self->hdecls ); 
    84     $c->emit( $self->{ro}->hdecls ) if ( $self->{ro} ); 
    85     $self->gen_methods; 
    86  
    87     my $ro = $self->ro; 
    88     if ($ro) { 
    89         $ro->{emitter} = $self->{emitter}; 
    90         $ro->gen_methods; 
    91     } 
    92  
    93     $c->emit("#include \"pmc_default.h\"\n"); 
    94  
    95     $c->emit( $self->update_vtable_func ); 
    96     $c->emit( $self->get_vtable_func ); 
    97     $c->emit( $self->get_mro_func ); 
    98     $c->emit( $self->get_isa_func ); 
    99     $c->emit( $self->pmc_class_init_func ); 
    100     $c->emit( $self->init_func ); 
    101     $c->emit( $self->postamble ); 
    102  
    103     return 1; 
    104 } 
    105  
    106 =item C<generate_h_file()> 
    107  
    108 Generates the C header file code for the PMC. 
    109  
    110 =cut 
    111  
    112 sub generate_h_file { 
    113     my ($self)  = @_; 
    114     my $h       = $self->{emitter}; 
    115     my $uc_name = uc $self->name; 
    116     my $name    = $self->name; 
    117  
    118     $h->emit( dont_edit( $self->filename ) ); 
    119     $h->emit(<<"EOH"); 
    120  
    121 #ifndef PARROT_PMC_${uc_name}_H_GUARD 
    122 #define PARROT_PMC_${uc_name}_H_GUARD 
    123  
    124 EOH 
    125  
    126     $h->emit("#define PARROT_IN_EXTENSION\n") if ( $self->is_dynamic ); 
    127  
    128     # Emit available functions for work with vtables. 
    129     my $export = 'PARROT_EXPORT '; 
    130     if ($self->is_dynamic) { 
    131         $export = 'PARROT_DYNEXT_EXPORT '; 
    132         $h->emit("${export}VTABLE* Parrot_${name}_get_vtable_pointer(PARROT_INTERP);\n"); 
    133         $h->emit("${export}void    Parrot_${name}_class_init(PARROT_INTERP, int, int);\n"); 
    134     } 
    135  
    136     if ($name ne 'default') { 
    137         $h->emit("${export}VTABLE* Parrot_${name}_update_vtable(ARGMOD(VTABLE*));\n"); 
    138         $h->emit("${export}VTABLE* Parrot_${name}_ro_update_vtable(ARGMOD(VTABLE*));\n"); 
    139     } 
    140     $h->emit("${export}VTABLE* Parrot_${name}_get_vtable(PARROT_INTERP);\n"); 
    141     $h->emit("${export}VTABLE* Parrot_${name}_ro_get_vtable(PARROT_INTERP);\n"); 
    142     $h->emit("${export}PMC*    Parrot_${name}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro));\n"); 
    143     $h->emit("${export}Hash*   Parrot_${name}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa));\n"); 
    144  
    145  
    146     $self->gen_attributes; 
    147     $h->emit(<<"EOH"); 
    148  
    149 #endif /* PARROT_PMC_${uc_name}_H_GUARD */ 
    150  
    151 EOH 
    152     $h->emit( c_code_coda() ); 
    153     return 1; 
    154 } 
    155  
    156 =item C<hdecls()> 
    157  
    158 Returns the C code function declarations for all the methods for inclusion 
    159 in the PMC's C header file. 
    160  
    161 =cut 
    162  
    163 sub hdecls { 
    164     my ($self) = @_; 
    165  
    166     my $hout; 
    167     my $name    = $self->name; 
    168     my $lc_name = $self->name; 
    169  
    170     # generate decls for all vtables in this PMC 
    171     foreach my $vt_method_name ( @{ $self->vtable->names } ) { 
    172         if ( $self->implements_vtable($vt_method_name) ) { 
    173             $hout .= 
    174                 $self->get_method($vt_method_name)->generate_headers($self); 
    175         } 
    176     } 
    177  
    178     # generate decls for all nci methods in this PMC 
    179     foreach my $method ( @{ $self->{methods} } ) { 
    180         next if $method->is_vtable; 
    181         $hout .= $method->generate_headers($self); 
    182     } 
    183  
    184     my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : ''; 
    185  
    186     # class init decl 
    187     $hout .= "${export}void    Parrot_${name}_class_init(PARROT_INTERP, int, int);\n"; 
    188  
    189     $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT '; 
    190  
    191     $hout .= "${export}VTABLE* Parrot_${lc_name}_update_vtable(ARGMOD(VTABLE*));\n" 
    192         unless $name eq 'default'; 
    193  
    194     $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable(PARROT_INTERP);\n"; 
    195  
    196     $hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable_pointer(PARROT_INTERP);\n" 
    197         if ($self->is_dynamic); 
    198  
    199     $self->{hdecls} .= $hout; 
    200  
    201     return $self->{hdecls}; 
    202 } 
    203  
    204 =back 
    205  
    206 =head2 Instance Methods 
    207  
    208 =over 
    209  
    210 =item C<init()> 
    211  
    212 Initializes the instance. 
    213  
    214 =cut 
    215  
    216 sub init { 
    217     my ($self) = @_; 
    218  
    219     #!( singleton or abstract ) everything else gets readonly version of 
    220     # methods too. 
    221  
    222     $self->ro( Parrot::Pmc2c::PMC::RO->new($self) ) 
    223         unless $self->abstract or $self->singleton; 
    224 } 
    225  
    226 =item C<gen_includes()> 
    227  
    228 Returns the C C<#include> for the header file of each of the PMC's superclasses. 
    229  
    230 =cut 
    231  
    232 sub gen_includes { 
    233     my ($self) = @_; 
    234     my $c      = $self->{emitter}; 
    235  
    236     $c->emit(<<"EOC"); 
    237 #include "parrot/parrot.h" 
    238 #include "parrot/extend.h" 
    239 #include "parrot/dynext.h" 
    240 EOC 
    241  
    242     $c->emit(qq{#include "pmc_fixedintegerarray.h"\n}) 
    243         if $self->flag('need_fia_header'); 
    244  
    245     foreach my $parent_name ( $self->name, @{ $self->parents } ) { 
    246         $c->emit( '#include "pmc_' . lc $parent_name . ".h\"\n" ); 
    247     } 
    248  
    249     foreach my $mixin_name ( @{ $self->mixins } ) { 
    250         $c->emit( '#include "pmc_' . lc $mixin_name . ".h\"\n" ); 
    251     } 
    252  
    253     $c->emit( '#include "' . lc $self->name . ".str\"\n" ) 
    254         unless $self->is_dynamic; 
    255 } 
    256  
    257 =item C<pre_method_gen> 
    258  
    259 Generate switch-bases VTABLE for MULTI 
    260  
    261 =cut 
    262  
    263 sub pre_method_gen { 
    264     my ($self) = @_; 
    265  
    266     $self->gen_switch_vtable; 
    267  
    268     1; 
    269 } 
    270  
    271 =item C<gen_methods()> 
    272  
    273 Returns the C code for the pmc methods. 
    274  
    275 =cut 
    276  
    277 sub gen_methods { 
    278     my ($self) = @_; 
    279  
    280     # vtables 
    281     foreach my $method ( @{ $self->vtable->methods } ) { 
    282         my $vt_method_name = $method->name; 
    283         next if $vt_method_name eq 'class_init'; 
    284  
    285         if ( $self->implements_vtable($vt_method_name) ) { 
    286             $self->get_method($vt_method_name)->generate_body($self); 
    287         } 
    288     } 
    289  
    290     # methods 
    291     foreach my $method ( @{ $self->methods } ) { 
    292         next if $method->is_vtable; 
    293         $method->generate_body($self); 
    294     } 
    295 } 
    296  
    297 =item C<gen_attributes()> 
    298  
    299 Returns the C code for the attribute struct definition. 
    300  
    301 =cut 
    302  
    303 sub gen_attributes { 
    304     my ($self)     = @_; 
    305     my $attributes = $self->attributes; 
    306  
    307     if ( @{$attributes} ) { 
    308  
    309         Parrot::Pmc2c::Attribute::generate_start( $attributes->[0], $self ); 
    310  
    311         foreach my $attribute ( @{$attributes} ) { 
    312             $attribute->generate_declaration($self); 
    313         } 
    314  
    315         Parrot::Pmc2c::Attribute::generate_end( $attributes->[0], $self ); 
    316  
    317         foreach my $attribute ( @{$attributes} ) { 
    318             $attribute->generate_accessor($self); 
    319         } 
    320     } 
    321 } 
    322  
    323 =item C<find_multi_functions()> 
    324  
    325 Returns an arrayref of MULTI function names declared in the PMC. Used to 
    326 initialize the multiple dispatch function list. 
    327  
    328 =cut 
    329  
    330 sub find_multi_functions { 
    331     my ($self)  = @_; 
    332  
    333     my $pmcname = $self->name; 
    334     my ( @multi_names ); 
    335  
    336     foreach my $method ( @{ $self->methods } ) { 
    337         next unless $method->is_multi; 
    338         my $short_sig    = $method->{MULTI_short_sig}; 
    339         my $full_sig     = $pmcname . "," . $method->{MULTI_full_sig}; 
    340         my $functionname = 'Parrot_' . $pmcname . '_' . $method->name; 
    341         push @multi_names, [ $method->symbol, $short_sig, $full_sig, 
    342                              $pmcname, $functionname, $method ]; 
    343     } 
    344     return ( \@multi_names ); 
    345 } 
    346  
    347 sub build_full_c_vt_method_name { 
    348     my ( $self, $vt_method_name ) = @_; 
    349  
    350     my $implementor; 
    351     if ( $self->implements_vtable($vt_method_name) ) { 
    352         return $self->get_method($vt_method_name) 
    353             ->full_method_name( $self->name . $self->{variant} ); 
    354     } 
    355     elsif ( $self->{super}{$vt_method_name} ) { 
    356         $implementor = $self->{super}{$vt_method_name}; 
    357     } 
    358     else { 
    359         $implementor = "default"; 
    360     } 
    361  
    362     return "Parrot_${implementor}_$vt_method_name"; 
    363 } 
    364  
    365 =item C<vtable_flags()> 
    366  
    367 Returns C code to produce a PMC's flags. 
    368  
    369 =cut 
    370  
    371 sub vtable_flags { 
    372     my ($self) = @_; 
    373  
    374     my $vtbl_flag = 0; 
    375     $vtbl_flag .= '|VTABLE_PMC_IS_SINGLETON'  if $self->flag('singleton'); 
    376     $vtbl_flag .= '|VTABLE_IS_SHARED_FLAG'    if $self->flag('is_shared'); 
    377     $vtbl_flag .= '|VTABLE_IS_READONLY_FLAG'  if $self->flag('is_ro'); 
    378     $vtbl_flag .= '|VTABLE_HAS_READONLY_FLAG' if $self->flag('has_ro'); 
    379  
    380     return $vtbl_flag; 
    381 } 
    382  
    383 =item C<vtable_decl($name)> 
    384  
    385 Returns the C code for the declaration of a vtable temporary named 
    386 C<$name> with the functions for this class. 
    387  
    388 =cut 
    389  
    390 sub vtable_decl { 
    391     my ( $self, $temp_struct_name, $enum_name ) = @_; 
    392  
    393     # gen vtable flags 
    394     my $vtbl_flag = $self->vtable_flags; 
    395  
    396     my @vt_methods; 
    397     foreach my $vt_method ( @{ $self->vtable->methods } ) { 
    398         next if $vt_method->is_mmd; 
    399         push @vt_methods, 
    400             $self->build_full_c_vt_method_name( $vt_method->name ); 
    401     } 
    402  
    403     my $methlist = join( ",\n        ", @vt_methods ); 
    404  
    405     my $cout = <<ENDOFCODE; 
    406     const VTABLE $temp_struct_name = { 
    407         NULL,       /* namespace */ 
    408         $enum_name, /* base_type */ 
    409         NULL,       /* whoami */ 
    410         $vtbl_flag, /* flags */ 
    411         NULL,       /* provides_str */ 
    412         NULL,       /* isa_hash */ 
    413         NULL,       /* class */ 
    414         NULL,       /* mro */ 
    415         NULL,       /* attribute_defs */ 
    416         NULL,       /* ro_variant_vtable */ 
    417         $methlist, 
    418         0           /* attr size */ 
    419     }; 
    420 ENDOFCODE 
    421     return $cout; 
    422 } 
    423  
    424 sub gen_multi_name 
    425 { 
    426     my ($name, $cache) = @_; 
    427  
    428     return $cache->{$name} if exists $cache->{$name}; 
    429     my $count              = keys %$cache; 
    430     return $cache->{$name} = "mfl_$count"; 
    431 } 
    432  
    433 =item C<pmc_class_init_func()> 
    434  
    435 Returns the C code for the PMC's class_init function as a static 
    436 function to be called from the exported class_init. 
    437  
    438 =cut 
    439  
    440 sub pmc_class_init_func { 
    441     my ($self) = @_; 
    442     my $class_init_code = ""; 
    443  
    444     if ($self->has_method('class_init')) { 
    445         $class_init_code .= $self->get_method('class_init')->body; 
    446  
    447         $class_init_code =~ s/INTERP/interp/g; 
    448  
    449         # fix indenting 
    450         $class_init_code =~ s/^/    /mg; 
    451         $class_init_code = <<ENDOFCODE 
    452 static void thispmc_class_init(PARROT_INTERP, int entry) 
    453 { 
    454 $class_init_code 
    455 } 
    456 ENDOFCODE 
    457     } 
    458     return $class_init_code; 
    459 } 
    460  
    461 =item C<init_func()> 
    462  
    463 Returns the C code for the PMC's initialization method, or an empty 
    464 string if the PMC has a C<no_init> flag. 
    465  
    466 =cut 
    467  
    468 sub init_func { 
    469     my ($self) = @_; 
    470     return '' if $self->no_init; 
    471  
    472     my $cout        = ''; 
    473     my $classname   = $self->name; 
    474     my $enum_name   = $self->is_dynamic ? -1 : "enum_class_$classname"; 
    475     my $multi_funcs = $self->find_multi_functions(); 
    476  
    477     my @multi_list; 
    478     my %strings_seen; 
    479     my $multi_strings = ''; 
    480     my $cache         = {}; 
    481  
    482     my $i = 0; 
    483     for my $multi (@$multi_funcs) { 
    484         my ($name, $ssig, $fsig, $ns, $func) = @$multi; 
    485         my ($name_str, $ssig_str, $fsig_str, $ns_name)     = 
    486             map { gen_multi_name($_, $cache) } ($name, $ssig, $fsig, $ns); 
    487  
    488         for my $s ([$name, $name_str], 
    489                    [$ssig, $ssig_str], 
    490                    [$fsig, $fsig_str], 
    491                    [$ns,   $ns_name ]) { 
    492             my ($raw_string, $name) = @$s; 
    493             next if $strings_seen{$name}++; 
    494             $multi_strings .=  "            STRING * const $name = " 
    495                            . qq|CONST_STRING_GEN(interp, "$raw_string");\n|; 
    496         } 
    497  
    498         push @multi_list, <<END_MULTI_LIST; 
    499             _temp_multi_func_list[$i].multi_name = $name_str; 
    500             _temp_multi_func_list[$i].short_sig = $ssig_str; 
    501             _temp_multi_func_list[$i].full_sig = $fsig_str; 
    502             _temp_multi_func_list[$i].ns_name = $ns_name; 
    503             _temp_multi_func_list[$i].func_ptr = (funcptr_t) $func; 
    504 END_MULTI_LIST 
    505         $i++; 
    506  
    507     } 
    508  
    509     my $multi_list_size = @multi_list; 
    510     my $multi_list = join( "\n", @multi_list); 
    511  
    512     my $provides        = join( " ", keys( %{ $self->{flags}{provides} } ) ); 
    513     my $class_init_code = ""; 
    514  
    515     if ($self->has_method('class_init')) { 
    516         $class_init_code .= "        thispmc_class_init(interp, entry);\n"; 
    517     } 
    518  
    519     my %extra_vt; 
    520     $extra_vt{ro} = $self->{ro} if $self->{ro}; 
    521  
    522     $cout .= <<"EOC"; 
    523 void 
    524 Parrot_${classname}_class_init(PARROT_INTERP, int entry, int pass) 
    525 { 
    526     static const char attr_defs [] = 
    527 EOC 
    528     $cout .= '        "'; 
    529  
    530     my $attributes = $self->attributes; 
    531     foreach my $attribute ( @$attributes ) { 
    532         my $attrtype       = $attribute->{type}; 
    533         my $attrname       = $attribute->{name}; 
    534         my $typeid = ':'; # Unhandled 
    535         if($attrname =~ m/\(*(\w+)\)\(.*?\)/) { 
    536             $attrname = $1; 
    537         } 
    538         elsif ($attrtype eq "INTVAL") { 
    539             $typeid = 'I'; 
    540         } 
    541         elsif ($attrtype eq "FLOATVAL") { 
    542             $typeid = 'F'; 
    543         } 
    544         elsif ($attrtype =~ /STRING\s*\*$/) { 
    545             $typeid = 'S'; 
    546         } 
    547         elsif ($attrtype =~ /PMC\s*\*$/) { 
    548             $typeid = 'F'; 
    549         } 
    550  
    551         $cout .= $typeid; 
    552         $cout .= $attrname; 
    553         $cout .= ' '; 
    554     } 
    555  
    556     $cout .= "\";\n"; 
    557  
    558     my $const = ( $self->{flags}{dynpmc} ) ? " " : " const "; 
    559  
    560     my $flags = $self->vtable_flags; 
    561     $cout .= <<"EOC"; 
    562     if (pass == 0) { 
    563         VTABLE * const vt  = Parrot_${classname}_get_vtable(interp); 
    564         vt->base_type      = $enum_name; 
    565         vt->flags          = $flags; 
    566         vt->attribute_defs = attr_defs; 
    567         interp->vtables[entry] = vt; 
    568  
    569 EOC 
    570  
    571     # init vtable slot 
    572     if ( $self->is_dynamic ) { 
    573         $cout .= <<"EOC"; 
    574         vt->base_type    = entry; 
    575         vt->whoami       = Parrot_str_new_init(interp, "$classname", @{[length($classname)]}, 
    576                                        Parrot_ascii_encoding_ptr, PObj_constant_FLAG|PObj_external_FLAG); 
    577         vt->provides_str = Parrot_str_concat(interp, vt->provides_str, 
    578             Parrot_str_new_init(interp, "$provides", @{[length($provides)]}, Parrot_ascii_encoding_ptr, 
    579             PObj_constant_FLAG|PObj_external_FLAG)); 
    580  
    581 EOC 
    582     } 
    583     else { 
    584         $cout .= <<"EOC"; 
    585         vt->whoami       = CONST_STRING_GEN(interp, "$classname"); 
    586         vt->provides_str = CONST_STRING_GEN(interp, "$provides"); 
    587 EOC 
    588     } 
    589  
    590     $cout .= <<"EOC"; 
    591         vt->isa_hash     = Parrot_${classname}_get_isa(interp, NULL); 
    592 EOC 
    593  
    594     for my $k ( keys %extra_vt ) { 
    595         my $k_flags = $self->$k->vtable_flags; 
    596         $cout .= <<"EOC"; 
    597         { 
    598             VTABLE                   *vt_$k; 
    599             vt_${k}                 = Parrot_${classname}_${k}_get_vtable(interp); 
    600             vt_${k}->base_type      = $enum_name; 
    601             vt_${k}->flags          = $k_flags; 
    602  
    603             vt_${k}->attribute_defs = attr_defs; 
    604  
    605             vt_${k}->base_type           = entry; 
    606             vt_${k}->whoami              = vt->whoami; 
    607             vt_${k}->provides_str        = vt->provides_str; 
    608             vt->${k}_variant_vtable      = vt_${k}; 
    609             vt_${k}->${k}_variant_vtable = vt; 
    610             vt_${k}->isa_hash            = vt->isa_hash; 
    611         } 
    612  
    613 EOC 
    614     } 
    615  
    616     $cout .= <<"EOC"; 
    617     } 
    618     else { /* pass */ 
    619 EOC 
    620  
    621     # To make use of the .HLL directive, register any mapping... 
    622     if ( $self->{flags}{hll} && $self->{flags}{maps} ) { 
    623  
    624         my $hll = $self->{flags}{hll}; 
    625         $cout .= <<"EOC"; 
    626  
    627         { 
    628             /* Register this PMC as a HLL mapping */ 
    629             const INTVAL hll_id = Parrot_hll_get_HLL_id( interp, CONST_STRING_GEN(interp, "$hll")); 
    630             if (hll_id > 0) { 
    631 EOC 
    632         foreach my $maps ( sort keys %{ $self->{flags}{maps} } ) { 
    633             $cout .= <<"EOC"; 
    634                 Parrot_hll_register_HLL_type( interp, hll_id, enum_class_$maps, entry); 
    635 EOC 
    636         } 
    637         $cout .= <<"EOC"; 
    638             } 
    639         } /* Register */ 
    640 EOC 
    641     } 
    642  
    643         $cout .= <<"EOC"; 
    644         { 
    645             VTABLE * const vt  = interp->vtables[entry]; 
    646  
    647             vt->mro = Parrot_${classname}_get_mro(interp, PMCNULL); 
    648  
    649             if (vt->ro_variant_vtable) 
    650                 vt->ro_variant_vtable->mro = vt->mro; 
    651         } 
    652  
    653         /* set up MRO and _namespace */ 
    654         Parrot_pmc_create_mro(interp, entry); 
    655 EOC 
    656  
    657     # declare each nci method for this class 
    658     foreach my $method ( @{ $self->{methods} } ) { 
    659         next unless $method->type eq Parrot::Pmc2c::Method::NON_VTABLE; 
    660  
    661         #these differ for METHODs 
    662         my $method_name     = $method->name; 
    663         my $symbol_name     = $method->symbol; 
    664         my ($pcc_signature) = $method->pcc_signature; 
    665  
    666         $cout .= <<"EOC"; 
    667         { 
    668             STRING *method_name = CONST_STRING_GEN(interp, "$symbol_name"); 
    669             STRING *signature   = CONST_STRING_GEN(interp, "$pcc_signature"); 
    670             register_native_pcc_method_in_ns(interp, entry, 
    671                 F2DPTR(Parrot_${classname}_${method_name}), 
    672                 method_name, signature); 
    673         } 
    674 EOC 
    675         if ( $method->{attrs}{write} ) { 
    676             $cout .= <<"EOC"; 
    677         Parrot_mark_method_writes(interp, entry, "$symbol_name"); 
    678 EOC 
    679         } 
    680     } 
    681  
    682     # include any class specific init code from the .pmc file 
    683     if ($class_init_code) { 
    684         $cout .= <<"EOC"; 
    685  
    686         /* class_init */ 
    687 $class_init_code 
    688  
    689 EOC 
    690     } 
    691  
    692     $cout .= <<"EOC"; 
    693         { 
    694 EOC 
    695  
    696  
    697     if ( @$multi_funcs ) { 
    698         # Don't const the list, breaks some older C compilers 
    699         $cout .= $multi_strings . <<"EOC"; 
    700  
    701             multi_func_list _temp_multi_func_list[$multi_list_size]; 
    702 $multi_list 
    703             Parrot_mmd_add_multi_list_from_c_args(interp, 
    704                 _temp_multi_func_list, $multi_list_size); 
    705 EOC 
    706     } 
    707  
    708     $cout .= <<"EOC"; 
    709         } 
    710     } /* pass */ 
    711 } /* Parrot_${classname}_class_init */ 
    712 EOC 
    713  
    714     if ( $self->is_dynamic ) { 
    715         $cout .= dynext_load_code( $classname, $classname => {} ); 
    716     } 
    717  
    718     $cout; 
    719 } 
    720  
    721 =item C<update_vtable_func()> 
    722  
    723 Returns the C code for the PMC's update_vtable. 
    724  
    725 =cut 
    726  
    727 sub update_vtable_func { 
    728     my ($self) = @_; 
    729  
    730     my $cout      = ""; 
    731     my $classname = $self->name; 
    732     my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
    733  
    734     # Sets the attr_size field: 
    735     # - If the auto_attrs flag is set, use the current data. 
    736     # - If manual_attrs is set, set to 0. 
    737     # - If none is set, check if this PMC has init or init_pmc vtable functions, 
    738     # setting it to 0 in that case, and keeping the value from the 
    739     # parent otherwise. 
    740     my $set_attr_size = ''; 
    741     my $flag_auto_attrs = $self->{flags}{auto_attrs}; 
    742     my $flag_manual_attrs = $self->{flags}{manual_attrs}; 
    743     die 'manual_attrs and auto_attrs can not be used together' 
    744          . 'in PMC ' . $self->name 
    745         if ($flag_auto_attrs && $flag_manual_attrs); 
    746     die 'PMC ' . $self->name . ' has attributes but no auto_attrs or manual_attrs' 
    747         if (@{$self->attributes} && ! ($flag_auto_attrs || $flag_manual_attrs)); 
    748  
    749     if ( @{$self->attributes} &&  $flag_auto_attrs) { 
    750         $set_attr_size .= "sizeof(Parrot_${classname}_attributes)"; 
    751     } 
    752     else { 
    753         $set_attr_size .= "0" if $flag_manual_attrs || 
    754                                  exists($self->{has_method}{init}) || 
    755                                  exists($self->{has_method}{init_pmc}); 
    756     } 
    757     $set_attr_size =     "    vt->attr_size = " . $set_attr_size . ";\n" 
    758         if $set_attr_size ne ''; 
    759  
    760     my $vtable_updates = ''; 
    761     for my $name ( @{ $self->vtable->names } ) { 
    762         if (exists $self->{has_method}{$name}) { 
    763             $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n"; 
    764         } 
    765     } 
    766  
    767     $vtable_updates .= $set_attr_size; 
    768  
    769     $cout .= <<"EOC"; 
    770  
    771 $export 
    772 VTABLE *Parrot_${classname}_update_vtable(VTABLE *vt) { 
    773 $vtable_updates 
    774     return vt; 
    775 } 
    776  
    777 EOC 
    778  
    779     # Generate RO vtable for implemented non-updating methods 
    780     $vtable_updates = ''; 
    781     foreach my $name ( @{ $self->vtable->names} ) { 
    782         next unless exists $self->{has_method}{$name}; 
    783         if ($self->vtable_method_does_write($name)) { 
    784             # If we override constantness status of vtable 
    785             if (!$self->vtable->attrs($name)->{write}) { 
    786                 $vtable_updates .= "    vt->$name = Parrot_${classname}_ro_${name};\n"; 
    787             } 
    788         } 
    789         else { 
    790             $vtable_updates .= "    vt->$name = Parrot_${classname}_${name};\n"; 
    791         } 
    792     } 
    793  
    794     $vtable_updates .= $set_attr_size; 
    795  
    796     $cout .= <<"EOC"; 
    797  
    798 $export 
    799 VTABLE *Parrot_${classname}_ro_update_vtable(ARGMOD(VTABLE *vt)) { 
    800 $vtable_updates 
    801     return vt; 
    802 } 
    803  
    804 EOC 
    805  
    806     $cout; 
    807 } 
    808  
    809 =item C<get_mro_func()> 
    810  
    811 Returns the C code for the PMC's get_mro function. 
    812  
    813 =cut 
    814  
    815 sub get_mro_func { 
    816     my ($self) = @_; 
    817  
    818     my $cout      = ""; 
    819     my $classname = $self->name; 
    820     my $get_mro = ''; 
    821     my @parent_names; 
    822     my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
    823  
    824     if ($classname ne 'default') { 
    825         for my $dp (reverse @{ $self->direct_parents}) { 
    826             $get_mro .= "    mro = Parrot_${dp}_get_mro(interp, mro);\n" 
    827             unless $dp eq 'default'; 
    828         } 
    829     } 
    830  
    831     $cout .= <<"EOC"; 
    832 $export 
    833 PARROT_CANNOT_RETURN_NULL 
    834 PARROT_WARN_UNUSED_RESULT 
    835 PMC* Parrot_${classname}_get_mro(PARROT_INTERP, ARGIN_NULLOK(PMC* mro)) { 
    836     if (PMC_IS_NULL(mro)) { 
    837         mro = Parrot_pmc_new(interp, enum_class_ResizableStringArray); 
    838     } 
    839 $get_mro 
    840     VTABLE_unshift_string(interp, mro, 
    841         Parrot_str_new_init(interp, "$classname", @{[length($classname)]}, 
    842             Parrot_default_encoding_ptr, 0)); 
    843     return mro; 
    844 } 
    845  
    846 EOC 
    847  
    848     $cout; 
    849 } 
    850  
    851 =item C<get_isa_func()> 
    852  
    853 Returns the C code for the PMC's get_isa function. 
    854  
    855 =cut 
    856  
    857 sub get_isa_func { 
    858     my ($self) = @_; 
    859  
    860     my $cout      = ""; 
    861     my $classname = $self->name; 
    862     my $get_isa = ''; 
    863     my @parent_names; 
    864     my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
    865  
    866     if ($classname ne 'default') { 
    867         for my $dp (reverse @{ $self->direct_parents}) { 
    868             $get_isa .= "    isa = Parrot_${dp}_get_isa(interp, isa);\n" 
    869             unless $dp eq 'default'; 
    870         } 
    871     } 
    872  
    873     $cout .= <<"EOC"; 
    874 $export 
    875 PARROT_CANNOT_RETURN_NULL 
    876 PARROT_WARN_UNUSED_RESULT 
    877 Hash* Parrot_${classname}_get_isa(PARROT_INTERP, ARGIN_NULLOK(Hash* isa)) { 
    878 EOC 
    879  
    880     if ($get_isa ne '') { 
    881         $cout .= $get_isa; 
    882     } 
    883     else { 
    884         $cout .= <<"EOC"; 
    885     if (isa == NULL) { 
    886         isa = Parrot_hash_new(interp); 
    887     } 
    888 EOC 
    889     } 
    890     $cout .= <<"EOC"; 
    891     Parrot_hash_put(interp, isa, (void *)(CONST_STRING_GEN(interp, "$classname")), PMCNULL); 
    892     return isa; 
    893 } 
    894  
    895 EOC 
    896  
    897     $cout; 
    898 } 
    899  
    900  
    901 =item C<get_vtable_func()> 
    902  
    903 Returns the C code for the PMC's update_vtable. 
    904  
    905 =cut 
    906  
    907 sub get_vtable_func { 
    908     my ($self) = @_; 
    909  
    910     my $cout      = ""; 
    911     my $classname = $self->name; 
    912     my @other_parents = reverse @{ $self->direct_parents }; 
    913     my $first_parent = shift @other_parents; 
    914     my $export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT'; 
    915  
    916     my $get_vtable = ''; 
    917  
    918     if ($first_parent eq 'default') { 
    919         $get_vtable .= "    vt = Parrot_default_get_vtable(interp);\n"; 
    920     } 
    921     else { 
    922         $get_vtable .= "    vt = Parrot_${first_parent}_get_vtable(interp);\n"; 
    923     } 
    924  
    925     foreach my $parent_name ( @other_parents) { 
    926         $get_vtable .= "    Parrot_${parent_name}_update_vtable(vt);\n"; 
    927     } 
    928  
    929     $get_vtable .= "    Parrot_${classname}_update_vtable(vt);\n"; 
    930  
    931     $cout .= <<"EOC"; 
    932 $export 
    933 PARROT_CANNOT_RETURN_NULL 
    934 PARROT_WARN_UNUSED_RESULT 
    935 VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) { 
    936     VTABLE *vt; 
    937 $get_vtable 
    938     return vt; 
    939 } 
    940  
    941 EOC 
    942  
    943     my $get_extra_vtable = ''; 
    944  
    945     if ($first_parent eq 'default') { 
    946         $get_extra_vtable .= "    vt = Parrot_default_ro_get_vtable(interp);\n"; 
    947     } 
    948     else { 
    949         $get_extra_vtable .= "    vt = Parrot_${first_parent}_ro_get_vtable(interp);\n"; 
    950     } 
    951  
    952     foreach my $parent_name ( @other_parents ) { 
    953         $get_extra_vtable .= "    Parrot_${parent_name}_ro_update_vtable(vt);\n"; 
    954     } 
    955  
    956     if ($self->is_dynamic) { 
    957         # The C could be optimized, but the case when Parrot_x_get_vtable_pointer 
    958         # is needed is very rare.  See TT #898 for more info. 
    959         $cout .= <<"EOC"; 
    960 $export 
    961 PARROT_CANNOT_RETURN_NULL 
    962 PARROT_WARN_UNUSED_RESULT 
    963 VTABLE* Parrot_${classname}_get_vtable_pointer(PARROT_INTERP) { 
    964     STRING *type_name = Parrot_str_new_constant(interp, "${classname}"); 
    965     INTVAL  type_num  = Parrot_pmc_get_type_str(interp, type_name); 
    966     return interp->vtables[type_num]; 
    967 } 
    968  
    969 EOC 
    970     } 
    971  
    972     $get_extra_vtable .= "    Parrot_${classname}_ro_update_vtable(vt);\n"; 
    973  
    974     $cout .= <<"EOC"; 
    975 $export 
    976 PARROT_CANNOT_RETURN_NULL 
    977 PARROT_WARN_UNUSED_RESULT 
    978 VTABLE* Parrot_${classname}_ro_get_vtable(PARROT_INTERP) { 
    979     VTABLE *vt; 
    980 $get_extra_vtable 
    981     return vt; 
    982 } 
    983  
    984 EOC 
    985  
    986     $cout; 
    987 } 
    988  
    989 sub is_vtable_method { 
    990     my ( $self, $vt_method_name ) = @_; 
    991     return 1 if $self->vtable->has_method($vt_method_name); 
    992     return 0; 
    993 } 
    994  
    995 sub vtable { 
    996     my ( $self, $value ) = @_; 
    997     $self->{vtable} = $value if $value; 
    998     return $self->{vtable}; 
    999 } 
    1000  
    1001 =item C<gen_switch_vtable> 
    1002  
    1003 Generate switch-bases VTABLE for MULTI 
    1004  
    1005 =cut 
    1006  
    1007 sub gen_switch_vtable { 
    1008     my ($self) = @_; 
    1009  
    1010     # No cookies for DynPMC. At least not now. 
    1011     return 1 if $self->is_dynamic; 
    1012  
    1013     # Convert list of multis to name->[(type,,ssig,fsig,ns,func)] hash. 
    1014     my %multi_methods; 
    1015     foreach (@{$self->find_multi_functions}) { 
    1016         my ($name, $ssig, $fsig, $ns, $func, $method) = @$_; 
    1017         my @sig = split /,/, $fsig; 
    1018         push @{ $multi_methods{ $name } }, [ $sig[1], $ssig, $fsig, $ns, $func, $method ]; 
    1019     } 
    1020  
    1021     # vtables 
    1022     foreach my $method ( @{ $self->vtable->methods } ) { 
    1023         my $vt_method_name = $method->name; 
    1024         next if $vt_method_name eq 'class_init'; 
    1025  
    1026         next if $self->implements_vtable($vt_method_name); 
    1027         next unless exists $multi_methods{$vt_method_name}; 
    1028  
    1029         my $multis = $multi_methods{$vt_method_name}; 
    1030  
    1031         # Get parameters.      strip type from param 
    1032         my @parameters = map { s/(\s*\S+\s*\*?\s*)//; $_ } split (/,/, $method->parameters); 
    1033  
    1034         # Gather "case :" 
    1035         my @cases = map { $self->generate_single_case($vt_method_name, $_, @parameters) } @$multis; 
    1036         my $cases = join "", @cases; 
    1037  
    1038         my $body = <<"BODY"; 
    1039     INTVAL type = VTABLE_type(INTERP, $parameters[0]); 
    1040     /* For dynpmc fallback to MMD */ 
    1041     if ((type >= enum_class_core_max) || (SELF.type() >= enum_class_core_max)) 
    1042         type = enum_class_core_max; 
    1043     switch(type) { 
    1044 $cases 
    1045     } 
    1046 BODY 
    1047  
    1048         my $vtable = $method->clone({ 
    1049                 body => Parrot::Pmc2c::Emitter->text($body), 
    1050             }); 
    1051         $self->add_method($vtable); 
    1052     } 
    1053  
    1054     1; 
    1055 } 
    1056  
    1057 # Generate single case for switch VTABLE 
    1058 sub generate_single_case { 
    1059     my ($self, $vt_method_name, $multi, @parameters) = @_; 
    1060  
    1061     my ($type, $ssig, $fsig, $ns, $func, $impl) = @$multi; 
    1062     my $case; 
    1063  
    1064     # Gather parameters names 
    1065     my $parameters = join ', ', @parameters; 
    1066     # ISO C forbids return with expression from void functions. 
    1067     my $return = $impl->return_type =~ /^void\s*$/ 
    1068                     ? '' 
    1069                     : 'return '; 
    1070  
    1071     if ($type eq 'DEFAULT' || $type eq 'PMC') { 
    1072         # For default case we have to handle return manually. 
    1073         my ($pcc_signature, $retval, $call_tail, $pcc_return) 
    1074                 = $self->gen_defaul_case_wrapping($ssig, @parameters); 
    1075         my $dispatch = "Parrot_mmd_multi_dispatch_from_c_args(INTERP, \"$vt_method_name\", \"$pcc_signature\", SELF, $parameters$call_tail);"; 
    1076  
    1077         $case = <<"CASE"; 
    1078         case enum_class_core_max: 
    1079 CASE 
    1080         if ($retval eq '') { 
    1081         $case .= <<"CASE"; 
    1082             $dispatch 
    1083 CASE 
    1084         } 
    1085         else { 
    1086         $case .= <<"CASE"; 
    1087             { 
    1088                 $retval 
    1089                 $dispatch 
    1090                 $pcc_return 
    1091             } 
    1092 CASE 
    1093         } 
    1094         $case .= <<"CASE"; 
    1095             break; 
    1096         default: 
    1097             $return$func(INTERP, SELF, $parameters); 
    1098             break; 
    1099 CASE 
    1100     } 
    1101     else { 
    1102         $case = <<"CASE"; 
    1103         case enum_class_$type: 
    1104             $return$func(INTERP, SELF, $parameters); 
    1105             break; 
    1106 CASE 
    1107     } 
    1108  
    1109     $case; 
    1110 } 
    1111  
    1112 # Generate (pcc_signature, retval holder, pcc_call_tail, return statement) 
    1113 # for default case in switch. 
    1114 sub gen_defaul_case_wrapping { 
    1115     my ($self, $ssig, @parameters) = @_; 
    1116  
    1117     my $letter = substr($ssig, 0, 1); 
    1118     if ($letter eq 'I') { 
    1119         return ( 
    1120             "PP->" . $letter, 
    1121             "INTVAL retval;", 
    1122             ', &retval', 
    1123             'return retval;', 
    1124         ); 
    1125     } 
    1126     elsif ($letter eq 'S') { 
    1127         return ( 
    1128             "PP->" . $letter, 
    1129             "STRING *retval;", 
    1130             ', &retval', 
    1131             'return retval;', 
    1132         ); 
    1133     } 
    1134     elsif ($letter eq 'P') { 
    1135         return ( 
    1136             'PPP->P', 
    1137             'PMC *retval = PMCNULL;', 
    1138             ", &retval", 
    1139             "return retval;", 
    1140         ); 
    1141     } 
    1142     elsif ($letter eq 'v') { 
    1143         return ( 
    1144             'PP->', 
    1145             '', 
    1146             '', 
    1147             'return;', 
    1148         ); 
    1149     } 
    1150     else { 
    1151         die "Can't handle signature $ssig!"; 
    1152     } 
    1153 } 
    1154  
    1155  
    1156 1; 
    1157  
    1158 # Local Variables: 
    1159 #   mode: cperl 
    1160 #   cperl-indent-level: 4 
    1161 #   fill-column: 100 
    1162 # End: 
    1163 # vim: expandtab shiftwidth=4: 
  • lib/Parrot/Pmc2c/Parser.pm

    diff --git a/lib/Parrot/Pmc2c/Parser.pm b/lib/Parrot/Pmc2c/Parser.pm
    index 04e1a7a..461a76a 100644
    a b  
    1 # Copyright (C) 2004-2008, Parrot Foundation. 
    2  
    31package Parrot::Pmc2c::Parser; 
    4  
     2# Copyright (C) 2004-2011, Parrot Foundation. 
    53use strict; 
    64use warnings; 
    7  
    85use base qw( Exporter ); 
    9  
    106our @EXPORT_OK = qw( parse_pmc extract_balanced ); 
    117use Parrot::Pmc2c::PMC (); 
    128use Parrot::Pmc2c::Attribute (); 
     
    2218 
    2319=head1 SYNOPSIS 
    2420 
    25     use Parrot::Pmc2c::Parser; 
     21    use Parrot::Pmc2c::Parser qw( 
     22        parse_pmc 
     23        extract_balanced 
     24    ); 
    2625 
    2726=head1 DESCRIPTION 
    2827 
    29 Parrot::Pmc2c::Parser parses a sudo C syntax into a perl hash that is then dumped. 
     28Parrot::Pmc2c::Parser parses a pseudo-C syntax into a perl hash that is then dumped. 
     29 
     30=head1 SUBROUTINES 
    3031 
     32This package exports two subroutines on request only. 
    3133 
    3234=head2 C<parse_pmc()> 
    3335 
     
    5153 
    5254B<Return Values:>  Reference to a Parrot::Pmc2c::PMC object 
    5355 
    54 B<Comments:>  Called by C<dump_pmc()>. 
     56B<Comments:>  Called by C<Parrot::Pmc2c::Dumper::dump_pmc()>. 
    5557 
    5658=cut 
    5759 
  • lib/Parrot/Pmc2c/UtilFunctions.pm

    diff --git a/lib/Parrot/Pmc2c/UtilFunctions.pm b/lib/Parrot/Pmc2c/UtilFunctions.pm
    index 04de4f8..1928b28 100644
    a b  
    1 # Copyright (C) 2007-2008, Parrot Foundation. 
     1# Copyright (C) 2007-2011, Parrot Foundation. 
    22 
    33package Parrot::Pmc2c::UtilFunctions; 
    44use strict; 
     
    1111    c_code_coda slurp spew filename 
    1212    args_from_parameter_list 
    1313    passable_args_from_parameter_list 
     14    gen_multi_name 
     15    trim 
    1416); 
    1517 
    1618=head1 NAME 
     
    1921 
    2022=head1 DESCRIPTION 
    2123 
    22 Various utility functions used in PMC to C transformations.  All functionas 
     24Various utility functions used in PMC to C transformations.  All functions 
    2325are exported on request only. 
    2426 
    2527=head1 SUBROUTINES 
     
    298300    $filename =~ s/\.\w+$/.pmc/          if ( $type eq ".pmc" ); 
    299301    return $filename; 
    300302} 
     303 
     304sub gen_multi_name { 
     305    my ($name, $cache) = @_; 
     306 
     307    return $cache->{$name} if exists $cache->{$name}; 
     308    my $count              = keys %$cache; 
     309    return $cache->{$name} = "mfl_$count"; 
     310} 
     311 
     312# Perl trim function to remove whitespace from the start and end of the string 
     313sub trim { 
     314    my $string = shift; 
     315    $string    =~ s/^\s+//; 
     316    $string    =~ s/\s+$//; 
     317    return $string; 
     318} 
     319 
    3013201; 
    302321 
    303322# Local Variables: 
  • tools/build/h2inc.pl

    diff --git a/tools/build/h2inc.pl b/tools/build/h2inc.pl
    index 07f5267..fee69f0 100644
    a b  
    1 # Copyright (C) 2009, Parrot Foundation. 
     1# Copyright (C) 2011, Parrot Foundation. 
    22 
    33=head1 NAME 
    44 
     
    1414 
    1515    perl tools/build/h2inc.pl <input_file> <output_file> 
    1616 
     17Example (from F<make> output): 
     18 
     19    /usr/local/bin/perl tools/build/h2inc.pl include/parrot/enums.h \ 
     20        lib/Parrot/Pmc2c/PCCMETHOD_BITS.pm 
     21 
    1722=cut 
    1823 
    1924use strict;