lib/Parrot/Pmc2c/PMC/delegate.pm

   1 # Copyright (C) 2007-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 Parrot::Pmc2c::delegate Instance Methods
   5
   6 =over 4
   7
   8 =cut
   9
  10 package Parrot::Pmc2c::PMC::delegate;
  11 use base 'Parrot::Pmc2c::PMC';
  12 use strict;
  13 use warnings;
  14
  15 =item C<pre_method_gen($self)>
  16
  17 Returns the C code for the method body.
  18
  19 The C<delegate> PMC redirects all methods to bytecode.
  20
  21 =cut
  22
  23 sub pre_method_gen {
  24     my ($self) = @_;
  25
  26     my $selfname = $self->name;
  27
  28     # vtable methods
  29     foreach my $method ( @{ $self->vtable->methods } ) {
  30         my $vt_method_name = $method->name;
  31         next unless $self->normal_unimplemented_vtable($vt_method_name);
  32         my $new_default_method = $method->clone(
  33             {
  34                 parent_name => $self->name,
  35                 type        => Parrot::Pmc2c::Method::VTABLE,
  36             }
  37         );
  38         my ( $func_ret, $ret_suffix, $args, $sig ) = $new_default_method->signature;
  39
  40         $new_default_method->body( Parrot::Pmc2c::Emitter->text(<<"EOC") );
  41
  42     STRING * const meth     = CONST_STRING_GEN(interp, "$vt_method_name");
  43     PMC    * const classobj = Parrot_oo_get_class_str(interp, VTABLE_name(interp, pmc));
  44     PMC    * const sub      = Parrot_oo_find_vtable_override(interp, classobj, meth);
  45     if (PMC_IS_NULL(sub))
  46         vtable_meth_not_found(interp, pmc, "$vt_method_name");
  47     ${func_ret}Parrot_run_meth_fromc_args$ret_suffix(interp, sub, pmc, meth, "$sig"$args);
  48 EOC
  49         $self->add_method($new_default_method);
  50     }
  51     return 1;
  52 }
  53
  54 1;
  55
  56 # Local Variables:
  57 #   mode: cperl
  58 #   cperl-indent-level: 4
  59 #   fill-column: 100
  60 # End:
  61 # vim: expandtab shiftwidth=4: