cgcc

   1 #!/usr/bin/perl -w
   2 # -----------------------------------------------------------------------------
   3
   4 use strict;
   5 use warnings;
   6
   7 my $cc = $ENV{'REAL_CC'} || 'cc';
   8 my $check = $ENV{'CHECK'} || 'sparse';
   9 my $ccom = $cc;
  10
  11 my $m32 = 0;
  12 my $m64 = 0;
  13 my $has_specs = 0;
  14 my $gendeps = 0;
  15 my $do_check = 0;
  16 my $do_compile = 1;
  17 my $gcc_base_dir;
  18 my $multiarch_dir;
  19 my $verbose = 0;
  20 my $nargs = 0;
  21
  22 while (@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
  85 add_option:
  86     my $this_arg = ' ' . &quote_arg ($_);
  87     $cc .= $this_arg unless &check_only_option ($_);
  88     $check .= $this_arg;
  89 }
  90
  91 if ($gendeps) {
  92     $do_compile = 1;
  93     $do_check = 0;
  94 }
  95
  96 if ($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
 118 if ($do_compile) {
 119     print "$cc\n" if $verbose;
 120     exec ($cc);
 121 }
 122
 123 exit 0;
 124
 125 # -----------------------------------------------------------------------------
 126 # Check if an option is for "check" only.
 127
 128 sub 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
 140 sub 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
 151 sub 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
 175 sub 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
 244 sub define_size_t {
 245     my ($text) = @_;
 246     # We have to undef in order to override check's internal definition.
 247     return ' -U__SIZE_TYPE__ ' . &quote_arg ("-D__SIZE_TYPE__=$text");
 248 }
 249
 250 # -----------------------------------------------------------------------------
 251
 252 sub 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 # -----------------------------------------------------------------------------