1 # Copyright (C) 2004-2007, The Perl Foundation.
7 Parrot::Pmc2c - PMC to C Code Generation
15 C<Parrot::Pmc2c> is used by F<tools/build/pmc2c.pl> to generate C code from PMC files.
23 package Parrot
::Pmc2c
::Method
;
26 use Parrot
::Pmc2c
::Emitter
;
27 use Parrot
::Pmc2c
::UtilFunctions
28 qw( gen_ret dont_edit count_newlines dynext_load_code c_code_coda );
29 use Parrot
::Pmc2c
::PCCMETHOD
;
31 =item C<generate_body($pmc)>
33 Generate and emit the C code for the method body.
38 my ( $self, $pmc ) = @_;
39 my $emit = sub { $pmc->{emitter
}->emit(@_) };
41 Parrot
::Pmc2c
::PCCMETHOD
::rewrite_pccinvoke
( $self, $pmc );
43 my $body = $self->body;
45 if ( $self->is_vtable ) {
46 $self->rewrite_vtable_method($pmc);
49 $self->rewrite_nci_method($pmc);
52 $emit->( ( $pmc->is_dynamic ?
'PARROT_DYNEXT_EXPORT ' : 'PARROT_API ') . $self->decl( $pmc, 'CFILE' ) );
58 for my $mmd ( @
{ $self->mmds } ) {
59 $mmd->generate_body($pmc);
66 sub generate_headers
{
67 my ( $self, $pmc ) = @_;
70 $hout .= $self->decl( $pmc, 'HEADER' );
73 for my $mmd ( @
{ $self->mmds } ) {
74 $hout .= $mmd->decl( $pmc, 'HEADER' );
81 =item C<decl($classname, $method, $for_header)>
83 Returns the C code for the PMC method declaration. C<$for_header>
84 indicates whether the code is for a header or implementation file.
89 my ( $self, $pmc, $for_header ) = @_;
91 my $pmcname = $pmc->name;
92 my $ret = $self->return_type;
93 my $meth = $self->name;
94 my $args = $self->parameters;
95 my $ro = $pmc->flag('is_ro') ?
'' : '';
96 my $decs = $self->decorators;
98 # convert 'type*' to 'type *' per PDD07
99 $ret =~ s/^(.*)\s*(\*)$/$1 $2/;
101 # convert args to PDD07
102 $args = ", $args" if $args =~ /\S/;
103 $args =~ s/(\w+)\s*(\*)\s*/$1 $2/g;
105 my ( $decorators, $export, $extern, $newl, $semi, $interp, $pmcvar );
106 $decorators = join($/, @
$decs, '');
107 if ( $for_header eq 'HEADER' ) {
108 $export = $pmc->is_dynamic ?
'PARROT_DYNEXT_EXPORT ' : 'PARROT_API ';
112 $interp = $pmcvar = "";
124 $decorators$export$extern$ret${newl}Parrot_${pmcname}${ro}_$meth(PARROT_INTERP, PMC *$pmcvar$args)$semi
128 =item C<proto($type,$parameters)>
130 Determines the prototype (argument signature) for a method body
131 (see F<src/call_list>).
163 #"BIGNUM*" => "???" # RT#43731
164 #"BIGNUM *"=> "???" # RT#43731
168 my ( $type, $parameters ) = @_;
170 # reduce to a comma separated set of types
171 $parameters =~ s/\w+(,|$)/,/g;
172 $parameters =~ s/ //g;
174 # type method(interp, self, parameters...)
175 my $ret = $calltype{ $type or "void" };
176 $ret .= "JO" . join( '', map { $calltype{$_} or "?" } split( /,/, $parameters ) );
179 # scan src/call_list.txt if the generated signature is available
181 # RT#43735 report errors for "?"
187 =item C<rewrite_nci_method($self, $pmc )>
189 Rewrites the method body performing the various macro substitutions for
190 nci method bodies (see F<tools/build/pmc2c.pl>).
194 sub rewrite_nci_method
{
195 my ( $self, $pmc ) = @_;
196 my $pmcname = $pmc->name;
197 my $body = $self->body;
199 # Rewrite SELF.other_method(args...)
202 \bSELF
\b # Macro: SELF
203 \
.(\w
+) # other_method
204 \
(\s
*(.*?
)\
) # capture argument list
206 sub { "pmc->real_self->vtable->$1(" . full_arguments
( $2, 'pmc->real_self' ) . ')' }
209 # Rewrite SELF.other_method(args...)
212 \bSELF
\b # Macro: SELF
213 \
.(\w
+) # other_method
214 \
(\s
*(.*?
)\
) # capture argument list
216 sub { "pmc->vtable->$1(" . full_arguments
($2) . ')' }
219 # Rewrite STATICSELF.other_method(args...)
222 \bSTATICSELF
\b # Macro STATICSELF
223 \
.(\w
+) # other_method
224 \
(\s
*(.*?
)\
) # capture argument list
228 . ( $pmc->is_vtable_method($1) ?
"" : "_nci" ) . "_$1("
229 . full_arguments
($2) . ")";
233 # Rewrite SELF -> pmc, INTERP -> interp
234 $body->subst( qr{\bSELF\b}, sub { 'pmc' } );
235 $body->subst( qr{\bINTERP\b}, sub { 'interp' } );
237 # Rewrite GET_ATTR, SET_ATTR with typename
238 $body->subst( qr{\bGET_ATTR}, sub { 'GETATTR_' . $pmcname } );
239 $body->subst( qr{\bSET_ATTR}, sub { 'SETATTR_' . $pmcname } );
242 =item C<rewrite_vtable_method($self, $pmc, $super, $super_table)>
244 Rewrites the method body performing the various macro substitutions for
245 vtable method bodies (see F<tools/build/pmc2c.pl>).
249 sub rewrite_vtable_method
{
250 my ( $self, $pmc ) = @_;
251 my $name = $self->name;
252 my $pmcname = $pmc->name;
253 my $super = $pmc->{super
}{$name};
254 my $super_table = $pmc->{super
};
255 my $body = $self->body;
258 # Rewrite method body
259 # Some MMD variants don't have a super mapping.
261 my $supertype = "enum_class_$super";
262 die "$pmcname defines unknown vtable method '$name'\n" unless defined $super_table->{$name};
263 my $supermethod = "Parrot_" . $super_table->{$name} . "_$name";
265 # Rewrite DYNSUPER(args)
268 \bDYNSUPER
\b # Macro: DYNSUPER
269 \
(\s
*(.*?
)\
) # capture argument list
271 sub { "interp->vtables[$supertype].$name(" . full_arguments
($1) . ')' }
274 # Rewrite OtherClass.SUPER(args...)
277 (\w
+) # capture OtherClass
278 \
.SUPER
\b # Macro: SUPER
279 \
(\s
*(.*?
)\
) # capture argument list
281 sub { "Parrot_${1}_$name(" . full_arguments
($2) . ')' }
284 # Rewrite SUPER(args...)
287 \bSUPER
\b # Macro: SUPER
288 \
(\s
*(.*?
)\
) # capture argument list
290 sub { "$supermethod(" . full_arguments
($1) . ')' }
294 # Rewrite SELF.other_method(args...)
297 \bSELF
\b # Macro: SELF
298 \
.(\w
+) # other_method
299 \
(\s
*(.*?
)\
) # capture argument list
301 sub { "pmc->vtable->$1(" . full_arguments
($2) . ')' }
304 # Rewrite SELF(args...). See comments above.
307 \bSELF
\b # Macro: SELF
308 \
(\s
*(.*?
)\
) # capture argument list
310 sub { "pmc->vtable->$name(" . full_arguments
($1) . ')' }
313 # Rewrite OtherClass.SELF.other_method(args...)
317 \
.\bSELF
\b # Macro SELF
318 \
.(\w
+) # other_method
319 \
(\s
*(.*?
)\
) # capture argument list
323 . ( $pmc->is_vtable_method($2) ?
"" : "_nci" ) . "_$2("
324 . full_arguments
($3) . ')';
328 # Rewrite OtherClass.STATICSELF.other_method(args...)
332 \
.\bSTATICSELF
\b # Macro STATICSELF
333 \
.(\w
+) # other_method
334 \
(\s
*(.*?
)\
) # capture argument list
338 . ( $pmc->is_vtable_method($2) ?
"" : "_nci" ) . "_$2("
339 . full_arguments
($3) . ')';
343 # Rewrite OtherClass.object.other_method(args...)
347 \
.\b(\w
+)\b # any object
348 \
.(\w
+) # other_method
349 \
(\s
*(.*?
)\
) # capture argument list
353 . ( $pmc->is_vtable_method($3) ?
"" : "_nci" ) . "_$3("
354 . full_arguments
( $4, $2 ) . ')';
358 # Rewrite SELF.other_method(args...)
361 \bSELF
\b # Macro SELF
362 \
.(\w
+) # other_method
363 \
(\s
*(.*?
)\
) # capture argument list
367 . ( $pmc->is_vtable_method($1) ?
"" : "_nci" ) . "_$1("
368 . full_arguments
($2) . ")";
372 # Rewrite STATICSELF.other_method(args...)
375 \bSTATICSELF
\b # Macro STATICSELF
376 \
.(\w
+) # other_method
377 \
(\s
*(.*?
)\
) # capture argument list
381 . ( $pmc->is_vtable_method($1) ?
"" : "_nci" ) . "_$1("
382 . full_arguments
($2) . ")";
386 # Rewrite SELF -> pmc, INTERP -> interp
387 $body->subst( qr{\bSELF\b}, sub { 'pmc' } );
388 $body->subst( qr{\bINTERP\b}, sub { 'interp' } );
390 # Rewrite GET_ATTR, SET_ATTR with typename
391 $body->subst( qr{\bGET_ATTR}, sub { 'GETATTR_' . $pmcname } );
392 $body->subst( qr{\bSET_ATTR}, sub { 'SETATTR_' . $pmcname } );
394 # now use macros for all rewritten stuff
395 $body->subst( qr{\b(?:\w+)->vtable->(\w+)\(}, sub { "VTABLE_$1(" } );
400 =item C<full_arguments($args)>
402 Prepends C<INTERP, SELF> to C<$args>.
408 my $obj = shift || 'SELF';
410 return "INTERP, $obj, $args" if ( $args =~ m/\S/ );
411 return "INTERP, $obj";
414 sub full_method_name
{
415 my ( $self, $parent_name ) = @_;
416 return "Parrot_${parent_name}_" . $self->name;
423 # cperl-indent-level: 4
426 # vim: expandtab shiftwidth=4: