1## -*- mode: Perl -*-
2##
3## Copyright (c) 2012, 2013, 2015, 2016 The University of Utah
4## All rights reserved.
5##
6## This file is distributed under the University of Illinois Open Source
7## License.  See the file COPYING for details.
8
9###############################################################################
10
11package pass_clang_binsrch;
12
13use strict;
14use warnings;
15
16use POSIX;
17
18use Cwd 'abs_path';
19use File::Copy;
20use File::Spec;
21
22use creduce_config qw(bindir libexecdir);
23use creduce_regexes;
24use creduce_utils;
25
26# `$clang_delta' is initialized by `check_prereqs()'.
27my $clang_delta = "clang_delta";
28
29my $ORIG_DIR;
30
31sub count_instances ($$) {
32    (my $cfile, my $which) = @_;
33    open INF, qq{"$clang_delta" --query-instances=$which $cfile |} or die;
34    my $line = <INF>;
35    my $n = 0;
36    if ($line =~ /Available transformation instances: ([0-9]+)$/) {
37      $n = $1;
38    }
39    close INF;
40    return $n;
41}
42
43sub check_prereqs () {
44    $ORIG_DIR = getcwd();
45    my $path;
46    my $abs_bindir = abs_path(bindir);
47    if ((defined $abs_bindir) && ($FindBin::RealBin eq $abs_bindir)) {
48	# This script is in the installation directory.
49	# Use the installed `clang_delta'.
50	$path = libexecdir . "/clang_delta";
51    } else {
52	# Assume that this script is in the C-Reduce build tree.
53	# Use the `clang_delta' that is also in the build tree.
54	$path = "$FindBin::Bin/../clang_delta/clang_delta";
55    }
56    if ((-e $path) && (-x $path)) {
57	$clang_delta = $path;
58	return 1;
59    }
60    # Check Windows
61    $path=$path . ".exe";
62    if (($^O eq "MSWin32") && (-e $path) && (-x $path)) {
63	$clang_delta = $path;
64	return 1;
65    }
66    return 0;
67}
68
69sub new ($$) {
70    (my $cfile, my $which) = @_;
71    my %sh;
72    $sh{"start"} = 1;
73    return \%sh;
74}
75
76sub advance ($$$) {
77    (my $cfile, my $which, my $state) = @_;
78    my %sh = %{$state};
79    return \%sh if defined($sh{"start"});
80    $sh{"index"} += $sh{"chunk"};
81    if ($DEBUG) {
82	my $index = $sh{"index"};
83	my $chunk = $sh{"chunk"};
84	print "ADVANCE: index = $index, chunk = $chunk\n";
85    }
86    return \%sh;
87}
88
89sub round ($) {
90    (my $n) = @_;
91    return int ($n+0.5);
92}
93
94sub transform ($$$) {
95    (my $cfile, my $which, my $state) = @_;
96    my %sh = %{$state};
97
98    if (defined($sh{"start"})) {
99	delete $sh{"start"};
100	my $instances = count_instances($cfile,$which);
101	$sh{"chunk"} = $instances;
102	$sh{"instances"} = $instances;
103	print "initial granularity = $instances\n" if $DEBUG;
104	$sh{"index"} = 1;
105    }
106
107  AGAIN:
108
109    my $n=0;
110    my $index = $sh{"index"};
111    my $chunk = $sh{"chunk"};
112    my $instances = $sh{"instances"};
113    my $tmpfile = File::Temp::tmpnam();
114
115    print "TRANSFORM: index = $index, chunk = $chunk, instances = $instances\n" if $DEBUG;
116
117    if ($index <= $instances) {
118	my $end = $index + $chunk;
119	if ($end > $instances) {
120	    $end = $instances;
121	}
122
123	my $dec = $end - $index + 1;
124
125	my $cmd = qq{"$clang_delta" --transformation=$which --counter=$index --to-counter=$end $cfile};
126	print "$cmd\n" if $DEBUG;
127	my $res = run_clang_delta ("$cmd > $tmpfile");
128
129	if ($res==0) {
130	    File::Copy::move($tmpfile, $cfile);
131	    return ($OK, \%sh);
132	} else {
133	    if ($res == -1) {
134		# nothing?
135	    } elsif ($res == -2) {
136		unlink $tmpfile;
137		print "out of instances!\n" if $DEBUG;
138		goto rechunk;
139	    } else {
140		unlink $tmpfile;
141		return ($ERROR, "crashed: $cmd");
142	    }
143	}
144	File::Copy::move($tmpfile, $cfile);
145    } else {
146      rechunk:
147	return ($STOP, \%sh) if ($sh{"chunk"} < 10);
148	my $newchunk = round ($sh{"chunk"} / 2.0);
149	$sh{"chunk"} = $newchunk;
150	print "granularity = $newchunk\n" if $DEBUG;
151	$sh{"index"} = 1;
152	goto AGAIN;
153    }
154    return ($OK, \%sh);
155}
156
1571;
158