cgcc

   1 #!/usr/bin/perl -w
   2 # -----------------------------------------------------------------------------
   3
   4 my $cc = $ENV{'REAL_CC'} || 'cc';
   5 my $check = $ENV{'CHECK'} || 'sparse';
   6
   7 my $m32 = 0;
   8 my $m64 = 0;
   9 my $has_specs = 0;
  10 my $gendeps = 0;
  11 my $do_check = 0;
  12 my $do_compile = 1;
  13 my $gcc_base_dir;
  14 my $verbose = 0;
  15
  16 while (@ARGV) {
  17     $_ = shift(@ARGV);
  18     # Look for a .c file.  We don't want to run the checker on .o or .so files
  19     # in the link run.  (This simplistic check knows nothing about options
  20     # with arguments, but it seems to do the job.)
  21     $do_check = 1 if /^[^-].*\.c$/;
  22
  23     # Ditto for stdin.
  24     $do_check = 1 if $_ eq '-';
  25
  26     $m32 = 1 if /^-m32$/;
  27     $m64 = 1 if /^-m64$/;
  28     $gendeps = 1 if /^-M$/;
  29
  30     if (/^-target=(.*)$/) {
  31         $check .= &add_specs ($1);
  32         $has_specs = 1;
  33         next;
  34     }
  35
  36     if ($_ eq '-no-compile') {
  37         $do_compile = 0;
  38         next;
  39     }
  40
  41     if (/^-gcc-base-dir$/) {
  42         $gcc_base_dir = shift @ARGV;
  43         die ("$0: missing argument for -gcc-base-dir option") if !$gcc_base_dir;
  44         next;
  45     }
  46
  47     # If someone adds "-E", don't pre-process twice.
  48     $do_compile = 0 if $_ eq '-E';
  49
  50     $verbose = 1 if $_ eq '-v';
  51
  52     my $this_arg = ' ' . &quote_arg ($_);
  53     $cc .= $this_arg unless &check_only_option ($_);
  54     $check .= $this_arg unless &cc_only_option ($_);
  55 }
  56
  57 if ($gendeps) {
  58     $do_compile = 1;
  59     $do_check = 0;
  60 }
  61
  62 if ($do_check) {
  63     if (!$has_specs) {
  64         $check .= &add_specs ('host_arch_specs');
  65         $check .= &add_specs ('host_os_specs');
  66     }
  67
  68     $gcc_base_dir = qx($cc -print-file-name=) if !$gcc_base_dir;
  69     $check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir;
  70
  71     print "$check\n" if $verbose;
  72     if ($do_compile) {
  73         system ($check);
  74     } else {
  75         exec ($check);
  76     }
  77 }
  78
  79 if ($do_compile) {
  80     print "$cc\n" if $verbose;
  81     exec ($cc);
  82 }
  83
  84 exit 0;
  85
  86 # -----------------------------------------------------------------------------
  87 # Check if an option is for "check" only.
  88
  89 sub check_only_option {
  90     my ($arg) = @_;
  91     return 1 if $arg =~ /^-W(no-?)?(default-bitfield-sign|one-bit-signed-bitfield|cast-truncate|bitwise|typesign|context|undef|ptr-subtraction-blows|cast-to-as|decl|transparent-union|address-space|enum-mismatch|do-while|old-initializer|non-pointer-null|paren-string|return-void)$/;
  92     return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/;
  93     return 0;
  94 }
  95
  96 # -----------------------------------------------------------------------------
  97 # Check if an option is for "cc" only.
  98
  99 sub cc_only_option {
 100     my ($arg) = @_;
 101     # -Wall turns on all Sparse warnings, including experimental and noisy
 102     # ones.  Don't include it just because a project wants to pass -Wall to cc.
 103     # If you really want cgcc to run sparse with -Wall, use
 104     # CHECK="sparse -Wall".
 105     return 1 if $arg =~ /^-Wall$/;
 106     return 0;
 107 }
 108
 109 # -----------------------------------------------------------------------------
 110 # Simple arg-quoting function.  Just adds backslashes when needed.
 111
 112 sub quote_arg {
 113     my ($arg) = @_;
 114     return "''" if $arg eq '';
 115     return join ('',
 116                  map {
 117                      m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_;
 118                  } (split (//, $arg)));
 119 }
 120
 121 # -----------------------------------------------------------------------------
 122
 123 sub integer_types {
 124     my ($char,@dummy) = @_;
 125
 126     my %pow2m1 =
 127         (8 => '127',
 128          16 => '32767',
 129          32 => '2147483647',
 130          64 => '9223372036854775807',
 131          128 => '170141183460469231731687303715884105727',
 132          );
 133     my @types = (['SCHAR',''], ['SHRT',''], ['INT',''], ['LONG','L'], ['LONG_LONG','LL'], ['LONG_LONG_LONG','LLL']);
 134
 135     my $result = " -D__CHAR_BIT__=$char";
 136     while (@types) {
 137         my $bits = shift @_;
 138         my ($name,$suffix) = @{ shift @types };
 139         die "$0: weird number of bits." unless exists $pow2m1{$bits};
 140         $result .= " -D__${name}_MAX__=" . $pow2m1{$bits} . $suffix;
 141     }
 142     return $result;
 143 }
 144
 145 # -----------------------------------------------------------------------------
 146
 147 sub float_types {
 148     my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_;
 149     my $result = " -D__FLT_RADIX__=2";
 150     $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1');
 151     $result .= " -D__DECIMAL_DIG__=$dec_dig";
 152
 153     my %constants =
 154         (24 =>
 155          {
 156              'MIN' => '1.17549435e-38',
 157              'MAX' => '3.40282347e+38',
 158              'EPSILON' => '1.19209290e-7',
 159              'DENORM_MIN' => '1.40129846e-45',
 160          },
 161          53 =>
 162          {
 163              'MIN' => '2.2250738585072014e-308',
 164              'MAX' => '1.7976931348623157e+308',
 165              'EPSILON' => '2.2204460492503131e-16',
 166              'DENORM_MIN' => '4.9406564584124654e-324',
 167          },
 168          64 =>
 169          {
 170              'MIN' => '3.36210314311209350626e-4932',
 171              'MAX' => '1.18973149535723176502e+4932',
 172              'EPSILON' => '1.08420217248550443401e-19',
 173              'DENORM_MIN' => '3.64519953188247460253e-4951',
 174          },
 175          113 =>
 176          {
 177              'MIN' => '3.36210314311209350626267781732175260e-4932',
 178              'MAX' => '1.18973149535723176508575932662800702e+4932',
 179              'EPSILON' => '1.92592994438723585305597794258492732e-34',
 180              'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966',
 181          },
 182          );
 183
 184     my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']);
 185     while (@types) {
 186         my ($mant_bits,$exp_bits) = @{ shift @bitsizes };
 187         my ($name,$suffix) = @{ shift @types };
 188
 189         my $h = $constants{$mant_bits};
 190         die "$0: weird number of mantissa bits." unless $h;
 191
 192         my $mant_dig = int (($mant_bits - 1) * log (2) / log (10));
 193         my $max_exp = 1 << ($exp_bits - 1);
 194         my $min_exp = 3 - $max_exp;
 195         my $max_10_exp = int ($max_exp * log (2) / log (10));
 196         my $min_10_exp = -int (-$min_exp * log (2) / log (10));
 197
 198         $result .= " -D__${name}_MANT_DIG__=$mant_bits";
 199         $result .= " -D__${name}_DIG__=$mant_dig";
 200         $result .= " -D__${name}_MIN_EXP__='($min_exp)'";
 201         $result .= " -D__${name}_MAX_EXP__=$max_exp";
 202         $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'";
 203         $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp";
 204         $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0');
 205         $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');;
 206
 207         foreach my $inf (sort keys %$h) {
 208             $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix;
 209         }
 210     }
 211     return $result;
 212 }
 213
 214 # -----------------------------------------------------------------------------
 215
 216 sub define_size_t {
 217     my ($text) = @_;
 218     # We have to undef in order to override check's internal definition.
 219     return ' -U__SIZE_TYPE__ ' . &quote_arg ("-D__SIZE_TYPE__=$text");
 220 }
 221
 222 # -----------------------------------------------------------------------------
 223
 224 sub add_specs {
 225     my ($spec) = @_;
 226     if ($spec eq 'sunos') {
 227         return &add_specs ('unix') .
 228             ' -D__sun__=1 -D__sun=1 -Dsun=1' .
 229             ' -D__svr4__=1 -DSVR4=1' .
 230             ' -D__STDC__=0' .
 231             ' -D_REENTRANT' .
 232             ' -D_SOLARIS_THREADS' .
 233             ' -DNULL="((void *)0)"';
 234     } elsif ($spec eq 'linux') {
 235         return &add_specs ('unix') .
 236             ' -D__linux__=1 -D__linux=1 -Dlinux=linux';
 237     } elsif ($spec eq 'openbsd') {
 238         return &add_specs ('unix') .
 239             ' -D__OpenBSD__=1';
 240     } elsif ($spec eq 'unix') {
 241         return ' -Dunix=1 -D__unix=1 -D__unix__=1';
 242     } elsif ( $spec =~ /^cygwin/) {
 243         return &add_specs ('unix') .
 244             ' -D__CYGWIN__=1 -D__CYGWIN32__=1' .
 245             " -D'_cdecl=__attribute__((__cdecl__))'" .
 246             " -D'__cdecl=__attribute__((__cdecl__))'" .
 247             " -D'_stdcall=__attribute__((__stdcall__))'" .
 248             " -D'__stdcall=__attribute__((__stdcall__))'" .
 249             " -D'_fastcall=__attribute__((__fastcall__))'" .
 250             " -D'__fastcall=__attribute__((__fastcall__))'" .
 251             " -D'__declspec(x)=__attribute__((x))'";
 252     } elsif ($spec eq 'i86') {
 253         return (' -Di386=1 -D__i386=1 -D__i386__=1' .
 254                 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
 255                 &float_types (1, 1, 21, [24,8], [53,11], [64,15]) .
 256                 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
 257     } elsif ($spec eq 'sparc') {
 258         return (' -Dsparc=1 -D__sparc=1 -D__sparc__=1' .
 259                 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
 260                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
 261                 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
 262     } elsif ($spec eq 'sparc64') {
 263         return (' -Dsparc=1 -D__sparc=1 -D__sparc__=1 -D__sparcv9__=1 -D__sparc64__=1 -D__arch64__=1 -D__LP64__=1' .
 264                 &integer_types (8, 16, 32, 64, 64, 128) .
 265                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
 266                 &define_size_t ("long unsigned int"));
 267     } elsif ($spec eq 'x86_64') {
 268         return (' -Dx86_64=1 -D__x86_64=1 -D__x86_64__=1' . ($m32 ? '' : ' -D__LP64__=1') .
 269                 &integer_types (8, 16, 32, $m32 ? 32 : 64, 64, 128) .
 270                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
 271                 &define_size_t ($m32 ? "unsigned int" : "long unsigned int"));
 272     } elsif ($spec eq 'ppc') {
 273         return (' -D__powerpc__=1 -D_BIG_ENDIAN -D_STRING_ARCH_unaligned=1' .
 274                 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
 275                 &float_types (1, 1, 21, [24,8], [53,11], [113,15]) .
 276                 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
 277     } elsif ($spec eq 'host_os_specs') {
 278         my $os = `uname -s`;
 279         chomp $os;
 280         return &add_specs (lc $os);
 281     } elsif ($spec eq 'host_arch_specs') {
 282         my $arch = `uname -m`;
 283         chomp $arch;
 284         if ($arch =~ /^(i.?86|athlon)$/i) {
 285             return &add_specs ('i86');
 286         } elsif ($arch =~ /^(sun4u)$/i) {
 287             return &add_specs ('sparc');
 288         } elsif ($arch =~ /^(x86_64)$/i) {
 289             return &add_specs ('x86_64');
 290         } elsif ($arch =~ /^(ppc)$/i) {
 291             return &add_specs ('ppc');
 292         } elsif ($arch =~ /^(sparc64)$/i) {
 293             return &add_specs ('sparc64');
 294         }
 295     } else {
 296         die "$0: invalid specs: $spec\n";
 297     }
 298 }
 299
 300 # -----------------------------------------------------------------------------