1#!/usr/bin/perl -w 2# ----------------------------------------------------------------------------- 3 4use strict; 5use warnings; 6 7my $cc = $ENV{'REAL_CC'} || 'cc'; 8my $check = $ENV{'CHECK'} || 'sparse'; 9my $ccom = $cc; 10 11my $m32 = 0; 12my $m64 = 0; 13my $has_specs = 0; 14my $gendeps = 0; 15my $do_check = 0; 16my $do_compile = 1; 17my $gcc_base_dir; 18my $multiarch_dir; 19my $verbose = 0; 20my $nargs = 0; 21 22while (@ARGV) { 23 $_ = shift(@ARGV); 24 25 if ($nargs) { 26 $nargs--; 27 goto add_option; 28 } 29 30 # Look for a .c file. We don't want to run the checker on .o or .so files 31 # in the link run. 32 $do_check = 1 if /^[^-].*\.c$/; 33 34 # Ditto for stdin. 35 $do_check = 1 if $_ eq '-'; 36 37 if (/^-(o|MF|MT|MQ)$/) { 38 # Need to be checked explicitly since otherwise 39 # the argument would be processed as a 40 # (non-existant) source file or as an option. 41 die ("$0: missing argument for $_") if !@ARGV; 42 $nargs = 1; 43 } 44 45 # Ignore the extension if '-x c' is given. 46 if ($_ eq '-x') { 47 die ("$0: missing argument for $_") if !@ARGV; 48 die ("$0: invalid argument for $_") if $ARGV[0] ne 'c'; 49 $do_check = 1; 50 $nargs = 1; 51 } 52 53 $m32 = 1 if /^-m32$/; 54 $m64 = 1 if /^-m64$/; 55 $gendeps = 1 if /^-(M|MM|MD|MMD)$/; 56 57 if (/^-target=(.*)$/) { 58 $check .= &add_specs ($1); 59 $has_specs = 1; 60 next; 61 } 62 63 if ($_ eq '-no-compile') { 64 $do_compile = 0; 65 next; 66 } 67 68 if (/^-gcc-base-dir$/) { 69 $gcc_base_dir = shift @ARGV; 70 die ("$0: missing argument for -gcc-base-dir option") if !$gcc_base_dir; 71 next; 72 } 73 74 if (/^-multiarch-dir$/) { 75 $multiarch_dir = shift @ARGV; 76 die ("$0: missing argument for -multiarch-dir option") if !$multiarch_dir; 77 next; 78 } 79 80 # If someone adds "-E", don't pre-process twice. 81 $do_compile = 0 if $_ eq '-E'; 82 83 $verbose = 1 if $_ eq '-v'; 84 85add_option: 86 my $this_arg = ' ' . "e_arg ($_); 87 $cc .= $this_arg unless &check_only_option ($_); 88 $check .= $this_arg; 89} 90 91if ($gendeps) { 92 $do_compile = 1; 93 $do_check = 0; 94} 95 96if ($do_check) { 97 if (!$has_specs) { 98 $check .= &add_specs ('host_arch_specs'); 99 $check .= &add_specs ('host_os_specs'); 100 } 101 102 $gcc_base_dir = qx($ccom -print-file-name=) if !$gcc_base_dir; 103 chomp($gcc_base_dir); # possibly remove '\n' from compiler 104 $check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir; 105 106 $multiarch_dir = qx($ccom -print-multiarch) if ! defined $multiarch_dir; 107 chomp($multiarch_dir); # possibly remove '\n' from compiler 108 $check .= " -multiarch-dir " . $multiarch_dir if $multiarch_dir; 109 110 print "$check\n" if $verbose; 111 if ($do_compile) { 112 system ($check); 113 } else { 114 exec ($check); 115 } 116} 117 118if ($do_compile) { 119 print "$cc\n" if $verbose; 120 exec ($cc); 121} 122 123exit 0; 124 125# ----------------------------------------------------------------------------- 126# Check if an option is for "check" only. 127 128sub check_only_option { 129 my ($arg) = @_; 130 return 1 if $arg =~ /^-W(no-?)?(address-space|bitwise|cast-to-as|cast-truncate|constant-suffix|context|decl|default-bitfield-sign|designated-init|do-while|enum-mismatch|external-function-has-definition|init-cstring|memcpy-max-count|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)$/; 131 return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/; 132 return 1 if $arg =~ /^-f(dump-ir|memcpy-max-count|diagnostic-prefix)(=\S*)?$/; 133 return 1 if $arg =~ /^-f(mem2reg|optim)(-enable|-disable|=last)?$/; 134 return 0; 135} 136 137# ----------------------------------------------------------------------------- 138# Simple arg-quoting function. Just adds backslashes when needed. 139 140sub quote_arg { 141 my ($arg) = @_; 142 return "''" if $arg eq ''; 143 return join ('', 144 map { 145 m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_; 146 } (split (//, $arg))); 147} 148 149# ----------------------------------------------------------------------------- 150 151sub integer_types { 152 my ($char,@dummy) = @_; 153 154 my %pow2m1 = 155 (8 => '127', 156 16 => '32767', 157 32 => '2147483647', 158 64 => '9223372036854775807', 159 128 => '170141183460469231731687303715884105727', 160 ); 161 my @types = (['SCHAR',''], ['SHRT',''], ['INT',''], ['LONG','L'], ['LONG_LONG','LL'], ['LONG_LONG_LONG','LLL']); 162 163 my $result = " -D__CHAR_BIT__=$char"; 164 while (@types && @_) { 165 my $bits = shift @_; 166 my ($name,$suffix) = @{ shift @types }; 167 die "$0: weird number of bits." unless exists $pow2m1{$bits}; 168 $result .= " -D__${name}_MAX__=" . $pow2m1{$bits} . $suffix; 169 } 170 return $result; 171} 172 173# ----------------------------------------------------------------------------- 174 175sub float_types { 176 my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_; 177 my $result = " -D__FLT_RADIX__=2"; 178 $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1'); 179 $result .= " -D__DECIMAL_DIG__=$dec_dig"; 180 181 my %constants = 182 (24 => 183 { 184 'MIN' => '1.17549435e-38', 185 'MAX' => '3.40282347e+38', 186 'EPSILON' => '1.19209290e-7', 187 'DENORM_MIN' => '1.40129846e-45', 188 }, 189 53 => 190 { 191 'MIN' => '2.2250738585072014e-308', 192 'MAX' => '1.7976931348623157e+308', 193 'EPSILON' => '2.2204460492503131e-16', 194 'DENORM_MIN' => '4.9406564584124654e-324', 195 }, 196 64 => 197 { 198 'MIN' => '3.36210314311209350626e-4932', 199 'MAX' => '1.18973149535723176502e+4932', 200 'EPSILON' => '1.08420217248550443401e-19', 201 'DENORM_MIN' => '3.64519953188247460253e-4951', 202 }, 203 113 => 204 { 205 'MIN' => '3.36210314311209350626267781732175260e-4932', 206 'MAX' => '1.18973149535723176508575932662800702e+4932', 207 'EPSILON' => '1.92592994438723585305597794258492732e-34', 208 'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966', 209 }, 210 ); 211 212 my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']); 213 while (@types) { 214 my ($mant_bits,$exp_bits) = @{ shift @bitsizes }; 215 my ($name,$suffix) = @{ shift @types }; 216 217 my $h = $constants{$mant_bits}; 218 die "$0: weird number of mantissa bits." unless $h; 219 220 my $mant_dig = int (($mant_bits - 1) * log (2) / log (10)); 221 my $max_exp = 1 << ($exp_bits - 1); 222 my $min_exp = 3 - $max_exp; 223 my $max_10_exp = int ($max_exp * log (2) / log (10)); 224 my $min_10_exp = -int (-$min_exp * log (2) / log (10)); 225 226 $result .= " -D__${name}_MANT_DIG__=$mant_bits"; 227 $result .= " -D__${name}_DIG__=$mant_dig"; 228 $result .= " -D__${name}_MIN_EXP__='($min_exp)'"; 229 $result .= " -D__${name}_MAX_EXP__=$max_exp"; 230 $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'"; 231 $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp"; 232 $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0'); 233 $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');; 234 235 foreach my $inf (sort keys %$h) { 236 $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix; 237 } 238 } 239 return $result; 240} 241 242# ----------------------------------------------------------------------------- 243 244sub define_size_t { 245 my ($text) = @_; 246 # We have to undef in order to override check's internal definition. 247 return ' -U__SIZE_TYPE__ ' . "e_arg ("-D__SIZE_TYPE__=$text"); 248} 249 250# ----------------------------------------------------------------------------- 251 252sub add_specs { 253 my ($spec) = @_; 254 if ($spec eq 'sunos') { 255 return &add_specs ('unix') . 256 ' -D__sun__=1 -D__sun=1 -Dsun=1' . 257 ' -D__svr4__=1 -DSVR4=1' . 258 ' -D__STDC__=0' . 259 ' -D_REENTRANT' . 260 ' -D_SOLARIS_THREADS' . 261 ' -DNULL="((void *)0)"'; 262 } elsif ($spec eq 'linux') { 263 return &add_specs ('unix') . 264 ' -D__linux__=1 -D__linux=1 -Dlinux=linux'; 265 } elsif ($spec eq 'gnu/kfreebsd') { 266 return &add_specs ('unix') . 267 ' -D__FreeBSD_kernel__=1'; 268 } elsif ($spec eq 'openbsd') { 269 return &add_specs ('unix') . 270 ' -D__OpenBSD__=1'; 271 } elsif ($spec eq 'freebsd') { 272 return &add_specs ('unix') . 273 ' -D__FreeBSD__=1'; 274 } elsif ($spec eq 'netbsd') { 275 return &add_specs ('unix') . 276 ' -D__NetBSD__=1'; 277 } elsif ($spec eq 'darwin') { 278 return 279 ' -D__APPLE__=1 -D__APPLE_CC__=1 -D__MACH__=1'; 280 } elsif ($spec eq 'gnu') { # Hurd 281 return &add_specs ('unix') . # So, GNU is Unix, uh? 282 ' -D__GNU__=1 -D__gnu_hurd__=1 -D__MACH__=1'; 283 } elsif ($spec eq 'unix') { 284 return ' -Dunix=1 -D__unix=1 -D__unix__=1'; 285 } elsif ( $spec =~ /^cygwin/) { 286 return &add_specs ('unix') . 287 ' -D__CYGWIN__=1 -D__CYGWIN32__=1' . 288 " -D'_cdecl=__attribute__((__cdecl__))'" . 289 " -D'__cdecl=__attribute__((__cdecl__))'" . 290 " -D'_stdcall=__attribute__((__stdcall__))'" . 291 " -D'__stdcall=__attribute__((__stdcall__))'" . 292 " -D'_fastcall=__attribute__((__fastcall__))'" . 293 " -D'__fastcall=__attribute__((__fastcall__))'" . 294 " -D'__declspec(x)=__attribute__((x))'"; 295 } elsif ($spec eq 'i386') { 296 return ( 297 &float_types (1, 1, 21, [24,8], [53,11], [64,15])); 298 } elsif ($spec eq 'sparc') { 299 return ( 300 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 301 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) . 302 &define_size_t ($m64 ? "long unsigned int" : "unsigned int") . 303 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 304 } elsif ($spec eq 'sparc64') { 305 return ( 306 &integer_types (8, 16, 32, 64, 64, 128) . 307 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) . 308 &define_size_t ("long unsigned int") . 309 ' -D__SIZEOF_POINTER__=8'); 310 } elsif ($spec eq 'x86_64') { 311 return &float_types (1, 1, 33, [24,8], [53,11], [113,15]); 312 } elsif ($spec eq 'ppc') { 313 return (' -D_BIG_ENDIAN -D_STRING_ARCH_unaligned=1' . 314 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 315 &float_types (1, 1, 21, [24,8], [53,11], [113,15]) . 316 &define_size_t ($m64 ? "long unsigned int" : "unsigned int") . 317 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 318 } elsif ($spec eq 'ppc64') { 319 return (' -D_STRING_ARCH_unaligned=1 -m64' . 320 &float_types (1, 1, 21, [24,8], [53,11], [113,15])); 321 } elsif ($spec eq 'ppc64+be') { 322 return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1'; 323 } elsif ($spec eq 'ppc64+le') { 324 return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2'; 325 } elsif ($spec eq 's390x') { 326 return (' -D_BIG_ENDIAN' . 327 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) . 328 &float_types (1, 1, 36, [24,8], [53,11], [113,15]) . 329 &define_size_t ("long unsigned int") . 330 ' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4')); 331 } elsif ($spec eq 'arm') { 332 return (' -m32' . 333 &float_types (1, 1, 36, [24,8], [53,11], [53, 11])); 334 } elsif ($spec eq 'arm+hf') { 335 return &add_specs ('arm') . ' -D__ARM_PCS_VFP=1'; 336 } elsif ($spec eq 'aarch64') { 337 return (' -m64' . 338 &float_types (1, 1, 36, [24,8], [53,11], [113,15])); 339 } elsif ($spec eq 'host_os_specs') { 340 my $os = `uname -s`; 341 chomp $os; 342 return &add_specs (lc $os); 343 } elsif ($spec eq 'host_arch_specs') { 344 my $gccmachine; 345 my $arch; 346 347 $gccmachine = `$ccom -dumpmachine`; 348 chomp $gccmachine; 349 350 if ($gccmachine =~ '^aarch64-') { 351 return &add_specs ('aarch64'); 352 } elsif ($gccmachine =~ '^arm-.*eabihf$') { 353 return &add_specs ('arm+hf'); 354 } elsif ($gccmachine =~ '^arm-') { 355 return &add_specs ('arm'); 356 } elsif ($gccmachine =~ '^i[23456]86-') { 357 return &add_specs ('i386'); 358 } elsif ($gccmachine =~ '^(powerpc|ppc)64le-') { 359 return &add_specs ('ppc64+le'); 360 } elsif ($gccmachine =~ '^s390x-') { 361 return &add_specs ('s390x'); 362 } elsif ($gccmachine eq 'x86_64-linux-gnux32') { 363 return &add_specs ('x86_64') . ' -mx32'; 364 } elsif ($gccmachine =~ '^x86_64-') { 365 return &add_specs ('x86_64'); 366 } 367 368 # fall back to uname -m to determine the specifics. 369 # Note: this is only meaningful when using natively 370 # since information about the host is used to 371 # guess characteristics of the target. 372 373 $arch = `uname -m`; 374 chomp $arch; 375 if ($arch =~ /^(i.?86|athlon)$/i) { 376 return &add_specs ('i386'); 377 } elsif ($arch =~ /^(sun4u)$/i) { 378 return &add_specs ('sparc'); 379 } elsif ($arch =~ /^(x86_64)$/i) { 380 return &add_specs ('x86_64'); 381 } elsif ($arch =~ /^(ppc)$/i) { 382 return &add_specs ('ppc'); 383 } elsif ($arch =~ /^(ppc64)$/i) { 384 return &add_specs ('ppc64+be'); 385 } elsif ($arch =~ /^(ppc64le)$/i) { 386 return &add_specs ('ppc64+le'); 387 } elsif ($arch =~ /^(s390x)$/i) { 388 return &add_specs ('s390x'); 389 } elsif ($arch =~ /^(sparc64)$/i) { 390 return &add_specs ('sparc64'); 391 } elsif ($arch =~ /^arm(?:v[78]l)?$/i) { 392 return &add_specs ('arm'); 393 } elsif ($arch =~ /^(aarch64)$/i) { 394 return &add_specs ('aarch64'); 395 } 396 } else { 397 die "$0: invalid specs: $spec\n"; 398 } 399} 400 401# ----------------------------------------------------------------------------- 402