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     # We don't want to run the checker on non-C files.
  46     if ($_ eq '-x') {
  47         die ("$0: missing argument for $_") if !@ARGV;
  48         $do_check = ($ARGV[0] eq 'c');
  49         $nargs = 1;
  50     }
  51
  52     $m32 = 1 if /^-m32$/;
  53     $m64 = 1 if /^-m64$/;
  54     $gendeps = 1 if /^-(M|MM)$/;
  55
  56     if (/^-target=(.*)$/) {
  57         $check .= &add_specs ($1);
  58         $has_specs = 1;
  59         next;
  60     }
  61
  62     if ($_ eq '-no-compile') {
  63         $do_compile = 0;
  64         next;
  65     }
  66
  67     if (/^-gcc-base-dir$/) {
  68         $gcc_base_dir = shift @ARGV;
  69         die ("$0: missing argument for -gcc-base-dir option") if !$gcc_base_dir;
  70         next;
  71     }
  72
  73     if (/^-multiarch-dir$/) {
  74         $multiarch_dir = shift @ARGV;
  75         die ("$0: missing argument for -multiarch-dir option") if !$multiarch_dir;
  76         next;
  77     }
  78
  79     # If someone adds "-E", don't pre-process twice.
  80     $do_compile = 0 if $_ eq '-E';
  81
  82     $verbose = 1 if $_ eq '-v';
  83
  84 add_option:
  85     my $this_arg = ' ' . &quote_arg ($_);
  86     $cc .= $this_arg unless &check_only_option ($_);
  87     $check .= $this_arg;
  88 }
  89
  90 if ($gendeps) {
  91     $do_compile = 1;
  92     $do_check = 0;
  93 }
  94
  95 if ($do_check) {
  96     if (!$has_specs) {
  97         $check .= &add_specs ('host_arch_specs');
  98         $check .= &add_specs ('host_os_specs');
  99     }
 100
 101     $gcc_base_dir = qx($ccom -print-file-name=) if !$gcc_base_dir;
 102     chomp($gcc_base_dir);  # possibly remove '\n' from compiler
 103     $check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir;
 104
 105     $multiarch_dir = qx($ccom -print-multiarch) if ! defined $multiarch_dir;
 106     chomp($multiarch_dir);  # possibly remove '\n' from compiler
 107     $check .= " -multiarch-dir " . $multiarch_dir if $multiarch_dir;
 108
 109     print "$check\n" if $verbose;
 110     if ($do_compile) {
 111         system ($check);
 112     } else {
 113         exec ($check);
 114     }
 115 }
 116
 117 if ($do_compile) {
 118     print "$cc\n" if $verbose;
 119     exec ($cc);
 120 }
 121
 122 exit 0;
 123
 124 # -----------------------------------------------------------------------------
 125 # Check if an option is for "check" only.
 126
 127 sub check_only_option {
 128     my ($arg) = @_;
 129     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)$/;
 130     return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/;
 131     return 1 if $arg =~ /^-f(dump-ir|memcpy-max-count|diagnostic-prefix)(=\S*)?$/;
 132     return 1 if $arg =~ /^-f(mem2reg|optim)(-enable|-disable|=last)?$/;
 133     return 1 if $arg =~ /^-msize-(long|llp64)$/;
 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 float_types {
 152     my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_;
 153     my $result = " -D__FLT_RADIX__=2";
 154     $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1');
 155     $result .= " -D__DECIMAL_DIG__=$dec_dig";
 156
 157     my %constants =
 158         (24 =>
 159          {
 160              'MIN' => '1.17549435e-38',
 161              'MAX' => '3.40282347e+38',
 162              'EPSILON' => '1.19209290e-7',
 163              'DENORM_MIN' => '1.40129846e-45',
 164          },
 165          53 =>
 166          {
 167              'MIN' => '2.2250738585072014e-308',
 168              'MAX' => '1.7976931348623157e+308',
 169              'EPSILON' => '2.2204460492503131e-16',
 170              'DENORM_MIN' => '4.9406564584124654e-324',
 171          },
 172          64 =>
 173          {
 174              'MIN' => '3.36210314311209350626e-4932',
 175              'MAX' => '1.18973149535723176502e+4932',
 176              'EPSILON' => '1.08420217248550443401e-19',
 177              'DENORM_MIN' => '3.64519953188247460253e-4951',
 178          },
 179          113 =>
 180          {
 181              'MIN' => '3.36210314311209350626267781732175260e-4932',
 182              'MAX' => '1.18973149535723176508575932662800702e+4932',
 183              'EPSILON' => '1.92592994438723585305597794258492732e-34',
 184              'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966',
 185          },
 186          );
 187
 188     my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']);
 189     while (@types) {
 190         my ($mant_bits,$exp_bits) = @{ shift @bitsizes };
 191         my ($name,$suffix) = @{ shift @types };
 192
 193         my $h = $constants{$mant_bits};
 194         die "$0: weird number of mantissa bits." unless $h;
 195
 196         my $mant_dig = int (($mant_bits - 1) * log (2) / log (10));
 197         my $max_exp = 1 << ($exp_bits - 1);
 198         my $min_exp = 3 - $max_exp;
 199         my $max_10_exp = int ($max_exp * log (2) / log (10));
 200         my $min_10_exp = -int (-$min_exp * log (2) / log (10));
 201
 202         $result .= " -D__${name}_MANT_DIG__=$mant_bits";
 203         $result .= " -D__${name}_DIG__=$mant_dig";
 204         $result .= " -D__${name}_MIN_EXP__='($min_exp)'";
 205         $result .= " -D__${name}_MAX_EXP__=$max_exp";
 206         $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'";
 207         $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp";
 208         $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0');
 209         $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');;
 210
 211         foreach my $inf (sort keys %$h) {
 212             $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix;
 213         }
 214     }
 215     return $result;
 216 }
 217
 218 # -----------------------------------------------------------------------------
 219
 220 sub add_specs {
 221     my ($spec) = @_;
 222     if ($spec eq 'sunos') {
 223         return " --os=$spec" .
 224             ' -DSVR4=1' .
 225             ' -D__STDC__=0' .
 226             ' -D_REENTRANT' .
 227             ' -D_SOLARIS_THREADS' .
 228             ' -DNULL="((void *)0)"';
 229     } elsif ($spec eq 'linux') {
 230         return " --os=$spec";
 231     } elsif ($spec eq 'gnu/kfreebsd') {
 232         return &add_specs ('unix') .
 233             ' -D__FreeBSD_kernel__=1';
 234     } elsif ($spec eq 'openbsd') {
 235         return " --os=$spec";
 236     } elsif ($spec eq 'freebsd') {
 237         return " --os=$spec";
 238     } elsif ($spec eq 'netbsd') {
 239         return " --os=$spec";
 240     } elsif ($spec eq 'darwin') {
 241         return " --os=$spec";
 242     } elsif ($spec eq 'gnu') {          # Hurd
 243         return &add_specs ('unix') .    # So, GNU is Unix, uh?
 244             ' -D__GNU__=1 -D__gnu_hurd__=1 -D__MACH__=1';
 245     } elsif ($spec eq 'unix') {
 246         return ' -Dunix=1 -D__unix=1 -D__unix__=1';
 247     } elsif ( $spec =~ /^cygwin/) {
 248         return ' --os=cygwin';
 249     } elsif ($spec eq 'i386') {
 250         $m32 = 1;
 251         return (
 252                 ' --arch=i386' .
 253                 &float_types (1, 1, 21, [24,8], [53,11], [64,15]));
 254     } elsif ($spec eq 'sparc') {
 255         return (
 256                 ' --arch=sparc' .
 257                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
 258     } elsif ($spec eq 'sparc64') {
 259         return (
 260                 ' --arch=sparc64' .
 261                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
 262     } elsif ($spec eq 'x86_64') {
 263         return (' --arch=x86_64' .
 264                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
 265     } elsif ($spec eq 'ppc') {
 266         return (' --arch=ppc' .
 267                 &float_types (1, 1, 21, [24,8], [53,11], [113,15]));
 268     } elsif ($spec eq 'ppc64') {
 269         return (
 270                 ' --arch=ppc64' .
 271                 &float_types (1, 1, 21, [24,8], [53,11], [113,15]));
 272     } elsif ($spec eq 'ppc64be') {
 273         return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1';
 274     } elsif ($spec eq 'ppc64le') {
 275         return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2';
 276     } elsif ($spec eq 's390x') {
 277         return (' -D_BIG_ENDIAN' .
 278                 ' --arch=s390x' .
 279                 &float_types (1, 1, 36, [24,8], [53,11], [113,15]));
 280     } elsif ($spec eq 'riscv32') {
 281         return (' --arch=riscv32' .
 282                 &float_types (1, 1, 33, [24,8], [53,11], [53,11]));
 283     } elsif ($spec eq 'riscv64') {
 284         return (' --arch=riscv64' .
 285                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
 286     } elsif ($spec eq 'arm') {
 287         return (' --arch=arm' .
 288                 &float_types (1, 1, 36, [24,8], [53,11], [53, 11]));
 289     } elsif ($spec eq 'arm+hf') {
 290         return &add_specs ('arm') . ' -mfloat-abi=hard';
 291     } elsif ($spec eq 'aarch64') {
 292         return (' --arch=aarch64' .
 293                 &float_types (1, 1, 36, [24,8], [53,11], [113,15]));
 294     } elsif ($spec eq 'xtensa') {
 295         return (' --arch=xtensa' .
 296                 &float_types (1, 1, 21, [24,8], [53,11], [53,11]));
 297     } elsif ($spec eq 'host_os_specs') {
 298         my $os = `uname -s`;
 299         chomp $os;
 300         return &add_specs (lc $os);
 301     } elsif ($spec eq 'host_arch_specs') {
 302         my $gccmachine;
 303         my $arch;
 304
 305         $gccmachine = `$ccom -dumpmachine`;
 306         chomp $gccmachine;
 307
 308         if ($gccmachine =~ '^aarch64-') {
 309             return &add_specs ('aarch64');
 310         } elsif ($gccmachine =~ '^arm-.*eabihf$') {
 311             return &add_specs ('arm+hf');
 312         } elsif ($gccmachine =~ '^arm-') {
 313             return &add_specs ('arm');
 314         } elsif ($gccmachine =~ '^i[23456]86-') {
 315             return &add_specs ('i386');
 316         } elsif ($gccmachine =~ '^(powerpc|ppc)64le-') {
 317             return &add_specs ('ppc64le');
 318         } elsif ($gccmachine =~ '^s390x-') {
 319             return &add_specs ('s390x');
 320         } elsif ($gccmachine eq 'x86_64-linux-gnux32') {
 321             return &add_specs ('x86_64') . ' -mx32';
 322         } elsif ($gccmachine =~ '^x86_64-') {
 323             return &add_specs ('x86_64');
 324         } elsif ($gccmachine =~ '^xtensa-') {
 325             return &add_specs ('xtensa');
 326         }
 327
 328         # fall back to uname -m to determine the specifics.
 329         # Note: this is only meaningful when using natively
 330         #       since information about the host is used to
 331         #       guess characteristics of the target.
 332
 333         $arch = `uname -m`;
 334         chomp $arch;
 335         if ($arch =~ /^(i.?86|athlon)$/i) {
 336             return &add_specs ('i386');
 337         } elsif ($arch =~ /^(sun4u)$/i) {
 338             return &add_specs ('sparc');
 339         } elsif ($arch =~ /^(x86_64)$/i) {
 340             return &add_specs ('x86_64');
 341         } elsif ($arch =~ /^(ppc)$/i) {
 342             return &add_specs ('ppc');
 343         } elsif ($arch =~ /^(ppc64)$/i) {
 344             return &add_specs ('ppc64be');
 345         } elsif ($arch =~ /^(ppc64le)$/i) {
 346             return &add_specs ('ppc64le');
 347         } elsif ($arch =~ /^(s390x)$/i) {
 348             return &add_specs ('s390x');
 349         } elsif ($arch =~ /^(sparc64)$/i) {
 350             return &add_specs ('sparc64');
 351         } elsif ($arch =~ /^arm(?:v[78]l)?$/i) {
 352             return &add_specs ('arm');
 353         } elsif ($arch =~ /^(aarch64)$/i) {
 354             return &add_specs ('aarch64');
 355         } elsif ($arch =~ /^(xtensa)$/i) {
 356             return &add_specs ('xtensa');
 357         }
 358     } else {
 359         die "$0: invalid specs: $spec\n";
 360     }
 361 }
 362
 363 # -----------------------------------------------------------------------------