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