blob: e207d0180cc352bb0d0decfc2681d6f7f85fe981 [file] [log] [blame]
#!/usr/bin/perl -w
# -----------------------------------------------------------------------------
my $cc = $ENV{'REAL_CC'} || 'cc';
my $check = $ENV{'CHECK'} || 'sparse';
my $ccom = $cc;
my $m32 = 0;
my $m64 = 0;
my $has_specs = 0;
my $gendeps = 0;
my $do_check = 0;
my $do_compile = 1;
my $gcc_base_dir;
my $multiarch_dir;
my $verbose = 0;
my $nargs = 0;
while (@ARGV) {
$_ = shift(@ARGV);
if ($nargs) {
$nargs--;
goto add_option;
}
# Look for a .c file. We don't want to run the checker on .o or .so files
# in the link run.
$do_check = 1 if /^[^-].*\.c$/;
# Ditto for stdin.
$do_check = 1 if $_ eq '-';
if ($_ eq '-o') {
# Need to be checked explicitly since '-o -' is
# sometimes used and the '-' would otherwise be
# processed as an option.
die ("$0: missing argument for $_") if !@ARGV;
$nargs = 1;
}
# Ignore the extension if '-x c' is given.
if ($_ eq '-x') {
die ("$0: missing argument for $_") if !@ARGV;
die ("$0: invalid argument for $_") if $ARGV[0] ne 'c';
$do_check = 1;
$nargs = 1;
}
$m32 = 1 if /^-m32$/;
$m64 = 1 if /^-m64$/;
$gendeps = 1 if /^-M$/;
if (/^-target=(.*)$/) {
$check .= &add_specs ($1);
$has_specs = 1;
next;
}
if ($_ eq '-no-compile') {
$do_compile = 0;
next;
}
if (/^-gcc-base-dir$/) {
$gcc_base_dir = shift @ARGV;
die ("$0: missing argument for -gcc-base-dir option") if !$gcc_base_dir;
next;
}
if (/^-multiarch-dir$/) {
$multiarch_dir = shift @ARGV;
die ("$0: missing argument for -multiarch-dir option") if !$multiarch_dir;
next;
}
# If someone adds "-E", don't pre-process twice.
$do_compile = 0 if $_ eq '-E';
$verbose = 1 if $_ eq '-v';
add_option:
my $this_arg = ' ' . &quote_arg ($_);
$cc .= $this_arg unless &check_only_option ($_);
$check .= $this_arg;
}
if ($gendeps) {
$do_compile = 1;
$do_check = 0;
}
if ($do_check) {
if (!$has_specs) {
$check .= &add_specs ('host_arch_specs');
$check .= &add_specs ('host_os_specs');
}
$gcc_base_dir = qx($ccom -print-file-name=) if !$gcc_base_dir;
chomp($gcc_base_dir); # possibly remove '\n' from compiler
$check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir;
$multiarch_dir = qx($ccom -print-multiarch) if ! defined $multiarch_dir;
chomp($multiarch_dir); # possibly remove '\n' from compiler
$check .= " -multiarch-dir " . $multiarch_dir if $multiarch_dir;
print "$check\n" if $verbose;
if ($do_compile) {
system ($check) == 0 or exit 1;
} else {
exec ($check);
}
}
if ($do_compile) {
print "$cc\n" if $verbose;
exec ($cc);
}
exit 0;
# -----------------------------------------------------------------------------
# Check if an option is for "check" only.
sub check_only_option {
my ($arg) = @_;
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|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)$/;
return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/;
return 1 if $arg =~ /^-f(dump-ir|memcpy-max-count|diagnostic-prefix)(=\S*)?$/;
return 1 if $arg =~ /^-f(mem2reg|optim)(-enable|-disable|=last)?$/;
return 0;
}
# -----------------------------------------------------------------------------
# Simple arg-quoting function. Just adds backslashes when needed.
sub quote_arg {
my ($arg) = @_;
return "''" if $arg eq '';
return join ('',
map {
m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_;
} (split (//, $arg)));
}
# -----------------------------------------------------------------------------
sub integer_types {
my ($char,@dummy) = @_;
my %pow2m1 =
(8 => '127',
16 => '32767',
32 => '2147483647',
64 => '9223372036854775807',
128 => '170141183460469231731687303715884105727',
);
my @types = (['SCHAR',''], ['SHRT',''], ['INT',''], ['LONG','L'], ['LONG_LONG','LL'], ['LONG_LONG_LONG','LLL']);
my $result = " -D__CHAR_BIT__=$char";
while (@types && @_) {
my $bits = shift @_;
my ($name,$suffix) = @{ shift @types };
die "$0: weird number of bits." unless exists $pow2m1{$bits};
$result .= " -D__${name}_MAX__=" . $pow2m1{$bits} . $suffix;
}
return $result;
}
# -----------------------------------------------------------------------------
sub float_types {
my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_;
my $result = " -D__FLT_RADIX__=2";
$result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1');
$result .= " -D__DECIMAL_DIG__=$dec_dig";
my %constants =
(24 =>
{
'MIN' => '1.17549435e-38',
'MAX' => '3.40282347e+38',
'EPSILON' => '1.19209290e-7',
'DENORM_MIN' => '1.40129846e-45',
},
53 =>
{
'MIN' => '2.2250738585072014e-308',
'MAX' => '1.7976931348623157e+308',
'EPSILON' => '2.2204460492503131e-16',
'DENORM_MIN' => '4.9406564584124654e-324',
},
64 =>
{
'MIN' => '3.36210314311209350626e-4932',
'MAX' => '1.18973149535723176502e+4932',
'EPSILON' => '1.08420217248550443401e-19',
'DENORM_MIN' => '3.64519953188247460253e-4951',
},
113 =>
{
'MIN' => '3.36210314311209350626267781732175260e-4932',
'MAX' => '1.18973149535723176508575932662800702e+4932',
'EPSILON' => '1.92592994438723585305597794258492732e-34',
'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966',
},
);
my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']);
while (@types) {
my ($mant_bits,$exp_bits) = @{ shift @bitsizes };
my ($name,$suffix) = @{ shift @types };
my $h = $constants{$mant_bits};
die "$0: weird number of mantissa bits." unless $h;
my $mant_dig = int (($mant_bits - 1) * log (2) / log (10));
my $max_exp = 1 << ($exp_bits - 1);
my $min_exp = 3 - $max_exp;
my $max_10_exp = int ($max_exp * log (2) / log (10));
my $min_10_exp = -int (-$min_exp * log (2) / log (10));
$result .= " -D__${name}_MANT_DIG__=$mant_bits";
$result .= " -D__${name}_DIG__=$mant_dig";
$result .= " -D__${name}_MIN_EXP__='($min_exp)'";
$result .= " -D__${name}_MAX_EXP__=$max_exp";
$result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'";
$result .= " -D__${name}_MAX_10_EXP__=$max_10_exp";
$result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0');
$result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');;
foreach my $inf (sort keys %$h) {
$result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix;
}
}
return $result;
}
# -----------------------------------------------------------------------------
sub define_size_t {
my ($text) = @_;
# We have to undef in order to override check's internal definition.
return ' -U__SIZE_TYPE__ ' . &quote_arg ("-D__SIZE_TYPE__=$text");
}
# -----------------------------------------------------------------------------
sub add_specs {
my ($spec) = @_;
if ($spec eq 'sunos') {
return &add_specs ('unix') .
' -D__sun__=1 -D__sun=1 -Dsun=1' .
' -D__svr4__=1 -DSVR4=1' .
' -D__STDC__=0' .
' -D_REENTRANT' .
' -D_SOLARIS_THREADS' .
' -DNULL="((void *)0)"';
} elsif ($spec eq 'linux') {
return &add_specs ('unix') .
' -D__linux__=1 -D__linux=1 -Dlinux=linux';
} elsif ($spec eq 'gnu/kfreebsd') {
return &add_specs ('unix') .
' -D__FreeBSD_kernel__=1';
} elsif ($spec eq 'openbsd') {
return &add_specs ('unix') .
' -D__OpenBSD__=1';
} elsif ($spec eq 'freebsd') {
return &add_specs ('unix') .
' -D__FreeBSD__=1';
} elsif ($spec eq 'netbsd') {
return &add_specs ('unix') .
' -D__NetBSD__=1';
} elsif ($spec eq 'darwin') {
return
' -D__APPLE__=1 -D__MACH__=1';
} elsif ($spec eq 'gnu') { # Hurd
return &add_specs ('unix') . # So, GNU is Unix, uh?
' -D__GNU__=1 -D__gnu_hurd__=1 -D__MACH__=1';
} elsif ($spec eq 'unix') {
return ' -Dunix=1 -D__unix=1 -D__unix__=1';
} elsif ( $spec =~ /^cygwin/) {
return &add_specs ('unix') .
' -D__CYGWIN__=1 -D__CYGWIN32__=1' .
" -D'_cdecl=__attribute__((__cdecl__))'" .
" -D'__cdecl=__attribute__((__cdecl__))'" .
" -D'_stdcall=__attribute__((__stdcall__))'" .
" -D'__stdcall=__attribute__((__stdcall__))'" .
" -D'_fastcall=__attribute__((__fastcall__))'" .
" -D'__fastcall=__attribute__((__fastcall__))'" .
" -D'__declspec(x)=__attribute__((x))'";
} elsif ($spec eq 'i386') {
return (
&float_types (1, 1, 21, [24,8], [53,11], [64,15]));
} elsif ($spec eq 'sparc') {
return (
&integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
&float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
&define_size_t ($m64 ? "long unsigned int" : "unsigned int") .
' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4'));
} elsif ($spec eq 'sparc64') {
return (
&integer_types (8, 16, 32, 64, 64, 128) .
&float_types (1, 1, 33, [24,8], [53,11], [113,15]) .
&define_size_t ("long unsigned int") .
' -D__SIZEOF_POINTER__=8');
} elsif ($spec eq 'x86_64') {
return &float_types (1, 1, 33, [24,8], [53,11], [113,15]);
} elsif ($spec eq 'ppc') {
return (' -D_BIG_ENDIAN -D_STRING_ARCH_unaligned=1' .
&integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
&float_types (1, 1, 21, [24,8], [53,11], [113,15]) .
&define_size_t ($m64 ? "long unsigned int" : "unsigned int") .
' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4'));
} elsif ($spec eq 'ppc64') {
return (' -D_STRING_ARCH_unaligned=1 -m64' .
&float_types (1, 1, 21, [24,8], [53,11], [113,15]));
} elsif ($spec eq 'ppc64+be') {
return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1';
} elsif ($spec eq 'ppc64+le') {
return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2';
} elsif ($spec eq 's390x') {
return (' -D_BIG_ENDIAN' .
&integer_types (8, 16, 32, $m64 ? 64 : 32, 64) .
&float_types (1, 1, 36, [24,8], [53,11], [113,15]) .
&define_size_t ("long unsigned int") .
' -D__SIZEOF_POINTER__=' . ($m64 ? '8' : '4'));
} elsif ($spec eq 'arm') {
chomp (my $gccmachine = `$ccom -dumpmachine`);
my $cppsymbols = ' -m32';
if ($gccmachine eq 'arm-linux-gnueabihf') {
$cppsymbols .= ' -D__ARM_PCS_VFP=1';
}
return ($cppsymbols .
&float_types (1, 1, 36, [24,8], [53,11], [53, 11]));
} elsif ($spec eq 'aarch64') {
return (' -m64' .
&float_types (1, 1, 36, [24,8], [53,11], [113,15]));
} elsif ($spec eq 'host_os_specs') {
my $os = `uname -s`;
chomp $os;
return &add_specs (lc $os);
} elsif ($spec eq 'host_arch_specs') {
my $arch = `uname -m`;
chomp $arch;
if ($arch =~ /^(i.?86|athlon)$/i) {
return &add_specs ('i386');
} elsif ($arch =~ /^(sun4u)$/i) {
return &add_specs ('sparc');
} elsif ($arch =~ /^(x86_64)$/i) {
return &add_specs ('x86_64');
} elsif ($arch =~ /^(ppc)$/i) {
return &add_specs ('ppc');
} elsif ($arch =~ /^(ppc64)$/i) {
return &add_specs ('ppc64+be');
} elsif ($arch =~ /^(ppc64le)$/i) {
return &add_specs ('ppc64+le');
} elsif ($arch =~ /^(s390x)$/i) {
return &add_specs ('s390x');
} elsif ($arch =~ /^(sparc64)$/i) {
return &add_specs ('sparc64');
} elsif ($arch =~ /^arm(?:v[78]l)?$/i) {
return &add_specs ('arm');
} elsif ($arch =~ /^(aarch64)$/i) {
return &add_specs ('aarch64');
}
} else {
die "$0: invalid specs: $spec\n";
}
}
# -----------------------------------------------------------------------------