cgcc

   1 #!/usr/bin/perl -w
   2 # -----------------------------------------------------------------------------
   3
   4 my $cc = $ENV{'REAL_CC'} || 'cc';
   5 my $check = $ENV{'CHECK'} || 'sparse';
   6 my $ccom = $cc;
   7
   8 my $m32 = 0;
   9 my $m64 = 0;
  10 my $has_specs = 0;
  11 my $gendeps = 0;
  12 my $do_check = 0;
  13 my $do_compile = 1;
  14 my $gcc_base_dir;
  15 my $multiarch_dir;
  16 my $verbose = 0;
  17
  18 while (@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 = ' ' . &quote_arg ($_);
  61     $cc .= $this_arg unless &check_only_option ($_);
  62     $check .= $this_arg;
  63 }
  64
  65 if ($gendeps) {
  66     $do_compile = 1;
  67     $do_check = 0;
  68 }
  69
  70 if ($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
  92 if ($do_compile) {
  93     print "$cc\n" if $verbose;
  94     exec ($cc);
  95 }
  96
  97 exit 0;
  98
  99 # -----------------------------------------------------------------------------
 100 # Check if an option is for "check" only.
 101
 102 sub 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|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)$/;
 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
 113 sub 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
 124 sub 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
 148 sub 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
 217 sub define_size_t {
 218     my ($text) = @_;
 219     # We have to undef in order to override check's internal definition.
 220     return ' -U__SIZE_TYPE__ ' . &quote_arg ("-D__SIZE_TYPE__=$text");
 221 }
 222
 223 # -----------------------------------------------------------------------------
 224
 225 sub 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 # -----------------------------------------------------------------------------