LVM_GetItemRect should not take text size in account for LVIR_LABEL in
[wine] / 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 # -----------------------------------------------------------------------------
14
15 use strict;
16
17 my $srcfile = $ARGV[0];
18 my %tid_callstack = ();
19 my $newlineerror = 0;
20 my $indentp = 1;
21
22 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
23 LINE:
24 while (<IN>) {
25
26
27     if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/  ||
28         /^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) {
29         my $tid = $1;
30         my $func = $2;
31
32 #       print "have call func=$func <$_>\n";
33         if (/ ret=(........)$/ ||
34             / ret=(....:....) (ds=....)$/) {
35             my $retaddr = $1;
36             my $segreg = $2;
37
38             $segreg = "none" unless defined $segreg;
39
40             push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
41             next;
42         } else {
43             # Assume a line got cut by a line feed in a string.
44             $_ .= scalar (<IN>);
45             if (!$newlineerror) {
46                 print "Err[$tid] string probably cut by newline.\n";
47                 $newlineerror = 1;
48             }       
49             # print "[$_]";
50             redo;
51         }
52     }
53
54     if (/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
55         /^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
56         /^([0-9a-f]+):RET  ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/) {
57         my $tid = $1;
58         my $func = $2;
59         my $retaddr = $3;
60         my $segreg = $4;
61         my ($topfunc,$topaddr,$topseg);
62
63 #       print "have ret func=$func <$_>\n";
64         if (!defined($tid_callstack{$tid}))
65         {
66             print "Err[$tid]: unknown tid\n";
67             next;
68         }
69
70         $segreg = "none" unless defined $segreg;
71
72       POP:
73         while (1) {
74             if ($#{$tid_callstack{$tid}} == -1) {
75                 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
76                 next LINE;
77             }
78
79             ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
80
81             if ($topfunc ne $func) {
82                 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
83                 next POP;
84             }
85             last POP;
86         }
87
88         my $addrok = ($topaddr eq $retaddr);
89         my $segok = ($topseg eq $segreg);
90         if ($addrok && $segok) {
91             print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
92             print "$func from $retaddr with $segreg.\n";
93         } else {
94             print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
95                 if !$addrok;
96             print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
97                 if !$segok;
98         }    
99     }
100 }
101
102 foreach my $tid (keys %tid_callstack) {
103     while ($#{$tid_callstack{$tid}} != -1) {
104         my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
105         print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
106     }
107 }
108
109 close (IN);