git.oblomov.eu Git - wine/blob - tools/examine-relay

   1 #!/usr/bin/perl -w
   2 # -----------------------------------------------------------------------------
   3 #
   4 # Relay-checker.
   5 #
   6 # This program will inspect a log file with relay information and tell you
   7 # whether calls and returns match.  If not, this suggests that the parameter
   8 # list might be incorrect.  (It could be something else also.)
   9 #
  10 # Copyright 1997-1998 Morten Welinder (terra@diku.dk)
  11 #           2001      Eric Pouech
  12 #
  13 # This library is free software; you can redistribute it and/or
  14 # modify it under the terms of the GNU Lesser General Public
  15 # License as published by the Free Software Foundation; either
  16 # version 2.1 of the License, or (at your option) any later version.
  17 #
  18 # This library is distributed in the hope that it will be useful,
  19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # Lesser General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU Lesser General Public
  24 # License along with this library; if not, write to the Free Software
  25 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  26 # -----------------------------------------------------------------------------
  27
  28 use strict;
  29
  30 my $srcfile = $ARGV[0];
  31 my %tid_callstack = ();
  32 my $newlineerror = 0;
  33 my $indentp = 1;
  34
  35 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
  36 LINE:
  37 while (<IN>) {
  38
  39
  40     if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/  ||
  41         /^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) {
  42         my $tid = $1;
  43         my $func = $2;
  44
  45 #       print "have call func=$func <$_>\n";
  46         if (/ ret=(........)$/ ||
  47             / ret=(....:....) (ds=....)$/) {
  48             my $retaddr = $1;
  49             my $segreg = $2;
  50
  51             $segreg = "none" unless defined $segreg;
  52
  53             push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
  54             next;
  55         } else {
  56             # Assume a line got cut by a line feed in a string.
  57             $_ .= scalar (<IN>);
  58             if (!$newlineerror) {
  59                 print "Err[$tid] string probably cut by newline.\n";
  60                 $newlineerror = 1;
  61             }
  62             # print "[$_]";
  63             redo;
  64         }
  65     }
  66
  67     if (/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
  68         /^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
  69         /^([0-9a-f]+):RET  ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/) {
  70         my $tid = $1;
  71         my $func = $2;
  72         my $retaddr = $3;
  73         my $segreg = $4;
  74         my ($topfunc,$topaddr,$topseg);
  75
  76 #       print "have ret func=$func <$_>\n";
  77         if (!defined($tid_callstack{$tid}))
  78         {
  79             print "Err[$tid]: unknown tid\n";
  80             next;
  81         }
  82
  83         $segreg = "none" unless defined $segreg;
  84
  85       POP:
  86         while (1) {
  87             if ($#{$tid_callstack{$tid}} == -1) {
  88                 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
  89                 next LINE;
  90             }
  91
  92             ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
  93
  94             if ($topfunc ne $func) {
  95                 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
  96                 next POP;
  97             }
  98             last POP;
  99         }
 100
 101         my $addrok = ($topaddr eq $retaddr);
 102         my $segok = ($topseg eq $segreg);
 103         if ($addrok && $segok) {
 104             print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
 105             print "$func from $retaddr with $segreg.\n";
 106         } else {
 107             print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
 108                 if !$addrok;
 109             print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
 110                 if !$segok;
 111         }
 112     }
 113 }
 114
 115 foreach my $tid (keys %tid_callstack) {
 116     while ($#{$tid_callstack{$tid}} != -1) {
 117         my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
 118         print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
 119     }
 120 }
 121
 122 close (IN);