1#!/usr/bin/perl -w 2# ----------------------------------------------------------------------------- 3 4my $cc = $ENV{'REAL_CC'} || 'cc'; 5my $check = $ENV{'CHECK'} || 'sparse'; 6my $ccom = $cc; 7 8my $m32 = 0; 9my $m64 = 0; 10my $has_specs = 0; 11my $gendeps = 0; 12my $do_check = 0; 13my $do_compile = 1; 14my $gcc_base_dir; 15my $multiarch_dir; 16my $verbose = 0; 17 18while (@ARGV) { 19 $_ = shift(@ARGV); 20 # Look for a .c file. We don't want to run the checker on .o or .so files 21 # in the link run. (This simplistic check knows nothing about options 22 # with arguments, but it seems to do the job.) 23 $do_check = 1 if /^[^-].*\.c$/; 24 25 # Ditto for stdin. 26 $do_check = 1 if $_ eq '-'; 27 28 $m32 = 1 if /^-m32$/; 29 $m64 = 1 if /^-m64$/; 30 $gendeps = 1 if /^-M$/; 31 32 if (/^-target=(.*)$/) { 33 $check .= &add_specs ($1); 34 $has_specs = 1; 35 next; 36 } 37 38 if ($_ eq '-no-compile') { 39 $do_compile = 0; 40 next; 41 } 42 43 if (/^-gcc-base-dir$/) { 44 $gcc_base_dir = shift @ARGV; 45 die ("$0: missing argument for -gcc-base-dir option") if !$gcc_base_dir; 46 next; 47 } 48 49 if (/^-multiarch-dir$/) { 50 $multiarch_dir = shift @ARGV; 51 die ("$0: missing argument for -multiarch-dir option") if !$multiarch_dir; 52 next; 53 } 54 55 # If someone adds "-E", don't pre-process twice. 56 $do_compile = 0 if $_ eq '-E'; 57 58 $verbose = 1 if $_ eq '-v'; 59 60 my $this_arg = ' ' . "e_arg ($_); 61 $cc .= $this_arg unless &check_only_option ($_); 62 $check .= $this_arg; 63} 64 65if ($gendeps) { 66 $do_compile = 1; 67 $do_check = 0; 68} 69 70if ($do_check) { 71 if (!$has_specs) { 72 $check .= &add_specs ('host_arch_specs'); 73 $check .= &add_specs ('host_os_specs'); 74 } 75 76 $gcc_base_dir = qx($ccom -print-file-name=) if !$gcc_base_dir; 77 chomp($gcc_base_dir); # possibly remove '\n' from compiler 78 $check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir; 79 80 $multiarch_dir = qx($ccom -print-multiarch) if ! defined $multiarch_dir; 81 chomp($multiarch_dir); # possibly remove '\n' from compiler 82 $check .= " -multiarch-dir " . $multiarch_dir if $multiarch_dir; 83 84 print "$check\n" if $verbose; 85 if ($do_compile) { 86 system ($check); 87 } else { 88 exec ($check); 89 } 90} 91 92if ($do_compile) { 93 print "$cc\n" if $verbose; 94 exec ($cc); 95} 96 97exit 0; 98 99# ----------------------------------------------------------------------------- 100# Check if an option is for "check" only. 101 102sub check_only_option { 103 my ($arg) = @_; 104 return 1 if $arg =~ /^-W(no-?)?(address-space|bitwise|cast-to-as|cast-truncate|context|decl|default-bitfield-sign|designated-init|do-while|enum-mismatch|external-function-has-definition|init-cstring|memcpy-max-count|non-ansi-function-declaration|non-pointer-null|old-initializer|one-bit-signed-bitfield|override-init-all|paren-string|ptr-subtraction-blows|return-void|sizeof-bool|sparse-all|sparse-error|transparent-union|typesign|undef|unknown-attribute)$/; 105 return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/; 106 return 1 if $arg =~ /^-f(dump-linearize|memcpy-max-count)(=\S*)?$/; 107 return 0; 108} 109 110# ----------------------------------------------------------------------------- 111# Simple arg-quoting function. Just adds backslashes when needed. 112 113sub quote_arg { 114 my ($arg) = @_; 115 return "''" if $arg eq ''; 116 return join ('', 117 map { 118 m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_; 119 } (split (//, $arg))); 120} 121 122# ----------------------------------------------------------------------------- 123 124sub integer_types { 125 my ($char,@dummy) = @_; 126 127 my %pow2m1 = 128 (8 => '127', 129 16 => '32767', 130 32 => '2147483647', 131 64 => '9223372036854775807', 132 128 => '170141183460469231731687303715884105727', 133 ); 134 my @types = (['SCHAR',''], ['SHRT',''], ['INT',''], ['LONG','L'], ['LONG_LONG','LL'], ['LONG_LONG_LONG','LLL']); 135 136 my $result = " -D__CHAR_BIT__=$char"; 137 while (@types && @_) { 138 my $bits = shift @_; 139 my ($name,$suffix) = @{ shift @types }; 140 die "$0: weird number of bits." unless exists $pow2m1{$bits}; 141 $result .= " -D__${name}_MAX__=" . $pow2m1{$bits} . $suffix; 142 } 143 return $result; 144} 145 146# ----------------------------------------------------------------------------- 147 148sub float_types { 149 my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_; 150 my $result = " -D__FLT_RADIX__=2"; 151 $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1'); 152 $result .= " -D__DECIMAL_DIG__=$dec_dig"; 153 154 my %constants = 155 (24 => 156 { 157 'MIN' => '1.17549435e-38', 158 'MAX' => '3.40282347e+38', 159 'EPSILON' => '1.19209290e-7', 160 'DENORM_MIN' => '1.40129846e-45', 161 }, 162 53 => 163 { 164 'MIN' => '2.2250738585072014e-308', 165 'MAX' => '1.7976931348623157e+308', 166 'EPSILON' => '2.2204460492503131e-16', 167 'DENORM_MIN' => '4.9406564584124654e-324', 168 }, 169 64 => 170 { 171 'MIN' => '3.36210314311209350626e-4932', 172 'MAX' => '1.18973149535723176502e+4932', 173 'EPSILON' => '1.08420217248550443401e-19', 174 'DENORM_MIN' => '3.64519953188247460253e-4951', 175 }, 176 113 => 177 { 178 'MIN' => '3.36210314311209350626267781732175260e-4932', 179 'MAX' => '1.18973149535723176508575932662800702e+4932', 180 'EPSILON' => '1.92592994438723585305597794258492732e-34', 181 'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966', 182 }, 183 ); 184 185 my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']); 186 while (@types) { 187 my ($mant_bits,$exp_bits) = @{ shift @bitsizes }; 188 my ($name,$suffix) = @{ shift @types }; 189 190 my $h = $constants{$mant_bits}; 191 die "$0: weird number of mantissa bits." unless $h; 192 193 my $mant_dig = int (($mant_bits - 1) * log (2) / log (10)); 194 my $max_exp = 1 << ($exp_bits - 1); 195 my $min_exp = 3 - $max_exp; 196 my $max_10_exp = int ($max_exp * log (2) / log (10)); 197 my $min_10_exp = -int (-$min_exp * log (2) / log (10)); 198 199 $result .= " -D__${name}_MANT_DIG__=$mant_bits"; 200 $result .= " -D__${name}_DIG__=$mant_dig"; 201 $result .= " -D__${name}_MIN_EXP__='($min_exp)'"; 202 $result .= " -D__${name}_MAX_EXP__=$max_exp"; 203 $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'"; 204 $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp"; 205 $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0'); 206 $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');; 207 208 foreach my $inf (sort keys %$h) { 209 $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix; 210 } 211 } 212 return $result; 213} 214 215# ----------------------------------------------------------------------------- 216 217sub define_size_t { 218 my ($text) = @_; 219 # We have to undef in order to override check's internal definition. 220 return ' -U__SIZE_TYPE__ ' . "e_arg ("-D__SIZE_TYPE__=$text"); 221} 222 223# ----------------------------------------------------------------------------- 224 225sub add_specs { 226 my ($spec) = @_; 227 if ($spec eq 'sunos') { 228 return &add_specs ('unix') . 229 ' -D__sun__=1 -D__sun=1 -Dsun=1' . 230 ' -D__svr4__=1 -DSVR4=1' . 231 ' -D__STDC__=0' . 232 ' -D_REENTRANT' . 233 ' -D_SOLARIS_THREADS' . 234 ' -DNULL="((void *)0)"'; 235 } elsif ($spec eq 'linux') { 236 return &add_specs ('unix') . 237 ' -D__linux__=1 -D__linux=1 -Dlinux=linux'; 238 } elsif ($spec eq 'gnu/kfreebsd') { 239 return &add_specs ('unix') . 240 ' -D__FreeBSD_kernel__=1'; 241 } elsif ($spec eq 'openbsd') { 242 return &add_specs ('unix') . 243 ' -D__OpenBSD__=1'; 244 } elsif ($spec eq 'darwin') { 245 return 246 ' -D__APPLE__=1 -D__MACH__=1'; 247 } elsif ($spec eq 'unix') { 248 return ' -Dunix=1 -D__unix=1 -D__unix__=1'; 249 } elsif ( $spec =~ /^cygwin/) { 250 return &add_specs ('unix') . 251 ' -D__CYGWIN__=1 -D__CYGWIN32__=1' . 252 " -D'_cdecl=__attribute__((__cdecl__))'" . 253 " -D'__cdecl=__attribute__((__cdecl__))'" . 254 " -D'_stdcall=__attribute__((__stdcall__))'" . 255 " -D'__stdcall=__attribute__((__stdcall__))'" . 256 " -D'_fastcall=__attribute__((__fastcall__))'" . 257 " -D'__fastcall=__attribute__((__fastcall__))'" . 258 " -D'__declspec(x)=__attribute__((x))'"; 259 } elsif ($spec eq 'i86') { 260 return (' -D__i386=1 -D__i386__=1' . 261 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 262 &float_types (1, 1, 21, [24,8], [53,11], [64,15]) . 263 &define_size_t ($m64 ? "long unsigned int" : "unsigned int") . 264 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 265 } elsif ($spec eq 'sparc') { 266 return (' -D__sparc=1 -D__sparc__=1' . 267 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 268 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) . 269 &define_size_t ($m64 ? "long unsigned int" : "unsigned int") . 270 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 271 } elsif ($spec eq 'sparc64') { 272 return (' -D__sparc=1 -D__sparc__=1 -D__sparcv9__=1 -D__sparc64__=1 -D__arch64__=1 -D__LP64__=1' . 273 &integer_types (8, 16, 32, 64, 64, 128) . 274 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) . 275 &define_size_t ("long unsigned int") . 276 ' -D__SIZEOF_POINTER__=8'); 277 } elsif ($spec eq 'x86_64') { 278 return (' -D__x86_64=1 -D__x86_64__=1' . ($m32 ? '' : ' -D__LP64__=1') . 279 &integer_types (8, 16, 32, $m32 ? 32 : 64, 64, 128) . 280 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) . 281 &define_size_t ($m32 ? "unsigned int" : "long unsigned int") . 282 ' -D__SIZEOF_POINTER__=' . ($m32 ? '4' : '8')); 283 } elsif ($spec eq 'ppc') { 284 return (' -D__powerpc__=1 -D_BIG_ENDIAN -D_STRING_ARCH_unaligned=1' . 285 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 286 &float_types (1, 1, 21, [24,8], [53,11], [113,15]) . 287 &define_size_t ($m64 ? "long unsigned int" : "unsigned int") . 288 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 289 } elsif ($spec eq 'ppc64') { 290 return (' -D__powerpc__=1 -D__PPC__=1 -D_STRING_ARCH_unaligned=1' . 291 ' -D__powerpc64__=1 -D__PPC64__=1' . 292 ' -m64' . 293 &float_types (1, 1, 21, [24,8], [53,11], [113,15])); 294 } elsif ($spec eq 's390x') { 295 return (' -D__s390x__ -D__s390__ -D_BIG_ENDIAN' . 296 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 297 &float_types (1, 1, 36, [24,8], [53,11], [113,15]) . 298 &define_size_t ("long unsigned int") . 299 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 300 } elsif ($spec eq 'arm') { 301 chomp (my $gccmachine = `$cc -dumpmachine`); 302 my $cppsymbols = ' -D__arm__=1 -m32'; 303 304 if ($gccmachine eq 'arm-linux-gnueabihf') { 305 $cppsymbols .= ' -D__ARM_PCS_VFP=1'; 306 } 307 308 return ($cppsymbols . 309 &float_types (1, 1, 36, [24,8], [53,11], [53, 11])); 310 } elsif ($spec eq 'aarch64') { 311 return (' -D__aarch64__=1 -m64' . 312 &float_types (1, 1, 36, [24,8], [53,11], [113,15])); 313 } elsif ($spec eq 'host_os_specs') { 314 my $os = `uname -s`; 315 chomp $os; 316 return &add_specs (lc $os); 317 } elsif ($spec eq 'host_arch_specs') { 318 my $arch = `uname -m`; 319 chomp $arch; 320 if ($arch =~ /^(i.?86|athlon)$/i) { 321 return &add_specs ('i86'); 322 } elsif ($arch =~ /^(sun4u)$/i) { 323 return &add_specs ('sparc'); 324 } elsif ($arch =~ /^(x86_64)$/i) { 325 return &add_specs ('x86_64'); 326 } elsif ($arch =~ /^(ppc)$/i) { 327 return &add_specs ('ppc'); 328 } elsif ($arch =~ /^(ppc64)$/i) { 329 return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1'; 330 } elsif ($arch =~ /^(ppc64le)$/i) { 331 return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2'; 332 } elsif ($arch =~ /^(s390x)$/i) { 333 return &add_specs ('s390x'); 334 } elsif ($arch =~ /^(sparc64)$/i) { 335 return &add_specs ('sparc64'); 336 } elsif ($arch =~ /^arm(?:v[78]l)?$/i) { 337 return &add_specs ('arm'); 338 } elsif ($arch =~ /^(aarch64)$/i) { 339 return &add_specs ('aarch64'); 340 } 341 } else { 342 die "$0: invalid specs: $spec\n"; 343 } 344} 345 346# ----------------------------------------------------------------------------- 347