cgcc

   1 #!/usr/bin/perl -w
   2 # -----------------------------------------------------------------------------
   3
   4 my $cc = $ENV{'REAL_CC'} || 'cc';
   5 my $check = $ENV{'CHECK'} || 'check';
   6
   7 my $m64 = 0;
   8 my $has_specs = 0;
   9 my $do_check = 0;
  10 my $do_compile = 1;
  11 my $verbose = 0;
  12
  13 foreach (@ARGV) {
  14     # Look for a .c file.  We don't want to run the checker on .o or .so files
  15     # in the link run.  (This simplistic check knows nothing about options
  16     # with arguments, but it seems to do the job.)
  17     $do_check = 1 if /^[^-].*\.c$/;
  18
  19     $m64 = 1 if /^-m64$/;
  20
  21     if (/^-specs=(.*)$/) {
  22         $check .= &add_specs ($1);
  23         $has_specs = 1;
  24         next;
  25     }
  26
  27     if ($_ eq '-no-compile') {
  28         $do_compile = 0;
  29         next;
  30     }
  31
  32     # If someone adds "-E", don't pre-process twice.
  33     $do_compile = 0 if $_ eq '-E';
  34
  35     $verbose = 1 if $_ eq '-v';
  36
  37     my $this_arg = ' ' . &quote_arg ($_);
  38     $cc .= $this_arg unless &check_only_option ($_);
  39     $check .= $this_arg;
  40 }
  41
  42 if ($do_check) {
  43     if (!$has_specs) {
  44         $check .= &add_specs ('host_arch_specs');
  45         $check .= &add_specs ('host_os_specs');
  46     }
  47     print "$check\n" if $verbose;
  48 #    exit 1;
  49     system ($check);
  50 }
  51
  52 if ($do_compile) {
  53     print "$cc\n" if $verbose;
  54     exec ($cc);
  55 }
  56
  57 exit 0;
  58
  59 # -----------------------------------------------------------------------------
  60 # Check if an option is for "check" only.
  61
  62 sub check_only_option {
  63     my ($arg) = @_;
  64     return 1 if $arg =~ /^-W(no-?)?(default-bitfield-sig|bitwise|typesign)$/;
  65     return 0;
  66 }
  67
  68 # -----------------------------------------------------------------------------
  69 # Simple arg-quoting function.  Just adds backslashes when needed.
  70
  71 sub quote_arg {
  72     my ($arg) = @_;
  73     return "''" if $arg eq '';
  74     return join ('',
  75                  map {
  76                      m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_;
  77                  } (split (//, $arg)));
  78 }
  79
  80 # -----------------------------------------------------------------------------
  81
  82 sub integer_types {
  83     my ($char,@dummy) = @_;
  84
  85     my %pow2m1 =
  86         (8 => '127',
  87          16 => '32767',
  88          32 => '2147483647',
  89          64 => '9223372036854775807',
  90          );
  91     my @types = (['SCHAR',''], ['SHRT',''], ['INT',''], ['LONG','L'], ['LONG_LONG','LL']);
  92
  93     my $result = " -D__CHAR_BIT__=$char";
  94     while (@types) {
  95         my $bits = shift @_;
  96         my ($name,$suffix) = @{ shift @types };
  97         die "$0: wierd number of bits." unless exists $pow2m1{$bits};
  98         $result .= " -D__${name}_MAX__=" . $pow2m1{$bits} . $suffix;
  99     }
 100     return $result;
 101 }
 102
 103 # -----------------------------------------------------------------------------
 104
 105 sub float_types {
 106     my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_;
 107     my $result = " -D__FLT_RADIX__=2";
 108     $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1');
 109     $result .= " -D__DECIMAL_DIG__=$dec_dig";
 110
 111     my %constants =
 112         (24 =>
 113          {
 114              'MIN' => '1.17549435e-38',
 115              'MAX' => '3.40282347e+38',
 116              'EPSILON' => '1.19209290e-7',
 117              'DENORM_MIN' => '1.40129846e-45',
 118          },
 119          53 =>
 120          {
 121              'MIN' => '2.2250738585072014e-308',
 122              'MAX' => '1.7976931348623157e+308',
 123              'EPSILON' => '2.2204460492503131e-16',
 124              'DENORM_MIN' => '4.9406564584124654e-324',
 125          },
 126          64 =>
 127          {
 128              'MIN' => '3.36210314311209350626e-4932',
 129              'MAX' => '1.18973149535723176502e+4932',
 130              'EPSILON' => '1.08420217248550443401e-19',
 131              'DENORM_MIN' => '3.64519953188247460253e-4951',
 132          },
 133          113 =>
 134          {
 135              'MIN' => '3.36210314311209350626267781732175260e-4932',
 136              'MAX' => '1.18973149535723176508575932662800702e+4932',
 137              'EPSILON' => '1.92592994438723585305597794258492732e-34',
 138              'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966',
 139          },
 140          );
 141
 142     my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']);
 143     while (@types) {
 144         my ($mant_bits,$exp_bits) = @{ shift @bitsizes };
 145         my ($name,$suffix) = @{ shift @types };
 146
 147         my $h = $constants{$mant_bits};
 148         die "$0: wierd number of mantissa bits." unless $h;
 149
 150         my $mant_dig = int (($mant_bits - 1) * log (2) / log (10));
 151         my $max_exp = 1 << ($exp_bits - 1);
 152         my $min_exp = 3 - $max_exp;
 153         my $max_10_exp = int ($max_exp * log (2) / log (10));
 154         my $min_10_exp = -int (-$min_exp * log (2) / log (10));
 155
 156         $result .= " -D__${name}_MANT_DIG__=$mant_bits";
 157         $result .= " -D__${name}_DIG__=$mant_dig";
 158         $result .= " -D__${name}_MIN_EXP__='($min_exp)'";
 159         $result .= " -D__${name}_MAX_EXP__=$max_exp";
 160         $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'";
 161         $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp";
 162         $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0');
 163         $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');;
 164
 165         foreach my $inf (sort keys %$h) {
 166             $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix;
 167         }
 168     }
 169     return $result;
 170 }
 171
 172 # -----------------------------------------------------------------------------
 173
 174 sub define_size_t {
 175     my ($text) = @_;
 176     # We have to undef in order to override check's internal definition.
 177     return ' -U__SIZE_TYPE__ ' . &quote_arg ("-D__SIZE_TYPE__=$text");
 178 }
 179
 180 # -----------------------------------------------------------------------------
 181
 182 sub add_specs {
 183     my ($spec) = @_;
 184     if ($spec eq 'sunos') {
 185         return &add_specs ('unix') .
 186             ' -D__sun__=1 -D__sun=1 -Dsun=1' .
 187             ' -D__svr4__=1 -DSVR4=1' .
 188             ' -D__STDC__=0' .
 189             ' -D_REENTRANT' .
 190             ' -D_SOLARIS_THREADS' .
 191             ' -DNULL="((void *)0)"';
 192     } elsif ($spec eq 'linux') {
 193         return &add_specs ('unix') .
 194             ' -D__linux__=1 -D__linux=1 -Dlinux=linux' .
 195             ' -D__STDC__=1';
 196     } elsif ($spec eq 'unix') {
 197         return ' -Dunix=1 -D__unix=1 -D__unix__=1';
 198     } elsif ($spec eq 'i86') {
 199         return (' -Di386=1 -D__i386=1 -D__i386__=1' .
 200                 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
 201                 &float_types (1, 1, 21, [24,8], [53,11], [64,15]) .
 202                 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
 203     } elsif ($spec eq 'sparc') {
 204         return (' -Dsparc=1 -D__sparc=1 -D__sparc__=1' .
 205                 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
 206                 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
 207                 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
 208     } elsif ($spec eq 'host_os_specs') {
 209         my $os = `uname -s`;
 210         chomp $os;
 211         return &add_specs (lc $os);
 212     } elsif ($spec eq 'host_arch_specs') {
 213         my $arch = `uname -m`;
 214         chomp $arch;
 215         if ($arch =~ /^(i.?86|athlon)$/i) {
 216             return &add_specs ('i86');
 217         } elsif ($arch =~ /^(sun4u)$/i) {
 218             return &add_specs ('sparc');
 219         }
 220     } else {
 221         die "$0: invalid specs: $spec\n";
 222     }
 223 }
 224
 225 # -----------------------------------------------------------------------------