Mercurial > hg > Members > anatofuz > MoarVM

annotate tools/jit-bisect.pl @ 64:da6d6597bd69 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
rollback
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 15 Feb 2019 20:51:54 +0900
parents 2cf249471370
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 #!/usr/bin/env perl
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 use strict;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
3 use warnings;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
4 use Getopt::Long;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 use File::Spec;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 use FindBin;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 use lib $FindBin::Bin;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 use timeout qw(run_timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
9
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 sub run_with {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 my ($command, $env, $timeout) = @_;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 my $status;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
13 {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 # simulate 'local' env vars, which doesn't really work with
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 # child processes
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 my %copy;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 while (my ($k,$v) = each %$env) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
18 $copy{$k} = $ENV{$v};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 $ENV{$k} = $v;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
21 if (defined $timeout) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
22 $status = run_timeout $command, $timeout;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
23 } else {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
24 $status = system @$command;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
25 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
26 while (my ($k,$v) = each %copy) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
27 if (defined $v) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 $ENV{$k} = $v;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 } else {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
30 delete $ENV{$k};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
31 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
32 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
33 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
34
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
35 if ($status == -1) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
36 local $" = ' ';
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
37 die "Failed to start: `@$command`: $!";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
38 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
39
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
40 return $status;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
41 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
42
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
43 sub quietly(&) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
44 my ($code) = @_;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
45 my ($error, @result);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
46 my ($dupout, $duperr);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
47
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
48
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
49 open $dupout, '>&', \*STDOUT;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
50 open $duperr, '>&', \*STDERR;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
51 close STDOUT;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
52 close STDERR;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
53 open STDOUT, '>', File::Spec->devnull;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
54 open STDERR, '>', File::Spec->devnull;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
55
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
56 eval {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
57 if (!defined wantarray) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
58 $code->();
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
59 } elsif (wantarray) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
60 @result = $code->();
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
61 } else {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
62 $result[0] = scalar $code->();
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
63 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
64 1;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
65 } or do {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
66 $error = $@ || $!;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
67 };
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
68
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
69 close STDOUT;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
70 close STDERR;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
71 open STDOUT, '>&', $dupout;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
72 open STDERR, '>&', $duperr;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
73 close $dupout;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
74 close $duperr;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
75
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
76 die $error if $error;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
77
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
78 return wantarray ? @result : $result[0];
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
79 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
80
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
81 sub noisily(&) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
82 my ($code) = @_;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
83 $code->();
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
84 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
85
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
86 sub bisect {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
87 my ($varname, $program, $env, $timeout) = @_;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
88
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
89 $env ||= {};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
90 printf STDERR ("Bisecting %s\n", $varname);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
91 if (%$env) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
92 printf STDERR "Given:\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
93 printf STDERR " %s=%s\n", $_, $env->{$_} for keys %$env;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
94 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
95
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
96 my ($low, $high, $mid) = (0,1,0);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
97 my $status;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
98
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
99 do {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
100 printf STDERR "%s=%d", $varname, $high;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
101 $status = quietly {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
102 run_with($program, { %$env, $varname => $high }, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
103 };
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
104 if ($status == 0) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
105 print STDERR "\tOK\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
106 ($low, $high) = ($high, $high * 2);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
107 } else {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 print STDERR "\tNOT OK\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
109 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 } while ($status == 0);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
111
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 while (($high - $low) > 1) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 $mid = int(($high + $low) / 2);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 printf STDERR "%s=%d", $varname, $mid;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 $status = quietly {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 run_with($program, { %$env, $varname => $mid }, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 };
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 if ($status == 0) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 $low = $mid;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 print STDERR "\tOK\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 } else {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 $high = $mid;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 print STDERR "\tNOT OK\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 return $status ? $low : $mid;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
128
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
129
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 my %OPTS = (
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
131 verbose => 0,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
132 dump => 1,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
133 timeout => undef,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
134 spesh => 0,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
135 );
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
136 GetOptions(\%OPTS, qw(verbose dump! timeout=i spesh)) or die "Could not get options";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
137
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
138 my @command = @ARGV;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
139 die 'Command is required' unless @command;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
140
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
141 if ($OPTS{verbose}) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
142 no warnings 'redefine';
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
143 *quietly = \&noisily;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
144 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
145 my $timeout = delete $OPTS{timeout};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
146
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
147 # start with a clean slate
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
148 delete @ENV{qw(
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
149 MVM_JIT_EXPR_DISABLE
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
150 MVM_JIT_EXPR_LAST_FRAME
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
151 MVM_JTI_EXPR_LAST_BB
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
152 MVM_JIT_DISABLE
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
153 MVM_SPESH_LIMIT
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
154 MVM_SPESH_DISABLE
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
155 )};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
156
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
157 # if we want to 'bisect' a spesh problem, also separate out the
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
158 # inline/osr flags
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
159 delete @ENV{qw(
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
160 MVM_SPESH_INLINE_DISABLE
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
161 MVM_SPESH_OSR_DISABLE
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
162 )} if $OPTS{spesh};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
163 $ENV{MVM_SPESH_BLOCKING} = 1;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
164
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
165 # I find that the addition of the MVM_SPESH_LOG / MVM_JIT_LOG
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
166 # environment variable can sometimes change the spesh order of
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
167 # frames. So let's add it always so that when we run it for logging
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
168 # output, we don't accidentally log the wrong frame.
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
169 $ENV{$_} = File::Spec->devnull for qw(MVM_SPESH_LOG MVM_JIT_LOG);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
170
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
171 quietly { run_with(\@command, {}, $timeout) } or do {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
172 die "This program is quite alright";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
173 };
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
174 quietly {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
175 run_with(\@command, {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
176 ($OPTS{spesh} ? (MVM_SPESH_DISABLE => 1) : (MVM_JIT_EXPR_DISABLE => 1))
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
177 }, $timeout)
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
178 } and do {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
179 die "This program cannot be bisected: $?";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
180 };
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
181 printf STDERR "Checks OK, this program can be bisected\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
182
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
183 if ($OPTS{spesh}) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
184 # on the hypothesis that it is simpler to debug a spesh log
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
185 # /without/ inlining or OSR, than with it, let's first try to
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
186 # switch flags until we find a breaking combination
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
187 my @flags = ({});
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
188 for my $flag (qw(MVM_SPESH_OSR_DISABLE MVM_SPESH_INLINE_DISABLE MVM_JIT_DISABLE)) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
189 @flags = map { $_, { %$_, $flag => 1 } } @flags;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
190 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
191
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
192 my $spesh_flags;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
193 for my $try_flags (reverse @flags) {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
194 quietly {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
195 run_with(\@command, $try_flags, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
196 } and do {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
197 $spesh_flags = $try_flags;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
198 last;
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
199 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
200 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
201
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
202 my $last_good_frame = bisect('MVM_SPESH_LIMIT', \@command, $spesh_flags, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
203 printf STDERR ("SPESH Broken frame: %d.\n", $last_good_frame);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
204
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
205 # alright, get a spesh diff
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
206 my $log_file = sprintf("spesh-%04d.txt", $last_good_frame+1);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
207 printf STDERR ("SPESH Acquiring log: %s\n", $log_file);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
208 run_with(\@command, {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
209 %$spesh_flags,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
210 MVM_SPESH_LOG => $log_file,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
211 MVM_SPESH_LIMIT => $last_good_frame + 1
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
212 }, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
213 print STDERR "Done\n";
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
214 } else {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
215 my $last_good_frame = bisect('MVM_JIT_EXPR_LAST_FRAME', \@command, {}, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
216 my $last_good_block = bisect('MVM_JIT_EXPR_LAST_BB', \@command, {
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
217 MVM_JIT_EXPR_LAST_FRAME => $last_good_frame + 1
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
218 }, $timeout);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
219 printf STDERR ('JIT Broken Frame/BB: %d / %d'."\n", $last_good_frame + 1, $last_good_block + 1);
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
220
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
221 my $dump_script = File::Spec->catfile($FindBin::Bin, 'jit-dump.pl');
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
222 my @dump_command = (
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
223 $^X, $dump_script,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
224 '--frame' => $last_good_frame + 1,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
225 '--block' => $last_good_block + 1,
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
226 ($timeout ? ('--timeout' => $timeout) : ()),
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
227 '--', @command
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
228 );
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
229 run_with(\@dump_command, {}) if $OPTS{dump};
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
230 }
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
231
2cf249471370 convert mercurial for git
Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff changeset
232 __END__