1# Copyright (C) 2004-2008, Parrot Foundation. 2package Parrot::Pmc2c::VTable; 3use strict; 4use warnings; 5 6use Storable (); 7use Parrot::Vtable (); 8use Parrot::Pmc2c::Method (); 9use File::Spec (); 10use File::Basename; 11use Cwd qw(cwd); 12 13sub new { 14 my ( $class, $filename ) = @_; 15 my $self = {}; 16 bless $self, $class; 17 $self->build($filename) if $filename; 18 return $self; 19} 20 21sub build { 22 my ( $self, $filename ) = @_; 23 my $vtable_table = Parrot::Vtable::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 attrs => $entry->[5], 37 type => Parrot::Pmc2c::Method::VTABLE_ENTRY, 38 } 39 ); 40 push @method_names, $entry->[1]; 41 } 42 43 $self->filename($filename); 44 $self->{'has_method'} = \%method_lookup; 45 $self->{'methods'} = \@methods; 46 $self->{'names'} = \@method_names; 47 48 return; 49} 50 51sub dump { 52 my ($self) = @_; 53 54 my $dump_filename = 55 File::Spec->catfile( cwd(), 56 basename( Parrot::Pmc2c::UtilFunctions::filename( $self->filename, '.dump' ) ) 57 ); 58 Storable::nstore( $self, $dump_filename ); 59 return $dump_filename; 60} 61 62sub has_method { 63 my ( $self, $methodname ) = @_; 64 return $self->{'has_method'}->{$methodname}; 65} 66 67sub get_method { 68 my ( $self, $methodname ) = @_; 69 my $method_index = $self->has_method($methodname); 70 return unless defined $method_index; 71 return $self->{methods}->[$method_index]; 72} 73 74sub names { 75 my ( $self, $value ) = @_; 76 $self->{names} = $value if $value; 77 return $self->{names}; 78} 79 80sub methods { 81 my ( $self, $value ) = @_; 82 $self->{methods} = $value if $value; 83 return $self->{methods}; 84} 85 86sub filename { 87 my ( $self, $value ) = @_; 88 $self->{filename} = $value if $value; 89 return $self->{filename}; 90} 91 92sub attrs { 93 my ( $self, $vt_meth ) = @_; 94 return $self->get_method($vt_meth)->attrs; 95} 96 971; 98 99# Local Variables: 100# mode: cperl 101# cperl-indent-level: 4 102# fill-column: 100 103# End: 104# vim: expandtab shiftwidth=4: 105