[gs-commits] ghostpdl branch, master, updated. jbig2dec-0.14-1781-g5eaccd8
[email protected] (Robin Watts) Thu, 31 Oct 2019 14:37:15 +0000 (UTC)
| Newsgroups | gmane.comp.printing.ghostscript.cvs |
|---|---|
| Message-ID | <[email protected]> |
The ghostpdl branch, master has been updated
via 5eaccd845c9957dff754ebfdde417fe5d82e5e82 (commit)
from 0d998f17c495a12b04904113ff676c7427089883 (commit)
----------------------------------------------------------------------
commit 5eaccd845c9957dff754ebfdde417fe5d82e5e82
Author: Robin Watts <[email protected]>
Date: Thu Oct 31 14:25:25 2019 +0000
Update vdb.pl script to latest version.
diff --git a/toolbin/vdb.pl b/toolbin/vdb.pl
index 8555fc1..3833f6f 100644
--- a/toolbin/vdb.pl
+++ b/toolbin/vdb.pl
@@ -3,12 +3,64 @@
# Perl script to ease the use of gdb with valgrind.
#
# Invoke as: vdb.pl <command to run>
+#
+# This also adds some commands to the usual gdb/valgrind
+# stuff.
+#
+# xb:
+#
+# xb expression
+# or:
+# xb expression_addr expression_length
+#
+# This does what you'd hope:
+#
+# mon xb <expression_addr> <expression_length>
+#
+# but it copes with expressions for the address and length
+# rather than insisting on raw numbers.
+#
+# xs:
+#
+# xs expression
+#
+# This does what you'd hope:
+#
+# mon xb <expression> <strlen(expression)>
+#
+# would do.
+#
+# xv:
+#
+# xv expression
+#
+# This does what you'd hope:
+#
+# mon xb &<expression> sizeof(<expression>)
+#
+# would do.
use strict;
use warnings;
use IPC::Open3;
use IO::Select;
+# Store the args
+my @args = @ARGV;
+
+# Wrap ourselves for line editing
+if (!exists $ENV{'VDB_WRAPPED'}) {
+ `which rlwrap`;
+ if ($? != 0) {
+ print "rlwrap not available - no command line editing.\n";
+ print "Consider: sudo apt-get install rlwrap\n";
+ } else {
+ $ENV{'VDB_WRAPPED'}=1;
+ unshift(@args, "rlwrap", $0);
+ exec(@args);
+ }
+}
+
# Global variables
my $gdbkilled = 0;
@@ -21,9 +73,6 @@ sub killgdb() {
}
-# Store the args
-my @args = @ARGV;
-
# Make the invocation args for valgrind
my @vgargs = (
"valgrind",
@@ -61,27 +110,111 @@ $sel->add(*STDIN);
*STDOUT->autoflush();
-my $scanning = 1;
-
+my $rate_limit = 0;
sub print_lines($)
{
my $buf=shift;
while (1) {
- my $loc = index($buf, "\n");
- if ($loc < 0) {
- last;
+ my $loc = index($buf, "\n");
+ if ($loc < 0) {
+ last;
+ }
+ my $line = substr($buf, 0, $loc+1);
+ print "$line";
+ $rate_limit++;
+ if ($rate_limit >= 24) {
+ sleep(1);
+ $rate_limit = 0;
}
- my $line = substr($buf, 0, $loc+1);
- print "$line";
- $buf = substr($buf, $loc+1);
+ $buf = substr($buf, $loc+1);
}
return $buf;
}
+# We scan the output of VG to look for the magic runes
+# State 0 = still waiting for magic runes
+# 1 = runes have been captured.
+my $vg_scan_state = 0;
+
+# We scan the output from GDB to look for responses to commands we have given it.
+# State 0 = Normal output - just parrot it out.
+# 1 = Waiting for the result of a print address
+# 2 = Waiting for the result of a print length
+my $gdb_scan_state = 0;
+
my $vgpartial = '';
my $gdbpartial = '';
+my $inpartial = '';
my $last2print = 0; # 0 = VG, 1 = GDB
+my $xb_addr;
+my $xb_len;
+sub go_command($) {
+ my $command = shift;
+ chomp $command;
+ if (!defined $command) {
+ # When valgrind hits EOF, exit.
+ killgdb();
+ waitpid($vgpid,0);
+ waitpid($gdbpid,0);
+ exit(0);
+ } elsif ($command =~ m/^\s*xb\s+(\S+)\s*$/) {
+ my $one = $1;
+ if ($one =~ m/0x[a-fA-F0-9]*/) {
+ $xb_addr="$one";
+ $xb_len="8";
+ print GDBSTDIN "mon xb $xb_addr $xb_len\n";
+ } else {
+ # We need to figure out the value of xb_addr;
+ if ($one =~ m/^\&(.+)/) {
+ $xb_len="sizeof($1)";
+ } else {
+ $xb_len="sizeof(*$one)";
+ }
+ print GDBSTDIN "print $one\n";
+ $gdb_scan_state=1; # Next thing we get back will be the address
+ }
+ } elsif ($command =~ m/^\s*xv\s+(\S+)\s*$/) {
+ my $one = $1;
+ # We need to figure out the value of xb_addr;
+ $xb_len="sizeof($one)";
+ print GDBSTDIN "print &$one\n";
+ $gdb_scan_state=1; # Next thing we get back will be the address
+ } elsif ($command =~ m/^\s*xb\s+(\S+)\s+(\S+)\s*$/) {
+ my $one = $1;
+ my $two = $2;
+ if ($one =~ m/0x[a-fA-F0-9]*/) {
+ $xb_addr="$one";
+ if ($two =~ m/^\d+$/) {
+ $xb_len="$two";
+ print GDBSTDIN "mon xb $xb_addr $xb_len\n";
+ } else {
+ print GDBSTDIN "print $two\n";
+ $gdb_scan_state=2; # Next thing we get back will be the length
+ }
+ } else {
+ # We need to figure out the value of xb_addr;
+ $xb_len="$two";
+ print GDBSTDIN "print $one\n";
+ $gdb_scan_state=1; # Next thing we get back will be the address
+ }
+ } elsif ($command =~ m/^\s*xs\s+(\S+)\s*$/) {
+ my $one = $1;
+ if ($one =~ m/0x[a-fA-F0-9]*/) {
+ $xb_addr="$one";
+ print GDBSTDIN "print strlen($one)\n";
+ $gdb_scan_state=2; # Next thing we get back will be the length
+ } else {
+ # We need to figure out the value of xb_addr;
+ $xb_len="strlen($one)";
+ print GDBSTDIN "print $one\n";
+ $gdb_scan_state=1; # Next thing we get back will be the address
+ }
+ } else {
+ print GDBSTDIN "$command\n";
+ }
+}
+
while (my @ready = $sel->can_read())
{
for my $fh (@ready) {
@@ -95,54 +228,117 @@ while (my @ready = $sel->can_read())
waitpid($gdbpid,0);
exit(0);
}
- if ($scanning) {
+ if ($vg_scan_state == 0) {
$vgbuf =~ m/(target remote \| .+ \-\-pid\=\d+)\s*/;
if ($1) {
- print GDBSTDIN "$1\n";
- $scanning = 0;
+ print GDBSTDIN "$1\n";
+ $vg_scan_state = 1;
}
}
- # It definitely read something, so print it.
- if ($last2print == 1) { # Last to print was GDB
+ # It definitely read something, so print it.
+ if ($last2print == 1) { # Last to print was GDB
if ($gdbpartial ne "") { # We need a newline
- print "\n";
- }
- # Better reprint any partial line we had
- print "$vgpartial";
- }
+ print "\n";
+ }
+ # Better reprint any partial line we had
+ print "$vgpartial";
+ }
$vgpartial = print_lines($vgbuf);
- print "$vgpartial";
- $last2print = 0; # VG
+ print "$vgpartial";
+ $last2print = 0; # VG
}
# Don't say anything to or from gdb until after we've got the magic words from valgrind
- if ($scanning == 0) {
- # Anything the user says, should be parotted to gdb
- if ($fh eq *STDIN) {
- my $buf = '';
- if (sysread(STDIN, $buf, 64*1024, length($buf)) == 0) {
- # When the user hits EOF, start to kill stuff.
+ if ($vg_scan_state != 0) {
+ if ($fh eq *STDIN) {
+ my $inbuf=$inpartial;
+ if (sysread(STDIN, $inbuf, 64*1024, length($inbuf)) == 0) {
+ # When gdb hits EOF start to kill stuff.
killgdb();
}
- print GDBSTDIN "$buf";
- }
+ while (1) {
+ my $loc = index($inbuf, "\n");
+ if ($loc < 0) {
+ last;
+ }
+ my $line = substr($inbuf, 0, $loc+1);
+ go_command($line);
+ $inbuf = substr($inbuf, $loc+1);
+ }
+ $inpartial = $inbuf;
+ }
# Anything gdb says, should be parotted out.
if ($fh eq *GDBSTDOUT) {
- my $gdbbuf='';
+ my $gdbbuf='';
if (sysread(GDBSTDOUT, $gdbbuf, 64*1024, length($gdbbuf)) == 0) {
# When gdb hits EOF start to kill stuff.
killgdb();
}
- # It definite read something, so print it.
- if ($last2print == 0) { # Last to print was VG
- if ($vgpartial ne "") { # We need a newline
- print "\n";
+ while ($gdbbuf ne "") {
+ if ($gdb_scan_state == 0) {
+ # It definitely read something, so print it.
+ if ($last2print == 0) { # Last to print was VG
+ if ($vgpartial ne "") { # We need a newline
+ print "\n";
+ }
+ # Better reprint any partial line we had
+ print "$gdbpartial";
+ }
+ $gdbpartial = print_lines($gdbbuf);
+ $gdbbuf="";
+ print "$gdbpartial";
+ $last2print = 1; # GDB
+ } elsif ($gdb_scan_state == 1) {
+ $gdbpartial .= $gdbbuf;
+ $gdbbuf = "";
+ while (1) {
+ my $loc = index($gdbpartial, "\n");
+ if ($loc < 0) {
+ last;
+ }
+ my $line = substr($gdbpartial, 0, $loc+1);
+ $gdbpartial = substr($gdbpartial, $loc+1);
+ if ($line =~ m/\$\d+ =.*(0x[a-zA-Z0-9]+)/) {
+ $xb_addr=$1;
+ print GDBSTDIN "print $xb_len\n";
+ $gdb_scan_state = 2; # Now we look for the length
+ last;
+ }
+ if ($line =~ m/(.*\n)/) {
+ $gdbpartial =~ s/(.*\n)//;
+ print "$1";
+ $gdbbuf = $gdbpartial;
+ $gdbpartial = "";
+ $gdb_scan_state = 0; # Error
+ last;
+ }
+ }
+ } elsif ($gdb_scan_state == 2) {
+ $gdbpartial .= $gdbbuf;
+ $gdbbuf = "";
+ while (1) {
+ my $loc = index($gdbpartial, "\n");
+ if ($loc < 0) {
+ last;
+ }
+ my $line = substr($gdbpartial, 0, $loc+1);
+ $gdbpartial = substr($gdbpartial, $loc+1);
+ if ($line =~ m/\$\d+ = (\d+)/) {
+ $xb_len=$1;
+ $gdb_scan_state = 0;
+ print GDBSTDIN "mon xb $xb_addr $xb_len\n";
+ last;
+ }
+ if ($line =~ m/(.*\n)/) {
+ $gdbpartial =~ s/(.*\n)//;
+ print "$1";
+ $gdbbuf = $gdbpartial;
+ $gdbpartial = "";
+ $gdb_scan_state = 0; # Error
+ last;
+ }
+ }
}
- # Better reprint any partial line we had
- print "$gdbpartial";
- }
- $gdbpartial = print_lines($gdbbuf);
- print "$gdbpartial";
- $last2print = 1; # GDB
+ }
}
}
}
Summary of changes:
toolbin/vdb.pl | 280 ++++++++++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 238 insertions(+), 42 deletions(-)