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 #
  12 # -----------------------------------------------------------------------------
  13
  14 my $srcfile = $ARGV[0];
  15 my @callstack = ();
  16 my $newlineerror = 0;
  17 my $indentp = 1;
  18
  19 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
  20 LINE:
  21 while (<IN>) {
  22     if (/^Call ([A-Za-z0-9]+\.\d+): .*\)/) {
  23         my $func = $1;
  24         if (/ ret=(........)$/ ||
  25             / ret=(....:....) (ds=....)$/ ||
  26             / ret=(........) (fs=....)$/) {
  27             my $retaddr = $1;
  28             my $segreg = $2;
  29
  30             $segreg = "none" unless defined $segreg;
  31             push @callstack, [$func,$retaddr, $segreg];
  32             next;
  33         } else {
  34             # Assume a line got cut by a line feed in a string.
  35             $_ .= scalar (<IN>);
  36             if (!$newlineerror) {
  37                 print "Error: string probably cut by newline.\n";
  38                 $newlineerror = 1;
  39             }
  40             # print "[$_]";
  41             redo;
  42         }
  43     }
  44
  45
  46     if (/^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(........)$/ ||
  47         /^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(....:....) (ds=....)$/ ||
  48         /^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(........) (fs=....)$/) {
  49         my $func = $1;
  50         my $retaddr = $2;
  51         my $segreg = $3;
  52         my ($topfunc,$topaddr,$topseg);
  53
  54         $segreg = "none" unless defined $segreg;
  55
  56       POP:
  57         while (1) {
  58             if ($#callstack == -1) {
  59                 print "Error: Return from $func to $retaddr with empty stack.\n";
  60                 next LINE;
  61             }
  62
  63             ($topfunc,$topaddr,$topseg) = @{pop @callstack};
  64
  65             if ($topfunc ne $func) {
  66                 print "Error: Return from $topfunc, but call from $func.\n";
  67                 next POP
  68             }
  69             last POP;
  70         }
  71
  72         my $addrok = ($topaddr eq $retaddr);
  73         my $segok = ($topseg eq $segreg);
  74         if ($addrok && $segok) {
  75             print "OK: ", ($indentp ? (' ' x (1 + $#callstack)) : '');
  76             print "$func from $retaddr with $segreg.\n";
  77         } else {
  78             print "Error: Return from $func is to $retaddr, not $topaddr.\n"
  79                 if !$addrok;
  80             print "Error: Return from $func with segreg $segreg, not $topseg.\n"
  81                 if !$segok;
  82         }
  83     }
  84 }
  85
  86 while ($#callstack != -1) {
  87     my ($topfunc,$topaddr) = @{pop @callstack};
  88     print "Error: leftover call to $topfunc from $topaddr.\n";
  89 }
  90
  91 close (IN);