view release on metacpan or  search on metacpan

src/sparse-0.4.4/cgcc  view on Meta::CPAN

	$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 someone adds "-E", don't pre-process twice.
    $do_compile = 0 if $_ eq '-E';

    $verbose = 1 if $_ eq '-v';

    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($cc -print-file-name=) if !$gcc_base_dir;
    $check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir;

    print "$check\n" if $verbose;
    if ($do_compile) {
	system ($check);
    } 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-?)?(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-nu...
    return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/;
    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',