1# Copyright (C) 2004-2012, Parrot Foundation.
2
3package Parrot::Pmc2c::Pmc2cMain;
4
5use strict;
6use warnings;
7
8use File::Spec ();
9use Carp;
10use Storable;
11
12use Parrot::PMC ();
13use Parrot::Pmc2c::VTable ();
14use Parrot::Pmc2c::Dumper 'dump_pmc';
15use Parrot::Pmc2c::Library ();
16use Parrot::Pmc2c::UtilFunctions 'filename';
17use Parrot::Pmc2c::PMC::default ();
18use Parrot::Pmc2c::PMC::Null ();
19use Parrot::Pmc2c::PMC::Object ();
20use Parrot::Pmc2c::PMC::Proxy ();
21
22# put the options in a package var so it can be accessed from
23# Parrot::Pmc2c::Emitter.
24our $OPTIONS;
25
26# This is useful for debugging, but upgrades deprecation warnings to errors.
27#$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
28
29=head1 NAME
30
31Parrot::Pmc2c::Pmc2cMain - Functions called within F<tools/build/pmc2c.pl>
32
33=head1 SYNOPSIS
34
35    use Parrot::Pmc2c::Pmc2cMain;
36
37=head1 DESCRIPTION
38
39Parrot::Pmc2c::Pmc2cMain holds subroutines called within F<tools/build/pmc2c.pl>.
40
41=cut
42
43=head1 FUNCTIONS
44
45=head2 Publicly Available Methods
46
47=head3 C<new()>
48
49    $self = Parrot::Pmc2c::Pmc2cMain->new( {
50        include => \@include,
51        opt     => \%opt,
52        args    => \@args,
53    } );
54
55B<Purpose:>  Parrot::Pmc2c::Pmc2cMain constructor.
56
57B<Arguments:>  Reference to a hash holding 3 required keys:
58
59=over 4
60
61=item * C<include>
62
63Array reference.  Array passed holds list of paths in which various methods
64should try to locate files.
65
66=item * C<opt>
67
68Hash reference.  Holds results of processing of options to C<pmc2c.pl()>.
69
70=item * C<args>
71
72Array reference.  In most cases, the array passed will hold the elements of
73C<@ARGV> remaining after options processing.
74
75=back
76
77B<Return Values:>  Parrot::Pmc2c::Pmc2cMain object.  Will C<die> with error
78message if arguments are defective.
79
80B<Comment:>  Tested in:  F<t/tools/pmc2cutils/01-pmc2cutils.t>.
81
82=cut
83
84sub new {
85    my ( $class, $allargsref ) = @_;
86    die "Must pass a hash ref to Parrot::Pmc2c::Pmc2cMain::new"
87        unless ref($allargsref) eq q{HASH};
88    die "Must have key 'include' which is a reference to an array of directories"
89        unless ( defined $allargsref->{include} and ref( $allargsref->{include} ) eq q{ARRAY} );
90    die "Must have key 'opt' which is a reference to a hash of option values"
91        unless ( defined $allargsref->{opt} and ref( $allargsref->{opt} ) eq q{HASH} );
92    die "Must have key 'args' which is a reference to a list of the remaining arguments"
93        unless ( defined $allargsref->{args} and ref( $allargsref->{args} ) eq q{ARRAY} );
94
95    my $base = File::Spec->catdir($allargsref->{bin},'..','..');
96    unshift @{ $allargsref->{include} },
97      '.', $base, File::Spec->catdir($base,'src','pmc'), File::Spec->catdir($base,'src','dynpmc');
98
99    foreach my $opt ( qw(nolines) ) {
100        if ( !defined $allargsref->{opt}{$opt} ) {
101            $allargsref->{opt}{$opt} = 0;
102        }
103    }
104
105    $OPTIONS = $allargsref->{opt};
106
107    return bless( $allargsref, $class );
108}
109
110=head3 C<dump_vtable()>
111
112    $self->dump_vtable("$Bin/../../src/vtable.tbl");
113
114B<Purpose:>  Create a F<.dump> file for the default vtable (from which
115all PMCs inherit).
116
117B<Arguments:>  Scalar holding filename of vtable.
118
119B<Return Values:>  Scalar holding path to F<.dump> file.
120
121B<Comments:>  In earlier version of F<pmc2c.pl>, this subroutine returned
122C<undef> upon success.  This was changed to more Perl-ish C<1>.
123
124If the caller of this subroutine has C<chdir>-ed to a tempdir before this
125subroutine is called -- as ought to be the case during testing of build
126tools -- then F<vtable.dump> will be created within that tempdir.
127Otherwise, F<vtable.dump> is created in the caller's working directory.
128When the caller is F<make>, that directory is the top-level Parrot directory.
129
130Tested in:  F<t/tools/pmc2cutils/03-dump_vtable.t>.
131
132=cut
133
134sub dump_vtable {
135    my ( $self, $file ) = @_;
136    return Parrot::Pmc2c::VTable->new($file)->dump;
137}
138
139=head3 C<dump_pmc()>
140
141see C<lib/Parrot/Pmc2c/Dumper>.
142
143=head3 C<read_dump()>
144
145  $self->read_dump('filename');
146
147B<Purpose:>  A F<.dump> file is the result of a call to C<dump_pmc()> and
148consists of a binary dump of a hash reference, Storable-style.
149C<read_dump()> reads in the F<.dump> file, recreates the data structure and
150returns a new hash reference holding the data structure.
151
152B<Arguments:>  Scalar holding name of file whose structure is to be dumped.
153The method will only process F<foo.dump> files, but you can also pass
154C<'foo.c'> or C<'foo.pmc'> as the argument and it will analyze the
155corresponding F<foo.dump> file.
156
157B<Return Values:>  Reference to hash holding recreated data structure.
158
159B<Comments:>  If the appropriate F<.dump> file cannot be located, program
160will die with error message (see C<find_file()> above).
161Called internally by C<gen_c()>, C<gen_parent_list()>,
162C<dump_pmc()>.
163
164Tested in:  F<t/tools/pmc2cutils/04-dump_pmc.t>.
165
166=cut
167
168sub read_dump {
169    my ( $self, $filename ) = @_;
170    $filename = $self->find_file( filename( $filename, '.dump' ), 1 );
171
172    return unless -f $filename;
173    return Storable::retrieve($filename);
174}
175
176=head3 C<gen_c()>
177
178    $return_value = $self->gen_c();
179
180B<Purpose:>  Generate the C source code file for each of the files passed in,
181using the directories passed in to search for the PMC dump files.
182
183B<Arguments:>  None.
184
185B<Return Values:>  Returns C<1> upon success.
186
187B<Comments:>  Internally calls C<Parrot::Pmc2c::Library::new()> and
188C<write_all_files()>.  In earlier version of F<pmc2c.pl>, this
189subroutine returned C<undef> upon success.  This was changed to more
190Perl-ish C<1>.
191
192Tested in:  F<t/tools/pmc2cutils/05-gen_c.t>.
193
194=cut
195
196sub gen_c {
197    my $self        = shift;
198    my $vtable_dump = $self->read_dump("vtable.pmc");
199
200    foreach my $filename ( @{ $self->{args} } ) {
201        Parrot::Pmc2c::PMC->prep_for_emit( $self->read_dump($filename), $vtable_dump )->generate;
202    }
203    return 1;
204}
205
206sub gen_library {
207    my ( $self, $library_name ) = @_;
208    my $pmcs = [ map { $self->read_dump($_) } @{ $self->{args} } ];
209
210    Parrot::Pmc2c::Library->generate_library( $library_name, $pmcs );
211    return 1;
212}
213
214=head3 C<find_file()>
215
216    $path = $self->find_file($file, $die_unless_found_flag);
217
218B<Purpose:>  Return the full path to C<$file>.  (Search in the directories
219listed in the C<include> key in the hash passed by reference to the
220constructor).  Optionally, die with an error message if that file cannot
221be found.
222
223B<Arguments:>  Two arguments.  Required:  string holding name of the file
224sought.  Optional:  a flag variable which, if set to a true value, will cause
225program to die if file is not located.
226
227B<Return Values:>  Upon success, string holding a path.  Upon failure,
228C<undef> (unless C<$die_unless_found_flag> is set to a true value, in which
229case program C<die>s).
230
231B<Comments:>  Called inside C<read_dump()> and C<dump_pmc()>.
232
233Tested in:  F<t/tools/pmc2cutils/02-find_file.t>.
234
235=cut
236
237sub find_file {
238    my ( $self, $file, $die_unless_found ) = @_;
239
240    return $file if ( File::Spec->file_name_is_absolute($file) && -e $file );
241
242    my @includes = @{ $self->{include} };
243    foreach my $dir (@includes) {
244        my $path = File::Spec->catfile( $dir, $file );
245        return $path if -e $path;
246    }
247
248    if ($die_unless_found) {
249        my $includes_list = join q|', '| => @includes;
250        Carp::confess("cannot find file '$file' in path '$includes_list'");
251    }
252
253    return;
254}
255
256=head1 AUTHOR
257
258Leopold Toetsch wrote F<pmc2c.pl>.  It was cleaned up by Matt Diephouse.
259James E Keenan extracted the subroutines into F<lib/Parrot/Pmc2c/Pmc2cMain.pm>
260and wrote the accompanying test suite.
261
262=head1 SEE ALSO
263
264F<tools/build/pmc2c.pl>, Parrot::Pmc2c, Parrot::Pmc2c::Library.
265
266=cut
267
2681;
269
270# Local Variables:
271#   mode: cperl
272#   cperl-indent-level: 4
273#   fill-column: 100
274# End:
275# vim: expandtab shiftwidth=4:
276