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