lib/Parrot/Pmc2c/PMC/Object.pm

   1 package Parrot::Pmc2c::PMC::Object;
   2
   3 # Copyright (C) 2007-2008, The Perl Foundation.
   4 # $Id$
   5
   6 use base 'Parrot::Pmc2c::PMC';
   7 use strict;
   8 use warnings;
   9
  10 =head1 C<body($method, $line, $out_name)>
  11
  12 Returns the C code for the method body.
  13
  14 Overrides the default implementation to direct all unknown methods to
  15 first check if there is an implementation of the vtable method in the
  16 vtable methods hash of this class of any others, and delegates up to
  17 any PMCs in the MRO.
  18
  19 =cut
  20
  21 sub pre_method_gen {
  22     my ($self) = @_;
  23
  24     # vtable methods
  25     foreach my $method ( @{ $self->vtable->methods } ) {
  26         my $vt_method_name = $method->name;
  27         next unless $self->normal_unimplemented_vtable($vt_method_name);
  28         my $new_default_method = $method->clone(
  29             {
  30                 parent_name => $self->name,
  31                 type        => Parrot::Pmc2c::Method::VTABLE,
  32             }
  33         );
  34
  35         my ( $return_prefix, $ret_suffix, $args, $sig, $return_type_char, $null_return ) =
  36             $new_default_method->signature;
  37         my $void_return  = $return_type_char eq 'v' ? 'return;'    : '';
  38         my $return       = $return_type_char eq 'v' ? ''           : $return_prefix;
  39         my $superargs    = $args;
  40         $superargs       =~ s/^,//;
  41
  42         $new_default_method->body( Parrot::Pmc2c::Emitter->text(<<"EOC") );
  43     Parrot_Object_attributes * const obj       = PARROT_OBJECT(pmc);
  44     Parrot_Class_attributes  * const _class    = PARROT_CLASS(obj->_class);
  45     STRING        * const meth_name = CONST_STRING_GEN(interp, "$vt_method_name");
  46
  47     /* Walk and search for the vtable method. */
  48     const int num_classes = VTABLE_elements(interp, _class->all_parents);
  49     int i;
  50     for (i = 0; i < num_classes; i++) {
  51         /* Get the class. */
  52         PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
  53
  54         PMC * const meth = Parrot_oo_find_vtable_override_for_class(interp, cur_class, meth_name);
  55         if (!PMC_IS_NULL(meth)) {
  56             ${return}Parrot_run_meth_fromc_args$ret_suffix(interp, meth, pmc, meth_name, "$sig"$args);
  57             $void_return
  58         }
  59
  60         if (cur_class->vtable->base_type == enum_class_PMCProxy) {
  61             /* Get the PMC instance and call the vtable method on that. */
  62             STRING * const proxy      = CONST_STRING_GEN(interp, "proxy");
  63             PMC    * const del_object = VTABLE_get_attr_str(interp, SELF, proxy);
  64
  65             if (!PMC_IS_NULL(del_object)) {
  66                 ${return}VTABLE_$vt_method_name(interp, del_object$args);
  67                 $void_return
  68             }
  69         }
  70     }
  71     ${return}SUPER($superargs);
  72     $void_return
  73 EOC
  74         $self->add_method($new_default_method);
  75     }
  76     return 1;
  77 }
  78
  79 1;
  80
  81 # Local Variables:
  82 #   mode: cperl
  83 #   cperl-indent-level: 4
  84 #   fill-column: 100
  85 # End:
  86 # vim: expandtab shiftwidth=4: