tools/process-crlibm

   1 #!/usr/bin/perl -w
   2
   3 # This script processes the test cases from crlibm, see
   4 # http://lipforge.ens-lyon.fr/www/crlibm/download.html
   5
   6 use strict;
   7
   8 my $dir = $ARGV[0];
   9 die "$0: missing crlibm directory\n" unless (defined $dir) && -d $dir;
  10
  11 my @funcs =
  12     (#'acospi',
  13      'acos',
  14      #'asinpi',
  15      'asin',
  16      #'atanpi',
  17      'atan',
  18      'cosh',
  19      'cospi',
  20      'cos',
  21      'expm1',
  22      'exp',
  23      'log10',
  24      ['log1p' => 'ln1p'],
  25      'log2',
  26      ['log' => 'ln'],
  27      ['pow' => 'power', sub { $_[0] == 0 && $_[1] == 0; }],
  28      'sinh',
  29      'sinpi',
  30      'sin',
  31      #'tanpi',
  32      'tan',
  33     );
  34
  35 # -----------------------------------------------------------------------------
  36
  37 my $last_func = '';
  38 my @test_lines = ();
  39
  40 sub output_test {
  41     my ($gfunc,$expr,$res) = @_;
  42
  43     my $gfunc0 = ($gfunc eq $last_func) ? '' : $gfunc;
  44
  45     $expr = "=$expr";
  46     $res = "=$res" if $res =~ /[*^]/;
  47
  48     my $N = 1 + @test_lines;
  49     push @test_lines, "\"$gfunc0\",\"$expr\",\"$res\",\"=IF(B$N=C$N,\"\"\"\",IF(C$N=0,-LOG10(ABS(B$N)),-LOG10(ABS((B$N-C$N)/C$N))))\"";
  50
  51     $last_func = $gfunc;
  52 }
  53
  54 # -----------------------------------------------------------------------------
  55
  56 sub interpret_hex {
  57     my ($h,$l) = @_;
  58
  59     # 'd' here is native double layout.  Sorry about that.
  60     my $d = unpack ('d', pack ('VV', hex $l, hex $h));
  61     my $ad = abs ($d);
  62
  63     my $s;
  64
  65     if ($ad == 0 || ($ad > 1e-5 && $ad < 1e10)) {
  66         $s = sprintf ("%.99f", $d);
  67     } elsif ($ad < 1e-300) {
  68         my $l2 = int (log ($ad) / log (2));
  69         $s = sprintf ("%.99f*2^%d", $d * 2 ** -$l2, $l2);
  70     } else {
  71         $s =sprintf ("%.99e", $d);
  72     }
  73
  74     $s =~ s/(\.\d*[1-9])0+($|\D)/$1$2/;
  75     $s =~ s/(\d)\.0+($|\D)/$1$2/;
  76
  77     #print STDERR "[$h] [$l] [$s]\n";
  78
  79     $s = undef if $s =~/nan|inf/i;
  80
  81     return $s;
  82 }
  83
  84 # -----------------------------------------------------------------------------
  85
  86 push @test_lines, ("") x (10 + @funcs);
  87
  88 my $func_no = 0;
  89 foreach (@funcs) {
  90     my ($func,$gfunc,$filter);
  91
  92     if (ref $_) {
  93         ($func,$gfunc,$filter) = @$_;
  94     } else {
  95         $func = $gfunc = $_;
  96         $filter = undef;
  97     }
  98     print STDERR "Processing data for $gfunc...\n";
  99
 100     my $first_row = 1 + @test_lines;
 101
 102     my $fn = "$dir/tests/$func.testdata";
 103
 104     my $src;
 105     die "$0: cannot read $fn: $!\n" unless open $src, "<", $fn;
 106
 107     # Skip header than mentions function name
 108     while (<$src>) {
 109         last if /^\s*[a-z]/i;
 110     }
 111
 112     while (<$src>) {
 113         chomp;
 114         s/\s*\#.*$//;
 115         next if /^\s*$/;
 116
 117         my ($round, @d) = split (" ");
 118
 119         # Ignore everything except round-to-nearest
 120         next unless $round eq 'N';
 121
 122         die "$0: Crazy line [$_]\n" unless @d >= 4 && (@d &1) == 0;
 123
 124         my @data = ();
 125         my $bad = 0;
 126         for (my $i = 0; $i < @d; $i += 2) {
 127             my $h = $d[$i];
 128             my $l = $d[$i + 1];
 129             my $x = &interpret_hex ($h, $l);
 130             $bad = 1 unless defined $x;
 131             push @data, $x;
 132         }
 133         next if $bad;
 134
 135         my $res = pop @data;
 136
 137         next if $filter && &$filter (@data);
 138
 139         &output_test ($gfunc,
 140                       "$gfunc(".join(',', @data).")",
 141                       $res);
 142     }
 143
 144     my $last_row = @test_lines;
 145     if ($last_row >= $first_row) {
 146         my $count = $last_row - $first_row + 1;
 147         $test_lines[$func_no + 2] =
 148             "$gfunc,$count,\"=min(D${first_row}:D${last_row},99)\"";
 149         $func_no++;
 150     }
 151 }
 152 {
 153     my $r0 = 3;
 154     my $r1 = $func_no + 2;
 155     $test_lines[0] = "\"Function\",\"Number of Tests\",\"Accuracy\",\"=min(C${r0}:C${r1})\"";
 156 }
 157
 158
 159 foreach (@test_lines) {
 160     print "$_\n";
 161 }
 162
 163 # -----------------------------------------------------------------------------