sparsegen/sparse/cgcc

#!/usr/bin/perl -w
# -----------------------------------------------------------------------------

use strict;
use warnings;

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 (/^-(o|MF|MT|MQ)$/) {
	# Need to be checked explicitly since otherwise
	# the argument would be processed as a
	# (non-existant) source file or 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|MM)$/;

    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|external-function-has-definition|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 1 if $arg =~ /^-msize-(long|llp64)$/;
    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 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 add_specs {
    my ($spec) = @_;
    if ($spec eq 'sunos') {
	return " --os=$spec" .
	    ' -DSVR4=1' .
	    ' -D__STDC__=0' .
	    ' -D_REENTRANT' .
	    ' -D_SOLARIS_THREADS' .
	    ' -DNULL="((void *)0)"';
    } elsif ($spec eq 'linux') {
	return " --os=$spec";
    } elsif ($spec eq 'gnu/kfreebsd') {
	return &add_specs ('unix') .
	    ' -D__FreeBSD_kernel__=1';
    } elsif ($spec eq 'openbsd') {
	return " --os=$spec";
    } elsif ($spec eq 'freebsd') {
	return " --os=$spec";
    } elsif ($spec eq 'netbsd') {
	return " --os=$spec";
    } elsif ($spec eq 'darwin') {
	return " --os=$spec";
    } 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 ' --os=cygwin';
    } elsif ($spec eq 'i386') {
	$m32 = 1;
	return (
		' --arch=i386' .
		&float_types (1, 1, 21, [24,8], [53,11], [64,15]));
    } elsif ($spec eq 'sparc') {
	return (
		' --arch=sparc' .
		&float_types (1, 1, 33, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'sparc64') {
	return (
		' --arch=sparc64' .
		&float_types (1, 1, 33, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'x86_64') {
	return (' --arch=x86_64' .
		&float_types (1, 1, 33, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'ppc') {
	return (' --arch=ppc' .
		&float_types (1, 1, 21, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'ppc64') {
	return (
		' --arch=ppc64' .
		&float_types (1, 1, 21, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'ppc64be') {
	return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1';
    } elsif ($spec eq 'ppc64le') {
	return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2';
    } elsif ($spec eq 's390x') {
	return (' -D_BIG_ENDIAN' .
		' --arch=s390x' .
		&float_types (1, 1, 36, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'riscv32') {
	return (' --arch=riscv32' .
		&float_types (1, 1, 33, [24,8], [53,11], [53,11]));
    } elsif ($spec eq 'riscv64') {
	return (' --arch=riscv64' .
		&float_types (1, 1, 33, [24,8], [53,11], [113,15]));
    } elsif ($spec eq 'arm') {
	return (' --arch=arm' .
		&float_types (1, 1, 36, [24,8], [53,11], [53, 11]));
    } elsif ($spec eq 'arm+hf') {
	return &add_specs ('arm') . ' -mfloat-abi=hard';
    } elsif ($spec eq 'aarch64') {
	return (' --arch=aarch64' .
		&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 $gccmachine;
	my $arch;

	$gccmachine = `$ccom -dumpmachine`;
	chomp $gccmachine;

	if ($gccmachine =~ '^aarch64-') {
	    return &add_specs ('aarch64');
	} elsif ($gccmachine =~ '^arm-.*eabihf$') {
	    return &add_specs ('arm+hf');
	} elsif ($gccmachine =~ '^arm-') {
	    return &add_specs ('arm');
	} elsif ($gccmachine =~ '^i[23456]86-') {
	    return &add_specs ('i386');
	} elsif ($gccmachine =~ '^(powerpc|ppc)64le-') {
	    return &add_specs ('ppc64le');
	} elsif ($gccmachine =~ '^s390x-') {
	    return &add_specs ('s390x');
	} elsif ($gccmachine eq 'x86_64-linux-gnux32') {
	    return &add_specs ('x86_64') . ' -mx32';
	} elsif ($gccmachine =~ '^x86_64-') {
	    return &add_specs ('x86_64');
	}

	# fall back to uname -m to determine the specifics.
	# Note: this is only meaningful when using natively
	#       since information about the host is used to
	#	guess characteristics of the target.

	$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 ('ppc64be');
	} elsif ($arch =~ /^(ppc64le)$/i) {
	    return &add_specs ('ppc64le');
	} 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";
    }
}

# -----------------------------------------------------------------------------