On Wed, 2008-05-14 at 11:03 -0700, Geoffrey Broadwell wrote:
> On Wed, 2008-05-14 at 10:40 -0700, Will Coleda via RT wrote:
> > Excellent. I was about to ask if we could have someone windows test to
> > make sure this works for them...
The previous version of the patch didn't work on Windows, because pipe
open doesn't work there, grrr. Please try the attached version of the
patch.
-'f
=== CREDITS
==================================================================
--- CREDITS (revision 5180)
+++ CREDITS (local)
@@ -257,7 +257,8 @@
N: Geoff Broadwell
D: OpenGL binding
-D: examples fixes
+D: Disassembly/source weaver
+D: Miscellaneous fixes
N: Gerard Goossen
D: Documentation patch for Parrot_PMC_get_pointer_intkey()
=== MANIFEST
==================================================================
--- MANIFEST (revision 5180)
+++ MANIFEST (local)
@@ -3710,6 +3710,7 @@
tools/docs/write_docs.pl [devel]
tools/install/smoke.pl []
tools/util/crow.pir []
+tools/util/dump_pbc.pl []
tools/util/gen_release_info.pl []
tools/util/ncidef2pasm.pl []
tools/util/perltidy.conf []
=== config/gen/makefiles/root.in
==================================================================
--- config/gen/makefiles/root.in (revision 5180)
+++ config/gen/makefiles/root.in (local)
@@ -585,6 +585,7 @@
dynoplibs \
compilers \
$(PBC_TO_EXE) \
+ $(DIS) \
$(PBCMERGE)
$(GEN_LIBRARY) : $(PARROT)
=== tools/util/dump_pbc.pl
==================================================================
--- tools/util/dump_pbc.pl (revision 5180)
+++ tools/util/dump_pbc.pl (local)
@@ -0,0 +1,122 @@
+#! perl
+
+# Copyright (C) 2008, The Perl Foundation.
+# $Id: $
+
+=head1 NAME
+
+tools/util/dump_pbc.pl - Weave together PBC disassembly with PIR source
+
+=head1 SYNOPSIS
+
+ perl tools/util/dump_pbc.pl foo.pbc
+
+=head1 DESCRIPTION
+
+dump_pbc.pl uses Parrot's F<disassemble> program to disassemble the opcodes
+in a PBC (Parrot ByteCode) file, then weaves the disassembly together with
+the original PIR source file(s). This makes it easier to see how the PIR
+syntactic sugar is desugared into raw Parrot opcodes.
+
+=head1 BUGS
+
+This program has only been tested for a few simple cases. Also, the name
+might suggest a different use than its actual purpose.
+
+While it is not a bug in F<dump_pbc.pl> per se, there is a line numbering
+bug for some PBC opcode sequences that will result in the disassembled
+opcodes appearing just before the source lines they represent, rather
+than just after. There does not appear to be consensus yet about where
+this bug actually resides.
+
+=cut
+
+use strict;
+use warnings;
+use Cwd;
+use FindBin;
+
+my ($PARROT_ROOT, $RUNTIME_DIR);
+BEGIN {
+ $PARROT_ROOT = Cwd::abs_path("$FindBin::Bin/../..");
+ $RUNTIME_DIR = "$PARROT_ROOT/runtime/parrot";
+}
+
+use lib "$PARROT_ROOT/lib";
+use Parrot::Config '%PConfig';
+
+my $DISASSEMBLER = "$PConfig{build_dir}$PConfig{slash}disassemble$PConfig{exe}";
+
+go(@ARGV);
+
+sub go {
+ my $pbc = shift;
+
+ # The following mess brought to you by Win32, where pipe open doesn't work,
+ # and thus its greater security and cleaner error handling are unavailable.
+
+ -f $pbc && -r _
+ or die "PBC file '$pbc' does not exist or is not readable.\n";
+
+ -f $DISASSEMBLER && -x _
+ or die "Can't find disassembler '$DISASSEMBLER';"
+ . "did you remember to make parrot first?\n";
+
+ my @dis = `$DISASSEMBLER $pbc`;
+ die "No disassembly; errors: $?, $!" unless @dis;
+
+ my $cur_file = '';
+ my $cur_line = -1;
+ my %cache;
+
+ foreach (@dis) {
+ if (/^Current Source Filename (.*)/) {
+ if ($cur_file ne $1) {
+ $cur_file = $1;
+ $cache{$cur_file} ||= slurp_file($cur_file);
+ $cur_line = -1;
+
+ print "\n#### $cur_file\n";
+ }
+ }
+ elsif (my ($info, $seq, $pc, $line, $code) = /^((\d+)-(\d+) (\d+): )(.*)/) {
+ my $int_line = int $line;
+ my $len_line = length $line;
+ if ($cur_line != $int_line) {
+ $cur_line = 0 if $cur_line == -1;
+ print "\n";
+ foreach my $i ($cur_line + 1 .. $int_line) {
+ my $source_code = $cache{$cur_file}[$i-1];
+ # next unless $source_code =~ /\S/;
+ printf "# %*d: %s", $len_line, $i, $source_code;
+ print "\n" if $source_code =~ /^\.end/;
+ }
+ $cur_line = $int_line;
+ }
+
+ print ' ' x ($len_line + 4), "$code\n";
+ }
+ }
+}
+
+sub slurp_file {
+ my $file = shift;
+ my $source;
+
+ open $source, '<', $file
+ or open $source, '<', "$PARROT_ROOT/$file"
+ or open $source, '<', "$RUNTIME_DIR/$file"
+ or die "Could not open source file '$file': $!";
+
+ my @lines = <$source>;
+
+ return [EMAIL PROTECTED];
+}
+
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Property changes on: tools/util/dump_pbc.pl
___________________________________________________________________
Name: svn:executable
+*
