If you have something like
[smatch.git] / cgcc
blob4fab53028a470cf10ef5b57a911342e86ee0ae25
1 #!/usr/bin/perl -w
2 # -----------------------------------------------------------------------------
4 my $cc = $ENV{'REAL_CC'} || 'cc';
5 my $check = $ENV{'CHECK'} || 'sparse';
7 my $m32 = 0;
8 my $m64 = 0;
9 my $has_specs = 0;
10 my $do_check = 0;
11 my $do_compile = 1;
12 my $verbose = 0;
14 foreach (@ARGV) {
15 # Look for a .c file. We don't want to run the checker on .o or .so files
16 # in the link run. (This simplistic check knows nothing about options
17 # with arguments, but it seems to do the job.)
18 $do_check = 1 if /^[^-].*\.c$/;
20 # Ditto for stdin.
21 $do_check = 1 if $_ eq '-';
23 $m32 = 1 if /^-m32$/;
24 $m64 = 1 if /^-m64$/;
26 if (/^-specs=(.*)$/) {
27 $check .= &add_specs ($1);
28 $has_specs = 1;
29 next;
32 if ($_ eq '-no-compile') {
33 $do_compile = 0;
34 next;
37 # If someone adds "-E", don't pre-process twice.
38 $do_compile = 0 if $_ eq '-E';
40 $verbose = 1 if $_ eq '-v';
42 my $this_arg = ' ' . &quote_arg ($_);
43 $cc .= $this_arg unless &check_only_option ($_);
44 $check .= $this_arg unless &cc_only_option ($_);
47 if ($do_check) {
48 if (!$has_specs) {
49 $check .= &add_specs ('host_arch_specs');
50 $check .= &add_specs ('host_os_specs');
52 print "$check\n" if $verbose;
53 if ($do_compile) {
54 system ($check);
55 } else {
56 exec ($check);
60 if ($do_compile) {
61 print "$cc\n" if $verbose;
62 exec ($cc);
65 exit 0;
67 # -----------------------------------------------------------------------------
68 # Check if an option is for "check" only.
70 sub check_only_option {
71 my ($arg) = @_;
72 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)$/;
73 return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/;
74 return 0;
77 # -----------------------------------------------------------------------------
78 # Check if an option is for "cc" only.
80 sub cc_only_option {
81 my ($arg) = @_;
82 # -Wall turns on all Sparse warnings, including experimental and noisy
83 # ones. Don't include it just because a project wants to pass -Wall to cc.
84 # If you really want cgcc to run sparse with -Wall, use
85 # CHECK="sparse -Wall".
86 return 1 if $arg =~ /^-Wall$/;
87 return 0;
90 # -----------------------------------------------------------------------------
91 # Simple arg-quoting function. Just adds backslashes when needed.
93 sub quote_arg {
94 my ($arg) = @_;
95 return "''" if $arg eq '';
96 return join ('',
97 map {
98 m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_;
99 } (split (//, $arg)));
102 # -----------------------------------------------------------------------------
104 sub integer_types {
105 my ($char,@dummy) = @_;
107 my %pow2m1 =
108 (8 => '127',
109 16 => '32767',
110 32 => '2147483647',
111 64 => '9223372036854775807',
113 my @types = (['SCHAR',''], ['SHRT',''], ['INT',''], ['LONG','L'], ['LONG_LONG','LL']);
115 my $result = " -D__CHAR_BIT__=$char";
116 while (@types) {
117 my $bits = shift @_;
118 my ($name,$suffix) = @{ shift @types };
119 die "$0: weird number of bits." unless exists $pow2m1{$bits};
120 $result .= " -D__${name}_MAX__=" . $pow2m1{$bits} . $suffix;
122 return $result;
125 # -----------------------------------------------------------------------------
127 sub float_types {
128 my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_;
129 my $result = " -D__FLT_RADIX__=2";
130 $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1');
131 $result .= " -D__DECIMAL_DIG__=$dec_dig";
133 my %constants =
134 (24 =>
136 'MIN' => '1.17549435e-38',
137 'MAX' => '3.40282347e+38',
138 'EPSILON' => '1.19209290e-7',
139 'DENORM_MIN' => '1.40129846e-45',
141 53 =>
143 'MIN' => '2.2250738585072014e-308',
144 'MAX' => '1.7976931348623157e+308',
145 'EPSILON' => '2.2204460492503131e-16',
146 'DENORM_MIN' => '4.9406564584124654e-324',
148 64 =>
150 'MIN' => '3.36210314311209350626e-4932',
151 'MAX' => '1.18973149535723176502e+4932',
152 'EPSILON' => '1.08420217248550443401e-19',
153 'DENORM_MIN' => '3.64519953188247460253e-4951',
155 113 =>
157 'MIN' => '3.36210314311209350626267781732175260e-4932',
158 'MAX' => '1.18973149535723176508575932662800702e+4932',
159 'EPSILON' => '1.92592994438723585305597794258492732e-34',
160 'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966',
164 my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']);
165 while (@types) {
166 my ($mant_bits,$exp_bits) = @{ shift @bitsizes };
167 my ($name,$suffix) = @{ shift @types };
169 my $h = $constants{$mant_bits};
170 die "$0: weird number of mantissa bits." unless $h;
172 my $mant_dig = int (($mant_bits - 1) * log (2) / log (10));
173 my $max_exp = 1 << ($exp_bits - 1);
174 my $min_exp = 3 - $max_exp;
175 my $max_10_exp = int ($max_exp * log (2) / log (10));
176 my $min_10_exp = -int (-$min_exp * log (2) / log (10));
178 $result .= " -D__${name}_MANT_DIG__=$mant_bits";
179 $result .= " -D__${name}_DIG__=$mant_dig";
180 $result .= " -D__${name}_MIN_EXP__='($min_exp)'";
181 $result .= " -D__${name}_MAX_EXP__=$max_exp";
182 $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'";
183 $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp";
184 $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0');
185 $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');;
187 foreach my $inf (sort keys %$h) {
188 $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix;
191 return $result;
194 # -----------------------------------------------------------------------------
196 sub define_size_t {
197 my ($text) = @_;
198 # We have to undef in order to override check's internal definition.
199 return ' -U__SIZE_TYPE__ ' . &quote_arg ("-D__SIZE_TYPE__=$text");
202 # -----------------------------------------------------------------------------
204 sub add_specs {
205 my ($spec) = @_;
206 if ($spec eq 'sunos') {
207 return &add_specs ('unix') .
208 ' -D__sun__=1 -D__sun=1 -Dsun=1' .
209 ' -D__svr4__=1 -DSVR4=1' .
210 ' -D__STDC__=0' .
211 ' -D_REENTRANT' .
212 ' -D_SOLARIS_THREADS' .
213 ' -DNULL="((void *)0)"';
214 } elsif ($spec eq 'linux') {
215 return &add_specs ('unix') .
216 ' -D__linux__=1 -D__linux=1 -Dlinux=linux';
217 } elsif ($spec eq 'unix') {
218 return ' -Dunix=1 -D__unix=1 -D__unix__=1';
219 } elsif ( $spec =~ /^cygwin/) {
220 return &add_specs ('unix') .
221 ' -D__CYGWIN__=1 -D__CYGWIN32__=1' .
222 " -D'_cdecl=__attribute__((__cdecl__))'" .
223 " -D'__cdecl=__attribute__((__cdecl__))'" .
224 " -D'_stdcall=__attribute__((__stdcall__))'" .
225 " -D'__stdcall=__attribute__((__stdcall__))'" .
226 " -D'_fastcall=__attribute__((__fastcall__))'" .
227 " -D'__fastcall=__attribute__((__fastcall__))'" .
228 " -D'__declspec(x)=__attribute__((x))'";
229 } elsif ($spec eq 'i86') {
230 return (' -Di386=1 -D__i386=1 -D__i386__=1' .
231 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
232 &float_types (1, 1, 21, [24,8], [53,11], [64,15]) .
233 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
234 } elsif ($spec eq 'sparc') {
235 return (' -Dsparc=1 -D__sparc=1 -D__sparc__=1' .
236 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
237 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
238 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
239 } elsif ($spec eq 'x86_64') {
240 return (' -Dx86_64=1 -D__x86_64=1 -D__x86_64__=1' .
241 &integer_types (8, 16, 32, $m32 ? 32 : 64, 64) .
242 &float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
243 &define_size_t ($m32 ? "unsigned int" : "long unsigned int"));
244 } elsif ($spec eq 'ppc') {
245 return (' -D__powerpc__=1 -D_BIG_ENDIAN -D_STRING_ARCH_unaligned=1' .
246 &integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
247 &float_types (1, 1, 21, [24,8], [53,11], [113,15]) .
248 &define_size_t ($m64 ? "long unsigned int" : "unsigned int"));
249 } elsif ($spec eq 'host_os_specs') {
250 my $os = `uname -s`;
251 chomp $os;
252 return &add_specs (lc $os);
253 } elsif ($spec eq 'host_arch_specs') {
254 my $arch = `uname -m`;
255 chomp $arch;
256 if ($arch =~ /^(i.?86|athlon)$/i) {
257 return &add_specs ('i86');
258 } elsif ($arch =~ /^(sun4u)$/i) {
259 return &add_specs ('sparc');
260 } elsif ($arch =~ /^(x86_64)$/i) {
261 return &add_specs ('x86_64');
262 } elsif ($arch =~ /^(ppc)$/i) {
263 return &add_specs ('ppc');
265 } else {
266 die "$0: invalid specs: $spec\n";
270 # -----------------------------------------------------------------------------