Skip to content

Commit

Permalink
improve precision tests, improve cvt_num16_num8 precision
Browse files Browse the repository at this point in the history
cvt_num16_num8 still gets only 3 digits right with 4.398046511104: 4.39217962522095
  • Loading branch information
Reini Urban committed Sep 10, 2012
1 parent 89dcb29 commit fafd854
Show file tree
Hide file tree
Showing 4 changed files with 63 additions and 32 deletions.
30 changes: 18 additions & 12 deletions src/packfile/pf_items.c
Original file line number Diff line number Diff line change
Expand Up @@ -530,7 +530,7 @@ cvt_num10_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
Converts IEEE 754 16-byte long double to IEEE 754 8 byte double.
First variant ok, 2nd not ok.
First variant ok, 2nd with too low precision.
=cut
Expand All @@ -541,29 +541,26 @@ cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
{
ASSERT_ARGS(cvt_num16_num8)

if ((sizeof(FLOATVAL) == 16) && (sizeof(double) == 8)) {
if ((FLOATTYPE == FLOATTYPE_16) && (sizeof(double) == 8)) {
FLOATVAL ld;
double d;

memcpy(&ld, src, 16);
d = (double)ld; /* compiler cast */
d = (double)ld; /* native compiler cast */
memcpy(dest, &d, 8);
return;
}
else {
/* Yet untested. Need native sparc64 */
/* In work. Need __float128 or native sparc64 */
int expo, i, sign;
# ifdef __LCC__
int expo2;
# endif
# if 0
Parrot_x_force_error_exit(NULL, 1, "cvt_num16_num8: long double conversion unsupported");
# endif

/* Have only 12-byte long double, or no long double at all. Need to disect it */

/*
16-byte long double (128 bits):
16-byte quad double (128 bits):
sign 1 bit 127
exp 15 bits 126-112 16383
man 112 bits 111-0
Expand All @@ -578,15 +575,15 @@ cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
+-------+-------+-------+-------+-------+-------+--...--+-------+
1|<-----15----->|<----------------112 bits--------------------->|
<---------------------------128 bits---------------------------->
16-byte LONG DOUBLE FLOATING-POINT (Sparc 64-bit)
16-byte LONG DOUBLE FLOATING-POINT (__float128 or Sparc 64-bit)
+-------+-------+-------+-------+-------+-------+-------+-------+
|dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]|
S| E | F |
S| E | F |
+-------+-------+-------+-------+-------+-------+-------+-------+
1|<---11-->|<---------------------52 bits---------------------->|
1|<---11-- >|<--------------------52 bits---------------------->|
<----------------------------64 bits---------------------------->
8-byte DOUBLE FLOATING-POINT
8-byte DOUBLE FLOATING-POINT
*/

memset(dest, 0, 8);
Expand Down Expand Up @@ -621,6 +618,15 @@ cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
dest[7] = (expo & 0x7f00) >> 8;
if (sign)
dest[7] |= 0x80;
/* bypass if mantissa is zero, well bytes 12-5 */
if (*(Parrot_UInt8*)&src[5]) {
/* src[13] => dest[6]; => dest[0] */
for (i = 0; i < 6; ++i) {
dest[i+1] |= (i==5 ? src[13] & 0xf0 : src[i+9]) >> 4;
dest[i] |= (src[i+8] & 0xf) << 4;
}
dest[0] |= (src[7] & 0xf0) >> 4;
}
}
}

Expand Down
31 changes: 17 additions & 14 deletions t/native_pbc/Test.pm
Original file line number Diff line number Diff line change
Expand Up @@ -79,10 +79,10 @@ sub test_native_pbc {
$skip_msg = "$file has old PBC_COMPAT $pbc_bc_version. "
. "Need $id platform to generate it.";
}
if ($type eq 'number' and $cvt =~ /_16_[bl]e=>._8_/) {
# 16 -> 8 drops some mantissa bits
# $expected =~ s/1\.12589990684262e\+15/1.12589990684058e+15/;
}
#if ($type eq 'number' and $cvt =~ /_16_[bl]e=>._8_/) {
# 16 -> 8 drops some mantissa bits
# $expected =~ s/1\.12589990684262e\+15/1.12589990684058e+15/;
#}
# check if skip or todo
SKIP: {
if ( $skip->{$id} ) {
Expand Down Expand Up @@ -142,18 +142,21 @@ native pbcs on 4 different machines.
=head1 PLATFORMS
i386 32 bit opcode_t, 2 byte intval, 8 byte double (linux-gcc-ix86, freebsd-gcc, cygwin)
i386 32 bit opcode_t, 2 byte intval, 12 bit long double --floatval="long double"
x86_64 64 bit opcode_t, 4 byte intval, 8 byte double (linux-gcc-x86_64, solaris-cc-64int)
x86_64 64 bit opcode_t, 4 byte intval, 16 byte long double --floatval="long double"
i386 32 bit opcode_t, 2 byte intval, 8 byte double
x86_64 64 bit opcode_t, 4 byte intval, 8 byte double
i386 32 bit opcode_t, 2 byte intval, 80bit/12 byte long double --floatval="long double"
x86_64 64 bit opcode_t, 4 byte intval, 80bit/16 byte long double --floatval="long double"
x86_64 64 bit opcode_t, 4 byte intval, 16 byte quad double --floatval=__float128
i386 32 bit opcode_t, 4 byte intval, 4-byte single float --floatval=float
big-endian 32 bit opcode_t, 2 byte intval, 8 byte double (darwin-ppc, sparc32 or mips32)
big-endian 32 bit opcode_t, 2 byte intval, 16 byte long double --floatval="long double"
big-endian 64 bit opcode_t, 4 byte intval, 8 byte double (Sparc64, mips64, ppc64)
big-endian 64 bit opcode_t, 4 byte intval, 16 byte long double --floatval="long double"
PPC 32 bit opcode_t, 2 byte intval, 16 byte double-double --floatval="long double"
big-endian 32 bit opcode_t, 2 byte intval, 4 byte single float --floatval=float
(skipped) i386 32 bit opcode_t, 2 byte intval, 4-byte single float --floatval=float
(skipped) x86_64 64 bit opcode_t, 4 byte intval, 4-byte single float --floatval=float
(skipped) big-endian 32 bit opcode_t, 2 byte intval, 4 byte single float --floatval=float
Hard to find platforms:
big-endian 64 bit opcode_t, 4 byte intval, 8 byte double (Sparc64, mips64, ppc64)
Sparc64 big-endian 64 bit opcode_t, 4 byte intval, 16 byte quad double --floatval="long double"
=head2 Functions
Expand Down
34 changes: 28 additions & 6 deletions t/native_pbc/number.t
Original file line number Diff line number Diff line change
Expand Up @@ -87,16 +87,38 @@ my $output = << 'END_OUTPUT';
281474976710656
END_OUTPUT

# $output =~ s/\n/\$\n/g;
# TODO required precision: 7 for float, 15 for double
$output =~ s/(\.\d{1,6})\d+/$1.'\d+'/eg;
# $output =~ s/(\d{7,9})\d+/$1.'[\d\.]+'/eg;
# $output =~ s/(\d{4,5})\d+/$1.'[\d\.]+'/eg;
my $qr = qr/$output/;
sub my_precision {
my ($myprec) = $PConfig{floatvalfmt} =~ m/(\d+)/;
$myprec = '41' if !$myprec and $PConfig{floatvalfmt} =~ m/%Q/;
return $myprec;
}

sub min_precision {
my $id = shift;
my $myprec = shift;
my ($theirtype) = $id =~ m/^\d_(\d.*)_/;
# See various LDBL_DIG
my $prec = {4 => 7, 8 => 15, 10 => 18, '16ppc' => 31, 16 => 41};
my $theirprec = $prec->{$theirtype} // 7;
return $myprec < $theirprec ? $myprec : $theirprec;
}

my $myprec = my_precision;

sub test_pbc_number {
my $id = shift;
my $desc = shift;

# required precision: 7 for float, 15 for double, ...
my $out = $output;
my $minprec = min_precision($id, $myprec);
my $prec1 = $minprec - 1; # 4.398046511104
my $prec2 = $minprec - 2; # -10.48576
$out =~ s/(^-?\d{1,$minprec})\d+/$1.'\d+'/eg;
$out =~ s/(^-?\d\.\d{1,$prec1})\d+/$1.'\d+'/eg;
$out =~ s/(^-?\d\d\.\d{1,$prec2})\d+/$1.'\d+'/eg;
my $qr = qr/$out/;

test_native_pbc($id, "number", $qr, $desc, $skip, $todo);
}

Expand Down
Binary file modified t/native_pbc/number_8_16_le.pbc
Binary file not shown.

0 comments on commit fafd854

Please sign in to comment.