This patch makes pmc2c.pl emit #line directives to .c files so the
debugger can trace the code back to the editable source. However, I
also have a larger patch that supersedes this one, but it changes
behavior. I just wanted to get this out first in case the later one is
deemed a bad idea.
The later patch implements "PMC inheritance": any unimplemented vtable
op in a .pmc file is inherited from its superclass. The global, and
default, superclass is default.pmc. You can inherit from an existing
PMC by saying "extends PerlArray" (for example) in the flags section
(the place where you'd put "noinit" right now.) pmc2c.pl scans all the
..pmc files on the path to the root to determine the most specific
implementation for each method.
I really just implemented this so that I could muck with the vtable
without modifying perlint.pmc, perlnum.pmc, etc. every time I made a
change, and the existing '= default' is insufficient for that. I also
think that default.pmc probably ought to have an implementation like
die("Unimplemented vtable method called.");
for almost everything.
If this sounds worthwhile, I'll clean up the code a bit and submit the
patch. In the meantime, here is the patch that just adds the #lines:
--- pmc2c.pl Wed Jan 2 13:27:47 2002
+++ pmc2c.pl.lineno Thu Dec 27 23:40:29 2001
@@ -9,14 +9,16 @@ use strict;
sub extract_balanced {
my $balance = 0;
+ my $lines = 0;
for(shift) {
- s/^\s+//;
+ s/^(\s+)//;
+ $lines += count_newlines($1);
/^\{/ or die "bad block open: ".substr($_,0,10),"..."; # }
while(/(\{)|(\})/g) {
if($1) {
$balance++;
} else { # $2
- --$balance or return (substr($_, 0, pos, ""), $_);
+ --$balance or return (substr($_, 0, pos, ""), $_, $lines);
}
}
die "Badly balanced" if $balance;
@@ -49,7 +51,7 @@ while (my $file = shift @ARGV) {
my $contents = join('', @contents);
close PMC;
- my $coutput = filter($contents); # run the filter
+ my $coutput = filter($contents, $file, $cfile); # run the filter
open (SOURCE, ">$cfile") || die "$0: Could not write file '$cfile'\n";
print SOURCE $coutput;
@@ -58,16 +60,26 @@ while (my $file = shift @ARGV) {
my %flags;
+sub count_newlines {
+ return scalar(() = $_[0] =~ /\n/g);
+}
+
sub filter {
- my $contents = shift;
+ my ($contents, $pmcfile, $cfile) = @_;
+ my $lineno = 1;
$contents =~ s/^([^{]*)pmclass ([\w]*)//s;
my ($pre, $classname) = ($1, $2);
+ $lineno += count_newlines($1);
- $flags{$1}++ while $contents =~ s/^\s*(\w+)//s;
+ while ($contents =~ s/^(\s*)(\w+)//s) {
+ $lineno += count_newlines($1);
+ $flags{$2}++;
+ }
- my ($classblock, $post) = extract_balanced($contents,);
- $classblock = substr($classblock, 2,-1); # trim out the { }
+ my ($classblock, $post, $lines) = extract_balanced($contents);
+ $lineno += $lines;
+ $classblock = substr($classblock, 1,-1); # trim out the { }
my $signature_re = qr{
^
@@ -89,25 +101,30 @@ sub filter {
my $OUT;
my %default;
- while ($classblock =~ s/$signature_re//) {
- my ($type, $methodname, $parameters) = ($1,$2,$3);
+ while ($classblock =~ s/($signature_re)//) {
+ $lineno += count_newlines($1);
+ my ($type, $methodname, $parameters) = ($2,$3,$4);
$parameters = ", $parameters" if $parameters =~ /\w/;
- if ($classblock =~ s/^\s*= default;?\s*//s) {
+ if ($classblock =~ s/^(\s*= default;?\s*)//s) {
+ $lineno += count_newlines($1);
$default{$methodname}++;
push @methods, $methodname;
next;
}
- my ($methodblock, $rema) = extract_balanced($classblock);
+ my ($methodblock, $rema, $lines) = extract_balanced($classblock);
+ $lineno += $lines;
$methodblock =~ s/SELF/pmc/g;
$methodblock =~ s/INTERP/interpreter/g;
$OUT .= "$type Parrot_" . $classname. "_" . "$methodname (struct Parrot_Interp
*interpreter, PMC* pmc$parameters)";
+ $OUT .= "\n#line $lineno \"$pmcfile\"\n ";
$OUT .= $methodblock;
$OUT .= "\n\n";
+ $lineno += count_newlines($methodblock);
$classblock = $rema;
push @methods, $methodname;
};
@@ -123,13 +140,17 @@ sub filter {
}
$OUT = <<EOC . $OUT;
+ /* Do not edit - automatically generated from '$pmcfile' by $0 */
$pre
static STRING* whoami;
EOC
+my $initline = 1+count_newlines($OUT)+1;
+
$OUT .= <<EOC unless exists $flags{noinit};
+#line $initline "$cfile"
void $initname (void) {
