File Coverage

File:config/gen/core_pmcs.pm
Coverage:97.0%

linestmtbrancondsubcode
1# Copyright (C) 2001-2009, Parrot Foundation.
2
3 - 11
=head1 NAME

config/gen/core_pmcs.pm - Core PMC List

=head1 DESCRIPTION

Generates the core PMC list F<include/parrot/core_pmcs.h>.

=cut
12
13package gen::core_pmcs;
14
15
2
2
2
2
use strict;
16
2
2
2
2
use warnings;
17
18
19
2
2
2
2
use base qw(Parrot::Configure::Step);
20
21
2
2
2
2
use Parrot::Configure::Utils ':gen';
22
23sub _init {
24
2
2
    my $self = shift;
25
2
    my %data;
26
2
    $data{description} = q{Generate core pmc list};
27
2
    $data{result} = q{};
28
2
    return \%data;
29}
30
31sub runstep {
32
1
1
    my ( $self, $conf ) = @_;
33
34
1
    $self->generate_h($conf);
35
1
    $self->generate_c($conf);
36
1
    $self->generate_pm($conf);
37
38
1
    return 1;
39}
40
41sub generate_h {
42
1
1
    my ( $self, $conf ) = @_;
43
44
1
    my $file = 'include/parrot/core_pmcs.h';
45
1
    $conf->append_configure_log($file);
46
1
    open( my $OUT, '>', "$file.tmp" );
47
48
1
1
    print {$OUT} <<'END_H';
49/*
50 * DO NOT EDIT THIS FILE
51 *
52 * Automatically generated by config/gen/core_pmcs.pm
53 */
54
55#ifndef PARROT_CORE_PMCS_H_GUARD
56#define PARROT_CORE_PMCS_H_GUARD
57
58/* &gen_from_enum(pmctypes.pasm) subst(s/enum_class_(\w+)/$1/e) */
59enum {
60END_H
61
62
1
    my @pmcs = split( qr/ /, $conf->data->get('pmc_names') );
63
1
    my $i = 0;
64
1
    foreach (@pmcs) {
65
94
94
        print {$OUT} " enum_class_$_,\t/* $i */\n";
66
94
        $i++;
67    }
68
1
1
    print {$OUT} <<'END_H';
69    enum_class_core_max
70};
71
72/* &end_gen */
73
74#endif /* PARROT_CORE_PMCS_H_GUARD */
75END_H
76
1
1
    print {$OUT} coda();
77
78
1
50
    close $OUT or die "Can't close file: $!";
79
80
1
    move_if_diff( "$file.tmp", $file );
81
82
1
    return;
83}
84
85sub generate_c {
86
1
1
    my ( $self, $conf ) = @_;
87
88
1
    my $file = "src/core_pmcs.c";
89
1
    my @pmcs = split( qr/ /, $conf->data->get('pmc_names') );
90
91
1
    $conf->append_configure_log($file);
92
1
    open( my $OUT, '>', "$file.tmp" );
93
94
1
1
    print {$OUT} <<'END_C';
95/*
96 * DO NOT EDIT THIS FILE
97 *
98 * Automatically generated by config/gen/core_pmcs.pm
99 */
100
101/* HEADERIZER HFILE: none */
102/* HEADERIZER STOP */
103
104#include "parrot/parrot.h"
105#include "parrot/global_setup.h"
106
107
108END_C
109
110
1
94
    print {$OUT} "extern void Parrot_${_}_class_init(PARROT_INTERP, int, int);\n" foreach (@pmcs);
111
112
1
1
    print {$OUT} <<'END_C';
113
114void Parrot_gbl_initialize_core_pmcs(PARROT_INTERP, int pass)
115{
116    /* first the PMC with the highest enum
117     * this reduces MMD table resize action */
118END_C
119
120
1
    print {$OUT} " Parrot_${_}_class_init(interp, enum_class_${_}, pass);\n"
121
1
        foreach ( @pmcs[ -1 .. -1 ] );
122
93
    print {$OUT} " Parrot_${_}_class_init(interp, enum_class_${_}, pass);\n"
123
1
        foreach ( @pmcs[ 0 .. $#pmcs - 1 ] );
124
1
1
    print {$OUT} <<'END_C';
125}
126
127static void register_pmc(PARROT_INTERP, ARGIN(PMC *registry), int pmc_id)
128{
129    STRING * const key = interp->vtables[pmc_id]->whoami;
130    VTABLE_set_integer_keyed_str(interp, registry, key, pmc_id);
131}
132
133void
134Parrot_gbl_register_core_pmcs(PARROT_INTERP, ARGIN(PMC *registry))
135{
136END_C
137
138
1
94
    print {$OUT} " register_pmc(interp, registry, enum_class_$_);\n" foreach (@pmcs);
139
1
1
    print {$OUT} <<'END_C';
140}
141
142END_C
143
1
1
    print {$OUT} coda();
144
145
1
50
    close $OUT or die "Can't close file: $!";
146
147
1
    move_if_diff( "$file.tmp", $file );
148
149
1
    return;
150}
151
152sub generate_pm {
153
1
1
    my ( $self, $conf ) = @_;
154
155
1
    my $file = "lib/Parrot/PMC.pm";
156
1
    my @pmcs = split( qr/ /, $conf->data->get('pmc_names') );
157
158
1
    $conf->append_configure_log($file);
159
1
    open( my $OUT, '>', "$file.tmp" );
160
161
1
    print $OUT <<'END_PM';
162# DO NOT EDIT THIS FILE
163#
164# Automatically generated by config/gen/core_pmcs.pm
165
166package Parrot::PMC;
167
168use strict;
169use warnings;
170
171use vars qw(@ISA %pmc_types @EXPORT_OK);
172
173@ISA = qw( Exporter );
174@EXPORT_OK = qw( %pmc_types);
175
176%pmc_types = (
177END_PM
178
179
1
    for my $num ( 0 .. $#pmcs ) {
180
94
        my $id = $num + 1;
181
94
94
        print {$OUT} "\t$pmcs[$num] => $id,\n";
182    }
183
184
1
1
    print {$OUT} <<'END_PM';
185);
186
1871;
188END_PM
189
190
1
50
    close $OUT or die "Can't close file: $!";
191
192
1
    move_if_diff( "$file.tmp", $file );
193
194
1
    return;
195}
196
197sub coda {
198
2
2
    my $v = 'vim';
199
200    # Translate it in code so vim doesn't think this file itself is readonly
201
2
    return <<"HERE"
202/*
203 * Local variables:
204 * c-file-style: "parrot"
205 * End:
206 * ${v}: readonly expandtab shiftwidth=4:
207 */
208HERE
209}
210
2111;
212
213# Local Variables:
214# mode: cperl
215# cperl-indent-level: 4
216# fill-column: 100
217# End:
218# vim: expandtab shiftwidth=4: