cvsuser 04/11/10 15:18:37
Modified: lib/Parrot Pmc2c.pm
Log:
Create a line_directive method, and refactor all the existing #line code to
use it.
Revision Changes Path
1.52 +28 -42 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- Pmc2c.pm 10 Nov 2004 01:23:22 -0000 1.51
+++ Pmc2c.pm 10 Nov 2004 23:18:36 -0000 1.52
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Pmc2c.pm,v 1.51 2004/11/10 01:23:22 rubys Exp $
+# $Id: Pmc2c.pm,v 1.52 2004/11/10 23:18:36 nicholas Exp $
=head1 NAME
@@ -221,6 +221,20 @@
=over
+=item C<line_directive($self,$line,$file)>
+
+Generates the C pre processor string for a #line directive, or an empty
string
+if C<$self->{opt}{nolines}> is true.
+
+=cut
+
+sub line_directive {
+ my ($self, $line, $file) = @_;
+ return '' if $self->{opt}{nolines};
+ return qq{#line $line "$file"\n} if defined $file;
+ return qq{#line $line\n};
+}
+
=item C<get_vtable_section()>
Creates a hash of all the method names containing vtable section. Called
@@ -524,11 +538,7 @@
my $classname = $self->{class};
my $pmc = lc($classname) .'.pmc';
my $meth = $method->{meth};
- unless ($self->{opt}{nolines}) {
- $cout .= <<"EOC";
-#line $method->{line} "$pmc"
-EOC
- }
+ $cout .= $self->line_directive($method->{line}, $pmc);
my $body = $method->{body};
$body =~ s/^\t/ /mg;
$body =~ s/^[ ]{4}//mg;
@@ -1117,12 +1127,8 @@
my $body = "VTABLE_$meth(interpreter, PMC_pmc_val(pmc)$arg)";
my $ret = gen_ret($method, $body);
my $decl = $self->decl($self->{class}, $method, 0);
- my $l = "";
- unless ($self->{opt}{nolines}) {
- $l = <<"EOC";
-#line $line "ref.c"
-EOC
- }
+ # I think that these will be out by one - NWC
+ my $l = $self->line_directive($line, "ref.c");
return <<EOC;
$l
$decl {
@@ -1194,7 +1200,6 @@
my $body = "VTABLE_$meth(interpreter, PMC_pmc_val(pmc)$arg)";
my $ret = '';
my $decl = $self->decl($self->{class}, $method, 0);
- my $l = "";
my $ret_def = '';
my $func_ret = '(void) ';
if ($method->{type} ne 'void') {
@@ -1203,11 +1208,8 @@
$func_ret = $self->gen_ret($method->{type});
$ret = "return ret_val;";
}
- unless ($self->{opt}{nolines}) {
- $l = <<"EOC";
-#line $line "sharedref.c"
-EOC
- }
+ # I think that these will be out by one - NWC
+ my $l = $self->line_directive($line, "sharedref.c");
return <<EOC;
$l
$decl {
@@ -1268,12 +1270,8 @@
# This cheats, assuming that all return types can be cast from zero.
$ret = "return ($method->{type})0;";
}
- my $l = "";
- unless ($self->{opt}{nolines}) {
- $l = <<"EOC";
-#line $line "default.c"
-EOC
- }
+ # I think that these will be out by one - NWC
+ my $l = $self->line_directive($line, "default.c");
return <<EOC;
$l
${decl}\{
@@ -1325,13 +1323,9 @@
return $self->SUPER::body($self->{methods}[$n]);
}
my $decl = $self->decl($self->{class}, $method, 0);
- my $l = "";
my $ret = gen_ret($method);
- unless ($self->{opt}{nolines}) {
- $l = <<"EOC";
-#line $line "null.c"
-EOC
- }
+ # I think that these will be out by one - NWC
+ my $l = $self->line_directive($line, "null.c");
return <<EOC;
$l
${decl} {
@@ -1434,7 +1428,6 @@
$arg = ", ". join(' ', @args) if @args;
my $sig = $self->signature($parameters);
$sig = $self->trans($method->{type}) . $sig;
- my $l = "";
my $ret = '';
my $ret_def = '';
my $func_ret = '(void) ';
@@ -1451,11 +1444,8 @@
}
my $umeth = uc $meth;
my $delegate_meth = "PARROT_VTABLE_${umeth}_METHNAME";
- unless ($self->{opt}{nolines}) {
- $l = <<"EOC";
-#line $line "delegate.c"
-EOC
- }
+ # I think that these will be out by one - NWC
+ my $l = $self->line_directive($line, "delegate.c");
return <<EOC;
$l
${decl} {
@@ -1512,12 +1502,8 @@
my $body = "VTABLE_$meth(interpreter, attr$arg)";
my $ret = gen_ret($method, $body);
my $decl = $self->decl($self->{class}, $method, 0);
- my $l = "";
- unless ($self->{opt}{nolines}) {
- $l = <<"EOC";
-#line $line "ref.c"
-EOC
- }
+ # I think that these will be out by one - NWC
+ my $l = $self->line_directive($line, "ref.c");
return <<EOC;
$l
$decl {
