1# Copyright (C) 2004-2012, Parrot Foundation.
2
3=head1 NAME
4
5Parrot::Pmc2c::Library - PMC to C Code Generation
6
7=head1 SYNOPSIS
8
9    use Parrot::Pmc2c::Library;
10
11=head1 DESCRIPTION
12
13Parrot::Pmc2c::Library is a wrapper around a collection of PMCs linked in the
14same dynamic library.
15
16=head2 Instance Methods
17
18=over 4
19
20=cut
21
22package Parrot::Pmc2c::Library;
23
24use strict;
25use warnings;
26use File::Basename qw(basename);
27use Parrot::Pmc2c::PMC ();
28use Parrot::Pmc2c::UtilFunctions qw(dont_edit dynext_load_code c_code_coda spew);
29
30=item C<generate_library($library_name, $pmcs)>
31
32    Parrot::Pmc2c::Library->generate_library( $library_name, $pmcs );
33
34=cut
35
36sub generate_library {
37    my ( $class, $library_name, $pmcs ) = @_;
38
39    spew( $library_name . '.c', gen_c( $library_name, $pmcs ) );
40    spew( $library_name . '.h', gen_h( $library_name, $pmcs ) );
41}
42
43=item C<gen_h($library_name, $pmcs)>
44
45Writes the header file for the library.
46
47=cut
48
49sub gen_h {
50    my ($library_name, $pmcs) = @_;
51    my $basename = basename($library_name);
52    my $lc_libname = lc $basename;
53    my $guardname = uc( join( '_', 'PARROT_LIB', $lc_libname, 'H_GUARD' ) );
54    my %pmcs = ( map { $_->{name} => $_ } @{$pmcs} );
55
56    my $hout = dont_edit('various files');
57    $hout .= <<"EOH";
58#ifndef $guardname
59#define $guardname
60
61EOH
62
63    foreach my $name ( keys %pmcs ) {
64        my $lcname = lc $name;
65        $hout .= <<"EOH";
66#include "pmc_$lcname.h"
67EOH
68    }
69    $hout .= <<"EOH";
70
71PARROT_DYNEXT_EXPORT Parrot_PMC Parrot_lib_${lc_libname}_load(PARROT_INTERP);
72
73#endif /* $guardname */
74EOH
75    $hout .= c_code_coda;
76
77    return $hout;
78}
79
80=item C<gen_c($library_name, $pmcs)>
81
82Writes the C file for the library.
83
84=cut
85
86sub gen_c {
87    my ( $library_name, $pmcs ) = @_;
88    my $basename = basename($library_name);
89    my $lc_libname = lc $basename;
90    my %classes = ( map { $_->{name} => $_ } @{$pmcs} );
91
92    my $cout = dont_edit('various files');
93    $cout .= <<"EOC";
94#define PARROT_IN_EXTENSION
95#define CONST_STRING(i, s)     Parrot_str_new_constant(i, s)
96#define CONST_STRING_GEN(i, s) Parrot_str_new_constant(i, s)
97#include "parrot/parrot.h"
98#include "parrot/extend.h"
99#include "parrot/dynext.h"
100
101#include "$basename.h"
102
103/*
104 * This load function will be called to do global (once) setup
105 * whatever is needed to get this extension running.
106 */
107
108PARROT_DYNEXT_EXPORT Parrot_PMC Parrot_lib_${lc_libname}_load(PARROT_INTERP)
109{
110    Parrot_PMC    pmc;
111
112    /* create a library PMC */
113    pmc = Parrot_pmc_new(interp, enum_class_ParrotLibrary);
114
115    /* for all PMCs we want to register: */
116EOC
117    for my $class (sort keys %classes) {
118        my $lc_class = lc $class;
119        $cout .= "    Parrot_lib_${lc_class}_load(interp);\n";
120    }
121    $cout .= <<"EOC";
122    return pmc;
123}
124
125EOC
126    $cout .= c_code_coda;
127
128    return $cout;
129}
130
131=back
132
133=head1 SEE ALSO
134
135=over 4
136
137=item F<tools/build/pmc2c.pl>
138
139=back
140
141=cut
142
1431;
144
145# Local Variables:
146#   mode: cperl
147#   cperl-indent-level: 4
148#   fill-column: 100
149# End:
150# vim: expandtab shiftwidth=4:
151