Skip to content

Commit

Permalink
Configure probes for format, sizes, ranges and digits
Browse files Browse the repository at this point in the history 
Probe FLOATVAL_FMT/floatvalfmt with float round-trip precision tests.
Found that long double and __float128 on intel are
stable only with %17Lg. I.e. 17 digits precision in number-string round
trips. Do the precision test for all float types.

Also test for the cpp defines of ranges and DBL|FLT_DIG
(precision digits).

New config hash value for floatvaldig, the number of compiler
precision digits, which be different to the tested floatvalfmt.

Improved HAS_FLOAT128 detection.

Use HAS_INT64 instead of HAS_LONGLONG for bswap64.
  • Loading branch information
Reini Urban committed Sep 12, 2012
1 parent 4afbef5 commit d92e691
Show file tree
Hide file tree
Showing 5 changed files with 149 additions and 36 deletions.
77 changes: 58 additions & 19 deletions config/auto/format.pm
View file
Expand Up @@ -61,12 +61,15 @@ sub _set_intvalfmt {

sub _set_floatvalfmt_nvsize {
my $conf = shift;
my ( $nv, $numvalsize, $cpuarch ) =
$conf->data->get(qw(nv numvalsize cpuarch));
my ( $nv, $numvalsize, $cpuarch, $floatvaldig ) =
$conf->data->get(qw(nv numvalsize cpuarch floatvaldig));
my ( $nvformat, $nvsize, $floattype );
$nvsize = $numvalsize;

my $fltdig = _get_floatvaldigits($conf, $floatvaldig)
if $floatvaldig;
if ( $nv eq "double" ) {
$nvformat = "%.15g";
$nvformat = sprintf("%%.%dg", $fltdig ? $fltdig : 15);
$floattype = 'FLOATTYPE_8';
}
elsif ( $nv eq "long double" ) {
Expand All @@ -76,25 +79,25 @@ sub _set_floatvalfmt_nvsize {
# TT #308 same values as in imcc
if ($nvsize == 8) {
$floattype = 'FLOATTYPE_8';
$nvformat = "%.16" . $spri;
$nvformat = sprintf("%%.%dg", $fltdig ? $fltdig : 16);
}
elsif ($nvsize == 12) {
$floattype = 'FLOATTYPE_10';
$nvformat = "%.18Lg"; # i386 only
$floattype = 'FLOATTYPE_10'; # i386 only
$nvformat = sprintf("%%.%dLg", $fltdig ? $fltdig : 18);
}
elsif ($nvsize == 16) {
$nvformat = "%.41Lg";
$nvformat = sprintf("%%.%dLg", $fltdig ? $fltdig : 41);
if ($cpuarch =~ /^i386|amd64|ia64$/) {
$floattype = 'FLOATTYPE_10';
$nvformat = "%.18Lg";
$nvformat = "%.18Lg" unless $fltdig;
}
elsif ($cpuarch eq 'mips') {
# quadmath with special NaN
$floattype = 'FLOATTYPE_16MIPS';
}
elsif ($cpuarch eq 'ppc') {
# double-double https://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man3/float.3.html
$nvformat = "%.31Lg";
$nvformat = "%.31Lg" unless $fltdig;
$floattype = 'FLOATTYPE_16PPC';
}
elsif ($cpuarch =~ /^s390|sparc/) {
Expand All @@ -117,13 +120,14 @@ sub _set_floatvalfmt_nvsize {
$nvformat = "%Qg";
}
else {
$nvformat = "%.41Lg";
$nvformat = sprintf("%%.%dLg", $fltdig ? $fltdig : 41);
}
$floattype = 'FLOATTYPE_16';
}
elsif ( $nv eq "float" ) {
$nvsize = 4;
$nvformat = "%.7g"; # http://www.keil.com/support/docs/2191.htm
# http://www.keil.com/support/docs/2191.htm
$nvformat = sprintf("%%.%dg", $fltdig ? $fltdig : 7);
$floattype = 'FLOATTYPE_4';
}
else {
Expand All @@ -132,15 +136,14 @@ sub _set_floatvalfmt_nvsize {

# For a series of random numbers test the nvformat precision, and decrease it.
# 4: 7 digits, 8: 15, 10: 18, 16ppc: 31, 16: 41
LOOP:
my @TEST = (-2.5, -4.003052, -10.48576);
my @TEST = (-2.5, -4.003052, -10.48576, 1.0/3.0 );
push @TEST, (-4.0030526, 4.398046511104) if $nvsize > 4;
push @TEST, (-104.398046517704) if $nvsize >= 16;
for my $num (@TEST) {
if (!_test_format($conf, $nvformat, $num)) {
$nvformat = _decrease_nvformat_precision($conf, $nvformat);
$conf->debug("nvformat: $nvformat");
redo LOOP;
$conf->debug("nvformat reduced: $nvformat\n");
redo;
}
}

Expand All @@ -153,31 +156,67 @@ sub _set_floatvalfmt_nvsize {

sub _decrease_nvformat_precision {
my ($conf, $nvformat) = @_;
my ($prefix, $num, $suff) = $nvformat =~ m/^(%\.?)(\d+)(.+)$/;
my ($prefix, $num, $suff) = $nvformat =~ m/^(%\.?)([Q\d]+)(.+)$/;
$num = 41 if $num eq 'Q';
# require at least some sort of precision
if ($num < 5) {
if ($num < 6) {
my ( $nv, $numvalsize, $cpuarch ) =
$conf->data->get(qw(nv numvalsize cpuarch));
die "Unable to find stable rount-trip numeric precision\n"
die "\nConfigure.pl: Unable to find stable round-trip numeric precision\n"
. "for $nv, size $numvalsize on $cpuarch. Please choose another --floatval\n";
}
return sprintf("%s%d%s", $prefix, $num-1, $suff);
}

sub _rounded_numeq {
my ($conf, $n1, $n2, $prec) = @_;
return 1 if $n1 == $n2;
if (length("$n1") > 3) {
if (length("$n1") >= 7) {
$n1 = sprintf("%.$prec"."g", $n1);
}
if (length("$n2") >= 7) {
$n2 = sprintf("%.$prec"."g", $n2);
}
$n1 = substr("$n1", 0, $prec-1);
$n2 = substr("$n2", 0, $prec-1);
$conf->debug(" nvformat:\n \"$n1\" == \n \"$n2\" ($prec digits)\n");
return $n1 == $n2;
}
else {
$conf->debug(" nvformat: \n $n1 == \n $n2 ($prec digits)\n");
return $n1 == $n2;
}
}

sub _test_format {
my ($conf, $nvformat, $number) = @_;

my $num = $number;
$num .= "L" if $nvformat =~ /L/;
$num .= "Q" if $nvformat =~ /Q/;
my ($prefix, $prec, $suff) = $nvformat =~ m/^(%\.?)([Q\d]+)(.+)$/;
$prec = 41 if $prec eq 'Q';
$conf->data->set( TEMP_nvformat => $nvformat,
TEMP_number => $num);
$conf->cc_gen('config/auto/format/test_c.in');
eval { $conf->cc_build() };
my $ret = $@ ? 0 : eval $conf->cc_run();
$conf->cc_clean();
return _rounded_numeq($conf, $ret, $number, $prec);
}

sub _get_floatvaldigits {
my ($conf, $floatvaldig) = @_;

$conf->data->set( TEMP_nvformat => "%u",
TEMP_number => $floatvaldig);
$conf->cc_gen('config/auto/format/test_c.in');
eval { $conf->cc_build() };
my $ret = $@ ? 0 : eval $conf->cc_run();
$conf->cc_clean();

return $ret == $number;
return $ret;
}

1;
Expand Down
2 changes: 2 additions & 0 deletions config/auto/format/test_c.in
View file
Expand Up @@ -6,6 +6,8 @@ Probe for proper printf number format round trips

#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <float.h>

int
main(int argc, char **argv)
Expand Down
91 changes: 77 additions & 14 deletions config/auto/sizes.pm
View file
Expand Up @@ -52,7 +52,14 @@ sub runstep {
my $sizes = _get_sizes($conf, values %types, @extra_ints);

$conf->data->set( HAS_LONGLONG => $sizes->{'long long'} ? 1 : 0 );
$conf->data->set( HAS_FLOAT128 => $sizes->{'__float128'} ? 1 : 0 );
my $cpuarch = $conf->data->get('cpuarch');
$conf->data->set( HAS_FLOAT128 => $sizes->{'__float128'}
? 1 # either GNU quadmath
# or native CPU. amd64 NOT
: ($sizes->{'long double'} == 16
&& $cpuarch =~ /^s390|sparc/
? 1 : 0)
);

_handle_ptrcast(
$conf, \%types, $sizes, [ @std_ints, @extra_ints ]);
Expand All @@ -63,6 +70,7 @@ sub runstep {

_set_intval_range($conf);
_set_floatval_range($conf);
_set_floatval_digits($conf);

# not as portable as possible, but should cover common architectures
# extend list of types as necessary
Expand All @@ -77,7 +85,6 @@ sub runstep {

_set_huge($conf, $sizes, 'int',
[ reverse(@std_ints), reverse(@extra_ints), $types{intval} ] );

_set_huge($conf, $sizes, 'float',
[ reverse(@std_floats), $types{numval} ] );

Expand All @@ -86,12 +93,31 @@ sub runstep {

#################### INTERNAL SUBROUTINES ####################

sub test_size {
sub _test_size {
my ($conf, $type) = @_;

$conf->data->set( TEMP_type => $type );
$conf->data->set(
TEMP_type => $type, TEMP_define => 'xx',
TEMP_include => '');
$conf->cc_gen('config/auto/sizes/test_c.in');
eval { $conf->cc_build() };
eval { $conf->cc_build('-DWANT_SIZE') };
my $ret = $@ ? 0 : eval $conf->cc_run();
$conf->cc_clean();

return $ret;
}

sub _test_define {
my ($conf, $define) = @_;

$conf->data->set(
TEMP_define => $define,
TEMP_type => '',
TEMP_include =>
$define =~ /^FLT128/ ? "# include <quadmath.h>" : "",
);
$conf->cc_gen('config/auto/sizes/test_c.in');
eval { $conf->cc_build('-DWANT_DEFINE') };
my $ret = $@ ? 0 : eval $conf->cc_run();
$conf->cc_clean();

Expand All @@ -102,7 +128,7 @@ sub _get_sizes {
my $conf = shift;
my %sizes = map { $_ => 0 } @_;
for my $size (keys %sizes) {
$sizes{$size} = test_size($conf, $size);
$sizes{$size} = _test_size($conf, $size);
}
return \%sizes;
}
Expand Down Expand Up @@ -183,28 +209,31 @@ sub _set_huge {

sub _set_intval_range {
my $conf = shift;
my $ivmin;
my $ivmax;
my ($ivmin, $ivmax, $ivfmt);
my $iv = $conf->data->get('iv');

if ( ( $iv eq 'short' ) || ( $iv eq 'short int' ) ) {
$ivmin = 'SHRT_MIN';
$ivmax = 'SHRT_MAX';
$ivfmt = "%d";
}
elsif ( $iv eq 'int' ) {
$ivmin = 'INT_MIN';
$ivmax = 'INT_MAX';
$ivfmt = "%d";
}
elsif ( ( $iv eq 'long' ) || ( $iv eq 'long int' ) ) {
$ivmin = 'LONG_MIN';
$ivmax = 'LONG_MAX';
}
$ivfmt = "%ld";
}
elsif ( ( $iv eq 'long long' ) || ( $iv eq 'long long int' ) ) {
# The assumption is that a compiler that have the long long type
# also provides its limit macros.
$ivmin = 'LLONG_MIN';
$ivmax = 'LLONG_MAX';
}
$ivfmt = "%lld";
}
else {
my $size = $conf->data->get('intvalsize');
my $n = 8 * $size;
Expand All @@ -221,14 +250,18 @@ two's complement representation and CHAR_BIT == 8.
END
}

if ( !_test_define($conf, $ivmin)
|| !_test_define($conf, $ivmax)) {
die "\nConfigure.pl: Invalid preprocessor define $ivmin or $ivmax\n";
}

$conf->data->set( intvalmin => $ivmin );
$conf->data->set( intvalmax => $ivmax );
}

sub _set_floatval_range {
my $conf = shift;
my $nvmin;
my $nvmax;
my ($nvmin, $nvmax);
my $nv = $conf->data->get('nv');

if ( $nv eq 'float') {
Expand All @@ -255,13 +288,43 @@ The range of representable values cannot be computed for arbitrary
floating-point types.
END
die "Configure.pl: Cannot find limits for type '$nv'\n";
die "\nConfigure.pl: Cannot find limits for type '$nv'\n";
}

if ( !_test_define($conf, $nvmin)
|| !_test_define($conf, $nvmax)) {
die "\nConfigure.pl: Invalid preprocessor define $nvmin or $nvmax\n";
}

$conf->data->set( floatvalmin => $nvmin );
$conf->data->set( floatvalmax => $nvmax );
}

sub _set_floatval_digits {
my $conf = shift;
my $nvdig;
my $nv = $conf->data->get('nv');

if ( $nv eq 'float') {
$nvdig = 'FLT_DIG';
}
elsif ( $nv eq 'double' ) {
$nvdig = 'DBL_DIG';
}
elsif ( $nv eq 'long double' ) {
$nvdig = 'LDBL_DIG';
}
elsif ( $nv eq '__float128' ) { #libquadmath
$nvdig = 'FLT128_DIG';
}

if (!_test_define($conf, $nvdig)) {
die "\nConfigure.pl: Invalid preprocessor define $nvdig\n";
}

$conf->data->set( floatvaldig => $nvdig );
}

sub _handle_ptrcast {
my ($conf, $typesref, $sizesref, $checklist) = @_;
my $intvalsize = $sizesref->{$typesref->{'intval'}};
Expand All @@ -272,7 +335,7 @@ sub _handle_ptrcast {
$conf->data->set( ptrcast => 'unsigned '.$intptr );
}
else {
die "Configure.pl: No int type of at least pointer size found.\n";
die "\nConfigure.pl: No int type of at least pointer size found.\n";
}

return if $intvalsize >= $ptrsize;
Expand Down
11 changes: 10 additions & 1 deletion config/auto/sizes/test_c.in
View file
@@ -1,16 +1,25 @@
/*
Copyright (C) 2002-2011, Parrot Foundation.

figure out some Configure settings
Figure out some Configure settings
*/

#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <limits.h>
#include <float.h>

@TEMP_include@

int
main(int argc, char **argv)
{
#ifdef WANT_SIZE
printf("%u\n", (unsigned)sizeof (@TEMP_type@));
#elif defined(WANT_DEFINE) && defined(@TEMP_define@)
printf("1\n");
#endif
return EXIT_SUCCESS;
}

Expand Down
4 changes: 2 additions & 2 deletions src/packfile/pf_items.c
View file
Expand Up @@ -2203,7 +2203,7 @@ fetch_buf_be_8(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b))
ASSERT_ARGS(fetch_buf_be_8)
#if PARROT_BIGENDIAN
memcpy(rb, b, 8);
#elif defined(HAS_LONGLONG)
#elif defined(HAS_INT64)
*(Parrot_UInt8*)rb = bswap64(*(const Parrot_UInt8*)b);
#else
SWAB_8(rb, b);
Expand All @@ -2227,7 +2227,7 @@ fetch_buf_le_8(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b))
ASSERT_ARGS(fetch_buf_le_8)
#if !PARROT_BIGENDIAN
memcpy(rb, b, 8);
#elif defined(HAS_LONGLONG)
#elif defined(HAS_INT64)
*(Parrot_UInt8*)rb = bswap64(*(const Parrot_UInt8*)b);
#else
SWAB_8(rb, b);
Expand Down

0 comments on commit d92e691

Please sign in to comment.