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)$/; 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) == 0 or exit 1; 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 1 if $arg =~ /^-msize-(long|llp64)$/; 135 return 0; 136} 137 138# ----------------------------------------------------------------------------- 139# Simple arg-quoting function. Just adds backslashes when needed. 140 141sub quote_arg { 142 my ($arg) = @_; 143 return "''" if $arg eq ''; 144 return join ('', 145 map { 146 m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_; 147 } (split (//, $arg))); 148} 149 150# ----------------------------------------------------------------------------- 151 152sub float_types { 153 my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_; 154 my $result = " -D__FLT_RADIX__=2"; 155 $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1'); 156 $result .= " -D__DECIMAL_DIG__=$dec_dig"; 157 158 my %constants = 159 (24 => 160 { 161 'MIN' => '1.17549435e-38', 162 'MAX' => '3.40282347e+38', 163 'EPSILON' => '1.19209290e-7', 164 'DENORM_MIN' => '1.40129846e-45', 165 }, 166 53 => 167 { 168 'MIN' => '2.2250738585072014e-308', 169 'MAX' => '1.7976931348623157e+308', 170 'EPSILON' => '2.2204460492503131e-16', 171 'DENORM_MIN' => '4.9406564584124654e-324', 172 }, 173 64 => 174 { 175 'MIN' => '3.36210314311209350626e-4932', 176 'MAX' => '1.18973149535723176502e+4932', 177 'EPSILON' => '1.08420217248550443401e-19', 178 'DENORM_MIN' => '3.64519953188247460253e-4951', 179 }, 180 113 => 181 { 182 'MIN' => '3.36210314311209350626267781732175260e-4932', 183 'MAX' => '1.18973149535723176508575932662800702e+4932', 184 'EPSILON' => '1.92592994438723585305597794258492732e-34', 185 'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966', 186 }, 187 ); 188 189 my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']); 190 while (@types) { 191 my ($mant_bits,$exp_bits) = @{ shift @bitsizes }; 192 my ($name,$suffix) = @{ shift @types }; 193 194 my $h = $constants{$mant_bits}; 195 die "$0: weird number of mantissa bits." unless $h; 196 197 my $mant_dig = int (($mant_bits - 1) * log (2) / log (10)); 198 my $max_exp = 1 << ($exp_bits - 1); 199 my $min_exp = 3 - $max_exp; 200 my $max_10_exp = int ($max_exp * log (2) / log (10)); 201 my $min_10_exp = -int (-$min_exp * log (2) / log (10)); 202 203 $result .= " -D__${name}_MANT_DIG__=$mant_bits"; 204 $result .= " -D__${name}_DIG__=$mant_dig"; 205 $result .= " -D__${name}_MIN_EXP__='($min_exp)'"; 206 $result .= " -D__${name}_MAX_EXP__=$max_exp"; 207 $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'"; 208 $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp"; 209 $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0'); 210 $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');; 211 212 foreach my $inf (sort keys %$h) { 213 $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix; 214 } 215 } 216 return $result; 217} 218 219# ----------------------------------------------------------------------------- 220 221sub add_specs { 222 my ($spec) = @_; 223 if ($spec eq 'sunos') { 224 return " --os=$spec" . 225 ' -DSVR4=1' . 226 ' -D__STDC__=0' . 227 ' -D_REENTRANT' . 228 ' -D_SOLARIS_THREADS' . 229 ' -DNULL="((void *)0)"'; 230 } elsif ($spec eq 'linux') { 231 return " --os=$spec"; 232 } elsif ($spec eq 'gnu/kfreebsd') { 233 return &add_specs ('unix') . 234 ' -D__FreeBSD_kernel__=1'; 235 } elsif ($spec eq 'openbsd') { 236 return " --os=$spec"; 237 } elsif ($spec eq 'freebsd') { 238 return " --os=$spec"; 239 } elsif ($spec eq 'netbsd') { 240 return " --os=$spec"; 241 } elsif ($spec eq 'darwin') { 242 return " --os=$spec"; 243 } elsif ($spec eq 'gnu') { # Hurd 244 return &add_specs ('unix') . # So, GNU is Unix, uh? 245 ' -D__GNU__=1 -D__gnu_hurd__=1 -D__MACH__=1'; 246 } elsif ($spec eq 'unix') { 247 return ' -Dunix=1 -D__unix=1 -D__unix__=1'; 248 } elsif ( $spec =~ /^cygwin/) { 249 return ' --os=cygwin'; 250 } elsif ($spec eq 'i386') { 251 $m32 = 1; 252 return ( 253 ' --arch=i386' . 254 &float_types (1, 1, 21, [24,8], [53,11], [64,15])); 255 } elsif ($spec eq 'sparc') { 256 return ( 257 ' --arch=sparc' . 258 &float_types (1, 1, 33, [24,8], [53,11], [113,15])); 259 } elsif ($spec eq 'sparc64') { 260 return ( 261 ' --arch=sparc64' . 262 &float_types (1, 1, 33, [24,8], [53,11], [113,15])); 263 } elsif ($spec eq 'x86_64') { 264 return (' --arch=x86_64' . 265 &float_types (1, 1, 33, [24,8], [53,11], [113,15])); 266 } elsif ($spec eq 'ppc') { 267 return (' --arch=ppc' . 268 &float_types (1, 1, 21, [24,8], [53,11], [113,15])); 269 } elsif ($spec eq 'ppc64') { 270 return ( 271 ' --arch=ppc64' . 272 &float_types (1, 1, 21, [24,8], [53,11], [113,15])); 273 } elsif ($spec eq 'ppc64be') { 274 return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1'; 275 } elsif ($spec eq 'ppc64le') { 276 return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2'; 277 } elsif ($spec eq 's390x') { 278 return (' -D_BIG_ENDIAN' . 279 ' --arch=s390x' . 280 &float_types (1, 1, 36, [24,8], [53,11], [113,15])); 281 } elsif ($spec eq 'riscv32') { 282 return (' --arch=riscv32' . 283 &float_types (1, 1, 33, [24,8], [53,11], [53,11])); 284 } elsif ($spec eq 'riscv64') { 285 return (' --arch=riscv64' . 286 &float_types (1, 1, 33, [24,8], [53,11], [113,15])); 287 } elsif ($spec eq 'arm') { 288 return (' --arch=arm' . 289 &float_types (1, 1, 36, [24,8], [53,11], [53, 11])); 290 } elsif ($spec eq 'arm+hf') { 291 return &add_specs ('arm') . ' -mfloat-abi=hard'; 292 } elsif ($spec eq 'aarch64') { 293 return (' --arch=aarch64' . 294 &float_types (1, 1, 36, [24,8], [53,11], [113,15])); 295 } elsif ($spec eq 'host_os_specs') { 296 my $os = `uname -s`; 297 chomp $os; 298 return &add_specs (lc $os); 299 } elsif ($spec eq 'host_arch_specs') { 300 my $gccmachine; 301 my $arch; 302 303 $gccmachine = `$ccom -dumpmachine`; 304 chomp $gccmachine; 305 306 if ($gccmachine =~ '^aarch64-') { 307 return &add_specs ('aarch64'); 308 } elsif ($gccmachine =~ '^arm-.*eabihf$') { 309 return &add_specs ('arm+hf'); 310 } elsif ($gccmachine =~ '^arm-') { 311 return &add_specs ('arm'); 312 } elsif ($gccmachine =~ '^i[23456]86-') { 313 return &add_specs ('i386'); 314 } elsif ($gccmachine =~ '^(powerpc|ppc)64le-') { 315 return &add_specs ('ppc64le'); 316 } elsif ($gccmachine =~ '^s390x-') { 317 return &add_specs ('s390x'); 318 } elsif ($gccmachine eq 'x86_64-linux-gnux32') { 319 return &add_specs ('x86_64') . ' -mx32'; 320 } elsif ($gccmachine =~ '^x86_64-') { 321 return &add_specs ('x86_64'); 322 } 323 324 # fall back to uname -m to determine the specifics. 325 # Note: this is only meaningful when using natively 326 # since information about the host is used to 327 # guess characteristics of the target. 328 329 $arch = `uname -m`; 330 chomp $arch; 331 if ($arch =~ /^(i.?86|athlon)$/i) { 332 return &add_specs ('i386'); 333 } elsif ($arch =~ /^(sun4u)$/i) { 334 return &add_specs ('sparc'); 335 } elsif ($arch =~ /^(x86_64)$/i) { 336 return &add_specs ('x86_64'); 337 } elsif ($arch =~ /^(ppc)$/i) { 338 return &add_specs ('ppc'); 339 } elsif ($arch =~ /^(ppc64)$/i) { 340 return &add_specs ('ppc64be'); 341 } elsif ($arch =~ /^(ppc64le)$/i) { 342 return &add_specs ('ppc64le'); 343 } elsif ($arch =~ /^(s390x)$/i) { 344 return &add_specs ('s390x'); 345 } elsif ($arch =~ /^(sparc64)$/i) { 346 return &add_specs ('sparc64'); 347 } elsif ($arch =~ /^arm(?:v[78]l)?$/i) { 348 return &add_specs ('arm'); 349 } elsif ($arch =~ /^(aarch64)$/i) { 350 return &add_specs ('aarch64'); 351 } 352 } else { 353 die "$0: invalid specs: $spec\n"; 354 } 355} 356 357# ----------------------------------------------------------------------------- 358