lib/Parrot/Pmc2c/VTable.pm

   1 # Copyright (C) 2004-2008, Parrot Foundation.
   2 # $Id$
   3 package Parrot::Pmc2c::VTable;
   4 use strict;
   5 use warnings;
   6
   7 use Storable ();
   8 use Parrot::Vtable;
   9 use Parrot::Pmc2c::Method ();
  10 use File::Basename;
  11 use Cwd qw(cwd);
  12
  13 sub new {
  14     my ( $class, $filename ) = @_;
  15     my $self = {};
  16     bless $self, $class;
  17     $self->build($filename) if $filename;
  18     return $self;
  19 }
  20
  21 sub build {
  22     my ( $self, $filename ) = @_;
  23     my $vtable_table = parse_vtable($filename);
  24
  25     my ( %method_lookup, @methods, @method_names );
  26
  27     foreach my $entry (@$vtable_table) {
  28         $method_lookup{ $entry->[1] } = scalar @methods;
  29         push @methods,
  30             Parrot::Pmc2c::Method->new(
  31             {
  32                 return_type => $entry->[0],
  33                 name        => $entry->[1],
  34                 parameters  => $entry->[2],
  35                 section     => $entry->[3],
  36                 mmd_name    => $entry->[4] eq -1 ? "" : $entry->[4],
  37                 right       => right_type( $entry->[4] ),
  38                 mmd_prefix  => prefix( $entry->[4] ),
  39                 attrs       => $entry->[5],
  40                 type        => Parrot::Pmc2c::Method::VTABLE_ENTRY,
  41             }
  42             );
  43         push @method_names, $entry->[1];
  44     }
  45
  46     $self->filename($filename);
  47     $self->{'has_method'} = \%method_lookup;
  48     $self->{'methods'}    = \@methods;
  49     $self->{'names'}      = \@method_names;
  50
  51     return;
  52 }
  53
  54 sub right_type {
  55     my ($mmd_name) = @_;
  56     return '' if $mmd_name eq -1;
  57     return 'enum_type_INTVAL'   if ( $mmd_name =~ s/_INT$// );
  58     return 'enum_type_FLOATVAL' if ( $mmd_name =~ s/_FLOAT$// );
  59     return 'enum_type_STRING'   if ( $mmd_name =~ s/_STR$// );
  60     return 'enum_type_PMC';
  61 }
  62
  63 sub prefix {
  64     my ($mmd_name) = @_;
  65     return '' if $mmd_name eq -1;
  66     $mmd_name =~ s/_INT$//;
  67     $mmd_name =~ s/_FLOAT$//;
  68     $mmd_name =~ s/_STR$//;
  69     return $mmd_name;
  70 }
  71
  72 sub dump {
  73     my ($self) = @_;
  74
  75     my $dump_filename =
  76           cwd() . q{/}
  77         . basename( Parrot::Pmc2c::UtilFunctions::filename( $self->filename, '.dump' ) );
  78     Storable::store( $self, $dump_filename );
  79     return $dump_filename;
  80 }
  81
  82 sub has_method {
  83     my ( $self, $methodname ) = @_;
  84     return $self->{'has_method'}->{$methodname};
  85 }
  86
  87 sub is_mmd {
  88     my ( $self, $methodname ) = @_;
  89     my $method = $self->get_method($methodname);
  90     return ( defined $method and $method->is_mmd );
  91 }
  92
  93 sub get_method {
  94     my ( $self, $methodname ) = @_;
  95     my $method_index = $self->has_method($methodname);
  96     return unless defined $method_index;
  97     return $self->{methods}->[$method_index];
  98 }
  99
 100 sub names {
 101     my ( $self, $value ) = @_;
 102     $self->{names} = $value if $value;
 103     return $self->{names};
 104 }
 105
 106 sub methods {
 107     my ( $self, $value ) = @_;
 108     $self->{methods} = $value if $value;
 109     return $self->{methods};
 110 }
 111
 112 sub filename {
 113     my ( $self, $value ) = @_;
 114     $self->{filename} = $value if $value;
 115     return $self->{filename};
 116 }
 117
 118 sub attrs {
 119     my ( $self, $vt_meth ) = @_;
 120     return $self->get_method($vt_meth)->attrs;
 121 }
 122
 123 1;
 124
 125 # Local Variables:
 126 #   mode: cperl
 127 #   cperl-indent-level: 4
 128 #   fill-column: 100
 129 # End:
 130 # vim: expandtab shiftwidth=4: