]>
Commit | Line | Data |
---|---|---|
8847214f | 1 | #!/usr/bin/perl -w |
568035b7 | 2 | # Copyright (C) 1999-2013 Free Software Foundation, Inc. |
8847214f UD |
3 | # This file is part of the GNU C Library. |
4 | # Contributed by Andreas Jaeger <aj@suse.de>, 1999. | |
5 | ||
6 | # The GNU C Library is free software; you can redistribute it and/or | |
41bdb6e2 AJ |
7 | # modify it under the terms of the GNU Lesser General Public |
8 | # License as published by the Free Software Foundation; either | |
9 | # version 2.1 of the License, or (at your option) any later version. | |
8847214f UD |
10 | |
11 | # The GNU C Library is distributed in the hope that it will be useful, | |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
41bdb6e2 | 14 | # Lesser General Public License for more details. |
8847214f | 15 | |
41bdb6e2 | 16 | # You should have received a copy of the GNU Lesser General Public |
59ba27a6 PE |
17 | # License along with the GNU C Library; if not, see |
18 | # <http://www.gnu.org/licenses/>. | |
8847214f UD |
19 | |
20 | # This file needs to be tidied up | |
21 | # Note that functions and tests share the same namespace. | |
22 | ||
6815fabc | 23 | # Information about tests are stored in: %results |
a9b5d2ee UD |
24 | # $results{$test}{"kind"} is either "fct" or "test" and flags whether this |
25 | # is a maximal error of a function or a single test. | |
6815fabc UD |
26 | # $results{$test}{"type"} is the result type, e.g. normal or complex. |
27 | # $results{$test}{"has_ulps"} is set if deltas exist. | |
6815fabc UD |
28 | # In the following description $type and $float are: |
29 | # - $type is either "normal", "real" (for the real part of a complex number) | |
30 | # or "imag" (for the imaginary part # of a complex number). | |
31 | # - $float is either of float, ifloat, double, idouble, ldouble, ildouble; | |
32 | # It represents the underlying floating point type (float, double or long | |
33 | # double) and if inline functions (the leading i stands for inline) | |
34 | # are used. | |
6815fabc UD |
35 | # $results{$test}{$type}{"ulp"}{$float} is defined and has a delta as value |
36 | ||
37 | ||
8847214f UD |
38 | use Getopt::Std; |
39 | ||
40 | use strict; | |
41 | ||
42 | use vars qw ($input $output); | |
6815fabc | 43 | use vars qw (%results); |
8847214f UD |
44 | use vars qw (@tests @functions); |
45 | use vars qw ($count); | |
6815fabc | 46 | use vars qw (%beautify @all_floats); |
8847214f UD |
47 | use vars qw ($output_dir $ulps_file); |
48 | ||
6815fabc | 49 | # all_floats is sorted and contains all recognised float types |
3a8e65a0 | 50 | @all_floats = ('double', 'float', 'idouble', |
6815fabc UD |
51 | 'ifloat', 'ildouble', 'ldouble'); |
52 | ||
fe559c5e | 53 | %beautify = |
8847214f UD |
54 | ( "minus_zero" => "-0", |
55 | "plus_zero" => "+0", | |
56 | "minus_infty" => "-inf", | |
57 | "plus_infty" => "inf", | |
67e971f1 | 58 | "qnan_value" => "qNaN", |
8847214f UD |
59 | "M_El" => "e", |
60 | "M_E2l" => "e^2", | |
61 | "M_E3l" => "e^3", | |
62 | "M_LOG10El", "log10(e)", | |
63 | "M_PIl" => "pi", | |
64 | "M_PI_34l" => "3/4 pi", | |
65 | "M_PI_2l" => "pi/2", | |
66 | "M_PI_4l" => "pi/4", | |
67 | "M_PI_6l" => "pi/6", | |
68 | "M_PI_34_LOG10El" => "3/4 pi*log10(e)", | |
69 | "M_PI_LOG10El" => "pi*log10(e)", | |
70 | "M_PI2_LOG10El" => "pi/2*log10(e)", | |
71 | "M_PI4_LOG10El" => "pi/4*log10(e)", | |
72 | "M_LOG_SQRT_PIl" => "log(sqrt(pi))", | |
73 | "M_LOG_2_SQRT_PIl" => "log(2*sqrt(pi))", | |
74 | "M_2_SQRT_PIl" => "2 sqrt (pi)", | |
75 | "M_SQRT_PIl" => "sqrt (pi)", | |
8847214f UD |
76 | ); |
77 | ||
78 | ||
79 | # get Options | |
80 | # Options: | |
81 | # u: ulps-file | |
82 | # h: help | |
83 | # o: output-directory | |
84 | # n: generate new ulps file | |
85 | use vars qw($opt_u $opt_h $opt_o $opt_n); | |
86 | getopts('u:o:nh'); | |
87 | ||
88 | $ulps_file = 'libm-test-ulps'; | |
89 | $output_dir = ''; | |
90 | ||
91 | if ($opt_h) { | |
f30e0cd3 | 92 | print "Usage: gen-libm-test.pl [OPTIONS]\n"; |
8847214f UD |
93 | print " -h print this help, then exit\n"; |
94 | print " -o DIR directory where generated files will be placed\n"; | |
a9b5d2ee | 95 | print " -n only generate sorted file NewUlps from libm-test-ulps\n"; |
8847214f UD |
96 | print " -u FILE input file with ulps\n"; |
97 | exit 0; | |
98 | } | |
99 | ||
100 | $ulps_file = $opt_u if ($opt_u); | |
101 | $output_dir = $opt_o if ($opt_o); | |
102 | ||
103 | $input = "libm-test.inc"; | |
104 | $output = "${output_dir}libm-test.c"; | |
105 | ||
106 | $count = 0; | |
107 | ||
108 | &parse_ulps ($ulps_file); | |
a9b5d2ee UD |
109 | &generate_testfile ($input, $output) unless ($opt_n); |
110 | &output_ulps ("${output_dir}libm-test-ulps.h", $ulps_file) unless ($opt_n); | |
8847214f UD |
111 | &print_ulps_file ("${output_dir}NewUlps") if ($opt_n); |
112 | ||
113 | # Return a nicer representation | |
114 | sub beautify { | |
115 | my ($arg) = @_; | |
116 | my ($tmp); | |
117 | ||
118 | if (exists $beautify{$arg}) { | |
119 | return $beautify{$arg}; | |
120 | } | |
121 | if ($arg =~ /^-/) { | |
122 | $tmp = $arg; | |
123 | $tmp =~ s/^-//; | |
124 | if (exists $beautify{$tmp}) { | |
125 | return '-' . $beautify{$tmp}; | |
126 | } | |
127 | } | |
128 | if ($arg =~ /[0-9]L$/) { | |
129 | $arg =~ s/L$//; | |
130 | } | |
131 | return $arg; | |
132 | } | |
133 | ||
134 | # Return a nicer representation of a complex number | |
135 | sub build_complex_beautify { | |
136 | my ($r, $i) = @_; | |
137 | my ($str1, $str2); | |
138 | ||
139 | $str1 = &beautify ($r); | |
140 | $str2 = &beautify ($i); | |
141 | if ($str2 =~ /^-/) { | |
142 | $str2 =~ s/^-//; | |
143 | $str1 .= ' - ' . $str2; | |
144 | } else { | |
145 | $str1 .= ' + ' . $str2; | |
146 | } | |
147 | $str1 .= ' i'; | |
148 | return $str1; | |
149 | } | |
150 | ||
151 | # Return name of a variable | |
152 | sub get_variable { | |
153 | my ($number) = @_; | |
154 | ||
fe559c5e UD |
155 | return "x" if ($number == 1); |
156 | return "y" if ($number == 2); | |
8847214f UD |
157 | return "z" if ($number == 3); |
158 | # return x1,x2,... | |
159 | $number =-3; | |
160 | return "x$number"; | |
161 | } | |
162 | ||
163 | # Add a new test to internal data structures and fill in the | |
b7dab1e4 | 164 | # ulps and exception information for the C line. |
8847214f | 165 | sub new_test { |
f44bf14a | 166 | my ($test, $exception, $show_exception) = @_; |
8847214f UD |
167 | my $rest; |
168 | ||
b7dab1e4 | 169 | # Add ulp. |
6815fabc | 170 | if (exists $results{$test}{'has_ulps'}) { |
8847214f UD |
171 | $rest = ", DELTA$count"; |
172 | } else { | |
173 | $rest = ', 0'; | |
174 | } | |
f44bf14a JM |
175 | if ($show_exception) { |
176 | if (defined $exception) { | |
177 | $rest .= ", $exception"; | |
178 | } else { | |
179 | $rest .= ', 0'; | |
180 | } | |
8847214f | 181 | } |
8847214f UD |
182 | # We must increment here to keep @tests and count in sync |
183 | push @tests, $test; | |
184 | ++$count; | |
185 | return $rest; | |
186 | } | |
187 | ||
51df539d JM |
188 | # Adjust an argument or expected value for use in a constant |
189 | # initializer. | |
190 | sub adjust_arg { | |
191 | my ($arg, $in_func) = @_; | |
192 | if (!$in_func) { | |
193 | $arg =~ s/(plus_zero|minus_zero|plus_infty|minus_infty|qnan_value | |
194 | |max_value|min_value|min_subnorm_value)/\U$1\E_INIT/xg; | |
195 | } | |
196 | return $arg; | |
197 | } | |
198 | ||
8847214f UD |
199 | # Treat some functions especially. |
200 | # Currently only sincos needs extra treatment. | |
201 | sub special_functions { | |
51df539d | 202 | my ($file, $in_func, $args) = @_; |
8847214f UD |
203 | my (@args, $str, $test, $cline); |
204 | ||
205 | @args = split /,\s*/, $args; | |
fe559c5e | 206 | |
8847214f UD |
207 | unless ($args[0] =~ /sincos/) { |
208 | die ("Don't know how to handle $args[0] extra."); | |
209 | } | |
51df539d JM |
210 | if ($in_func) { |
211 | $cline = " RUN_TEST_sincos (" . adjust_arg ($args[1], $in_func); | |
212 | } else { | |
213 | $cline = " { " . adjust_arg ($args[1], $in_func); | |
214 | } | |
8847214f UD |
215 | |
216 | $str = 'sincos (' . &beautify ($args[1]) . ', &sin_res, &cos_res)'; | |
217 | # handle sin | |
218 | $test = $str . ' puts ' . &beautify ($args[2]) . ' in sin_res'; | |
8847214f | 219 | |
51df539d JM |
220 | my ($sin_res_var) = ($in_func ? ", sin_res" : ""); |
221 | $cline .= ", \"$test\"$sin_res_var, " . adjust_arg ($args[2], $in_func); | |
f44bf14a | 222 | $cline .= &new_test ($test, $args[4], 0); |
fe559c5e | 223 | |
8847214f UD |
224 | # handle cos |
225 | $test = $str . ' puts ' . &beautify ($args[3]) . ' in cos_res'; | |
51df539d JM |
226 | my ($cos_res_var) = ($in_func ? ", cos_res" : ""); |
227 | $cline .= ", \"$test\"$cos_res_var, " . adjust_arg ($args[3], $in_func); | |
f44bf14a | 228 | $cline .= &new_test ($test, $args[4], 1); |
51df539d JM |
229 | if ($in_func) { |
230 | $cline .= ");\n"; | |
231 | } else { | |
232 | $cline .= " },\n"; | |
233 | } | |
8847214f UD |
234 | print $file $cline; |
235 | } | |
236 | ||
237 | # Parse the arguments to TEST_x_y | |
238 | sub parse_args { | |
51df539d | 239 | my ($file, $descr, $fct, $in_func, $args) = @_; |
8847214f UD |
240 | my (@args, $str, $descr_args, $descr_res, @descr); |
241 | my ($current_arg, $cline, $i); | |
f44bf14a JM |
242 | my (@special); |
243 | my ($extra_var, $call); | |
8847214f UD |
244 | |
245 | if ($descr eq 'extra') { | |
51df539d | 246 | &special_functions ($file, $in_func, $args); |
8847214f UD |
247 | return; |
248 | } | |
249 | ($descr_args, $descr_res) = split /_/,$descr, 2; | |
250 | ||
251 | @args = split /,\s*/, $args; | |
252 | ||
830fce04 | 253 | $call = "$fct ("; |
8847214f UD |
254 | |
255 | # Generate first the string that's shown to the user | |
256 | $current_arg = 1; | |
257 | $extra_var = 0; | |
258 | @descr = split //,$descr_args; | |
259 | for ($i = 0; $i <= $#descr; $i++) { | |
260 | if ($i >= 1) { | |
261 | $call .= ', '; | |
262 | } | |
263 | # FLOAT, int, long int, long long int | |
264 | if ($descr[$i] =~ /f|i|l|L/) { | |
265 | $call .= &beautify ($args[$current_arg]); | |
266 | ++$current_arg; | |
267 | next; | |
268 | } | |
269 | # &FLOAT, &int - argument is added here | |
270 | if ($descr[$i] =~ /F|I/) { | |
271 | ++$extra_var; | |
272 | $call .= '&' . &get_variable ($extra_var); | |
273 | next; | |
274 | } | |
275 | # complex | |
276 | if ($descr[$i] eq 'c') { | |
277 | $call .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); | |
278 | $current_arg += 2; | |
279 | next; | |
280 | } | |
281 | ||
282 | die ("$descr[$i] is unknown"); | |
283 | } | |
284 | $call .= ')'; | |
285 | $str = "$call == "; | |
286 | ||
fe559c5e | 287 | # Result |
8847214f UD |
288 | @descr = split //,$descr_res; |
289 | foreach (@descr) { | |
290 | if ($_ =~ /f|i|l|L/) { | |
291 | $str .= &beautify ($args[$current_arg]); | |
292 | ++$current_arg; | |
293 | } elsif ($_ eq 'c') { | |
294 | $str .= &build_complex_beautify ($args[$current_arg], $args[$current_arg+1]); | |
295 | $current_arg += 2; | |
296 | } elsif ($_ eq 'b') { | |
297 | # boolean | |
298 | $str .= ($args[$current_arg] == 0) ? "false" : "true"; | |
299 | ++$current_arg; | |
300 | } elsif ($_ eq '1') { | |
301 | ++$current_arg; | |
302 | } else { | |
303 | die ("$_ is unknown"); | |
304 | } | |
305 | } | |
306 | # consistency check | |
307 | if ($current_arg == $#args) { | |
308 | die ("wrong number of arguments") | |
f2da7793 | 309 | unless ($args[$current_arg] =~ /EXCEPTION|ERRNO|IGNORE_ZERO_INF_SIGN/); |
8847214f UD |
310 | } elsif ($current_arg < $#args) { |
311 | die ("wrong number of arguments"); | |
312 | } elsif ($current_arg > ($#args+1)) { | |
313 | die ("wrong number of arguments"); | |
314 | } | |
315 | ||
316 | ||
8847214f UD |
317 | # Put the C program line together |
318 | # Reset some variables to start again | |
319 | $current_arg = 1; | |
320 | $extra_var = 0; | |
51df539d JM |
321 | if ($in_func) { |
322 | $cline = "RUN_TEST_$descr"; | |
323 | } else { | |
324 | $cline = "{ "; | |
325 | } | |
8847214f | 326 | # Special handling for some macros: |
51df539d JM |
327 | if ($in_func && $args[0] =~ /fpclassify|isnormal|isfinite|isinf|isnan |
328 | |issignaling|signbit|isgreater|isgreaterequal|isless|islessequal | |
0e8e0c1c | 329 | |islessgreater|isunordered/x) { |
51df539d JM |
330 | $cline = "${cline}_tg"; |
331 | } | |
332 | if ($in_func) { | |
333 | $cline .= " ("; | |
334 | } | |
335 | $cline .= "\"$str\""; | |
336 | if ($in_func) { | |
337 | $cline .= ", $args[0]"; | |
8847214f UD |
338 | } |
339 | @descr = split //,$descr_args; | |
340 | for ($i=0; $i <= $#descr; $i++) { | |
8847214f UD |
341 | # FLOAT, int, long int, long long int |
342 | if ($descr[$i] =~ /f|i|l|L/) { | |
51df539d | 343 | $cline .= ", " . adjust_arg ($args[$current_arg], $in_func); |
8847214f UD |
344 | $current_arg++; |
345 | next; | |
346 | } | |
347 | # &FLOAT, &int | |
348 | if ($descr[$i] =~ /F|I/) { | |
8847214f UD |
349 | next; |
350 | } | |
351 | # complex | |
352 | if ($descr[$i] eq 'c') { | |
51df539d JM |
353 | $cline .= ", " . adjust_arg ($args[$current_arg], $in_func); |
354 | $cline .= ", " . adjust_arg ($args[$current_arg+1], $in_func); | |
8847214f UD |
355 | $current_arg += 2; |
356 | next; | |
357 | } | |
358 | } | |
f44bf14a | 359 | $cline .= ", "; |
8847214f UD |
360 | |
361 | @descr = split //,$descr_res; | |
362 | foreach (@descr) { | |
363 | if ($_ =~ /b|f|i|l|L/ ) { | |
51df539d | 364 | $cline .= adjust_arg ($args[$current_arg], $in_func); |
8847214f UD |
365 | $current_arg++; |
366 | } elsif ($_ eq 'c') { | |
51df539d JM |
367 | $cline .= adjust_arg ($args[$current_arg], $in_func); |
368 | $cline .= ", " . adjust_arg ($args[$current_arg+1], $in_func); | |
8847214f UD |
369 | $current_arg += 2; |
370 | } elsif ($_ eq '1') { | |
371 | push @special, $args[$current_arg]; | |
372 | ++$current_arg; | |
373 | } | |
374 | } | |
b7dab1e4 | 375 | # Add ulp. |
f44bf14a | 376 | $cline .= &new_test ($str, ($current_arg <= $#args) ? $args[$current_arg] : undef, 1); |
8847214f UD |
377 | |
378 | # special treatment for some functions | |
379 | if ($args[0] eq 'frexp') { | |
f44bf14a JM |
380 | if (defined $special[0]) { |
381 | my ($extra_expected) = $special[0]; | |
382 | my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); | |
383 | my ($str) = "$call sets x to $extra_expected"; | |
51df539d | 384 | my ($out_var) = ($in_func ? ", x" : ""); |
f44bf14a JM |
385 | if (!$run_extra) { |
386 | $str = ""; | |
387 | $extra_expected = "0"; | |
388 | } | |
51df539d | 389 | $cline .= ", \"$str\"$out_var, 123456789, $run_extra, $extra_expected"; |
f44bf14a JM |
390 | if ($run_extra) { |
391 | $cline .= &new_test ($str, undef, 0); | |
392 | } else { | |
393 | $cline .= ", 0"; | |
394 | } | |
8847214f UD |
395 | } |
396 | } elsif ($args[0] eq 'gamma' || $args[0] eq 'lgamma') { | |
f44bf14a JM |
397 | if (defined $special[0]) { |
398 | my ($extra_expected) = $special[0]; | |
399 | my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); | |
400 | my ($str) = "$call sets signgam to $extra_expected"; | |
51df539d | 401 | my ($out_var) = ($in_func ? ", signgam" : ""); |
f44bf14a JM |
402 | if (!$run_extra) { |
403 | $str = ""; | |
404 | $extra_expected = "0"; | |
405 | } | |
51df539d | 406 | $cline .= ", \"$str\"$out_var, 0, $run_extra, $extra_expected"; |
f44bf14a JM |
407 | if ($run_extra) { |
408 | $cline .= &new_test ($str, undef, 0); | |
409 | } else { | |
410 | $cline .= ", 0"; | |
411 | } | |
8847214f UD |
412 | } |
413 | } elsif ($args[0] eq 'modf') { | |
f44bf14a JM |
414 | if (defined $special[0]) { |
415 | my ($extra_expected) = $special[0]; | |
416 | my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); | |
417 | my ($str) = "$call sets x to $extra_expected"; | |
51df539d | 418 | my ($out_var) = ($in_func ? ", x" : ""); |
f44bf14a JM |
419 | if (!$run_extra) { |
420 | $str = ""; | |
421 | $extra_expected = "0"; | |
422 | } | |
51df539d JM |
423 | $extra_expected = adjust_arg ($extra_expected, $in_func); |
424 | $cline .= ", \"$str\"$out_var, 123.456789, $run_extra, $extra_expected"; | |
f44bf14a JM |
425 | if ($run_extra) { |
426 | $cline .= &new_test ($str, undef, 0); | |
427 | } else { | |
428 | $cline .= ", 0"; | |
429 | } | |
fe559c5e | 430 | } |
8847214f | 431 | } elsif ($args[0] eq 'remquo') { |
f44bf14a JM |
432 | if (defined $special[0]) { |
433 | my ($extra_expected) = $special[0]; | |
434 | my ($run_extra) = ($extra_expected ne "IGNORE" ? 1 : 0); | |
435 | my ($str) = "$call sets x to $extra_expected"; | |
51df539d | 436 | my ($out_var) = ($in_func ? ", x" : ""); |
f44bf14a JM |
437 | if (!$run_extra) { |
438 | $str = ""; | |
439 | $extra_expected = "0"; | |
440 | } | |
51df539d | 441 | $cline .= ", \"$str\"$out_var, 123456789, $run_extra, $extra_expected"; |
f44bf14a JM |
442 | if ($run_extra) { |
443 | $cline .= &new_test ($str, undef, 0); | |
444 | } else { | |
445 | $cline .= ", 0"; | |
446 | } | |
8847214f UD |
447 | } |
448 | } | |
51df539d JM |
449 | if ($in_func) { |
450 | print $file " $cline);\n"; | |
451 | } else { | |
452 | print $file " $cline },\n"; | |
453 | } | |
8847214f UD |
454 | } |
455 | ||
456 | # Generate libm-test.c | |
457 | sub generate_testfile { | |
458 | my ($input, $output) = @_; | |
459 | my ($lasttext); | |
51df539d | 460 | my (@args, $i, $str, $thisfct, $in_func); |
8847214f UD |
461 | |
462 | open INPUT, $input or die ("Can't open $input: $!"); | |
463 | open OUTPUT, ">$output" or die ("Can't open $output: $!"); | |
464 | ||
465 | # Replace the special macros | |
51df539d | 466 | $in_func = 0; |
8847214f UD |
467 | while (<INPUT>) { |
468 | ||
469 | # TEST_... | |
470 | if (/^\s*TEST_/) { | |
471 | my ($descr, $args); | |
472 | chop; | |
473 | ($descr, $args) = ($_ =~ /TEST_(\w+)\s*\((.*)\)/); | |
51df539d JM |
474 | &parse_args (\*OUTPUT, $descr, $thisfct, $in_func, $args); |
475 | next; | |
476 | } | |
477 | # START_DATA (function) | |
478 | if (/START_DATA/) { | |
479 | ($thisfct) = ($_ =~ /START_DATA\s*\((.*)\)/); | |
480 | $in_func = 0; | |
8847214f UD |
481 | next; |
482 | } | |
483 | # START (function) | |
484 | if (/START/) { | |
830fce04 | 485 | ($thisfct) = ($_ =~ /START\s*\((.*)\)/); |
51df539d | 486 | $in_func = 1; |
8847214f UD |
487 | print OUTPUT " init_max_error ();\n"; |
488 | next; | |
489 | } | |
51df539d JM |
490 | # END_DATA (function) |
491 | if (/END_DATA/) { | |
492 | next; | |
493 | } | |
8847214f UD |
494 | # END (function) |
495 | if (/END/) { | |
6815fabc | 496 | my ($fct, $line, $type); |
51df539d | 497 | $in_func = 0; |
6815fabc UD |
498 | if (/complex/) { |
499 | s/,\s*complex\s*//; | |
500 | $type = 'complex'; | |
501 | } else { | |
502 | $type = 'normal'; | |
503 | } | |
8847214f | 504 | ($fct) = ($_ =~ /END\s*\((.*)\)/); |
6815fabc UD |
505 | if ($type eq 'complex') { |
506 | $line = " print_complex_max_error (\"$fct\", "; | |
507 | } else { | |
508 | $line = " print_max_error (\"$fct\", "; | |
509 | } | |
510 | if (exists $results{$fct}{'has_ulps'}) { | |
8847214f UD |
511 | $line .= "DELTA$fct"; |
512 | } else { | |
513 | $line .= '0'; | |
514 | } | |
8847214f UD |
515 | $line .= ");\n"; |
516 | print OUTPUT $line; | |
517 | push @functions, $fct; | |
518 | next; | |
519 | } | |
520 | print OUTPUT; | |
521 | } | |
522 | close INPUT; | |
523 | close OUTPUT; | |
524 | } | |
525 | ||
526 | ||
527 | ||
528 | # Parse ulps file | |
529 | sub parse_ulps { | |
530 | my ($file) = @_; | |
a9b5d2ee | 531 | my ($test, $type, $float, $eps, $kind); |
8847214f | 532 | |
6815fabc UD |
533 | # $type has the following values: |
534 | # "normal": No complex variable | |
535 | # "real": Real part of complex result | |
536 | # "imag": Imaginary part of complex result | |
8847214f UD |
537 | open ULP, $file or die ("Can't open $file: $!"); |
538 | while (<ULP>) { | |
539 | chop; | |
540 | # ignore comments and empty lines | |
541 | next if /^#/; | |
542 | next if /^\s*$/; | |
543 | if (/^Test/) { | |
6815fabc UD |
544 | if (/Real part of:/) { |
545 | s/Real part of: //; | |
546 | $type = 'real'; | |
547 | } elsif (/Imaginary part of:/) { | |
548 | s/Imaginary part of: //; | |
549 | $type = 'imag'; | |
550 | } else { | |
551 | $type = 'normal'; | |
552 | } | |
8847214f UD |
553 | s/^.+\"(.*)\".*$/$1/; |
554 | $test = $_; | |
a9b5d2ee | 555 | $kind = 'test'; |
8847214f UD |
556 | next; |
557 | } | |
6815fabc | 558 | if (/^Function: /) { |
03965c71 | 559 | if (/Real part of/) { |
6815fabc UD |
560 | s/Real part of //; |
561 | $type = 'real'; | |
562 | } elsif (/Imaginary part of/) { | |
563 | s/Imaginary part of //; | |
564 | $type = 'imag'; | |
565 | } else { | |
566 | $type = 'normal'; | |
567 | } | |
568 | ($test) = ($_ =~ /^Function:\s*\"([a-zA-Z0-9_]+)\"/); | |
a9b5d2ee | 569 | $kind = 'fct'; |
8847214f UD |
570 | next; |
571 | } | |
572 | if (/^i?(float|double|ldouble):/) { | |
6815fabc | 573 | ($float, $eps) = split /\s*:\s*/,$_,2; |
3a8e65a0 | 574 | |
b7dab1e4 | 575 | if ($eps eq "0") { |
3a8e65a0 UD |
576 | # ignore |
577 | next; | |
8847214f | 578 | } else { |
6815fabc UD |
579 | $results{$test}{$type}{'ulp'}{$float} = $eps; |
580 | $results{$test}{'has_ulps'} = 1; | |
8847214f | 581 | } |
3a8e65a0 UD |
582 | if ($type =~ /^real|imag$/) { |
583 | $results{$test}{'type'} = 'complex'; | |
584 | } elsif ($type eq 'normal') { | |
585 | $results{$test}{'type'} = 'normal'; | |
586 | } | |
a9b5d2ee | 587 | $results{$test}{'kind'} = $kind; |
8847214f UD |
588 | next; |
589 | } | |
590 | print "Skipping unknown entry: `$_'\n"; | |
591 | } | |
592 | close ULP; | |
593 | } | |
594 | ||
8847214f UD |
595 | |
596 | # Clean up a floating point number | |
597 | sub clean_up_number { | |
598 | my ($number) = @_; | |
fe559c5e | 599 | |
f99ed760 UD |
600 | # Remove trailing zeros after the decimal point |
601 | if ($number =~ /\./) { | |
602 | $number =~ s/0+$//; | |
603 | $number =~ s/\.$//; | |
604 | } | |
8847214f UD |
605 | return $number; |
606 | } | |
607 | ||
608 | # Output a file which can be read in as ulps file. | |
609 | sub print_ulps_file { | |
610 | my ($file) = @_; | |
6815fabc | 611 | my ($test, $type, $float, $eps, $fct, $last_fct); |
8847214f UD |
612 | |
613 | $last_fct = ''; | |
614 | open NEWULP, ">$file" or die ("Can't open $file: $!"); | |
615 | print NEWULP "# Begin of automatic generation\n"; | |
a9b5d2ee UD |
616 | # first the function calls |
617 | foreach $test (sort keys %results) { | |
618 | next if ($results{$test}{'kind'} ne 'test'); | |
6815fabc UD |
619 | foreach $type ('real', 'imag', 'normal') { |
620 | if (exists $results{$test}{$type}) { | |
621 | if (defined $results{$test}) { | |
622 | ($fct) = ($test =~ /^(\w+)\s/); | |
623 | if ($fct ne $last_fct) { | |
624 | $last_fct = $fct; | |
625 | print NEWULP "\n# $fct\n"; | |
626 | } | |
627 | } | |
628 | if ($type eq 'normal') { | |
629 | print NEWULP "Test \"$test\":\n"; | |
630 | } elsif ($type eq 'real') { | |
631 | print NEWULP "Test \"Real part of: $test\":\n"; | |
632 | } elsif ($type eq 'imag') { | |
633 | print NEWULP "Test \"Imaginary part of: $test\":\n"; | |
634 | } | |
635 | foreach $float (@all_floats) { | |
636 | if (exists $results{$test}{$type}{'ulp'}{$float}) { | |
3a8e65a0 UD |
637 | print NEWULP "$float: ", |
638 | &clean_up_number ($results{$test}{$type}{'ulp'}{$float}), | |
6815fabc UD |
639 | "\n"; |
640 | } | |
6815fabc | 641 | } |
8847214f UD |
642 | } |
643 | } | |
644 | } | |
645 | print NEWULP "\n# Maximal error of functions:\n"; | |
646 | ||
a9b5d2ee UD |
647 | foreach $fct (sort keys %results) { |
648 | next if ($results{$fct}{'kind'} ne 'fct'); | |
6815fabc UD |
649 | foreach $type ('real', 'imag', 'normal') { |
650 | if (exists $results{$fct}{$type}) { | |
651 | if ($type eq 'normal') { | |
652 | print NEWULP "Function: \"$fct\":\n"; | |
653 | } elsif ($type eq 'real') { | |
654 | print NEWULP "Function: Real part of \"$fct\":\n"; | |
655 | } elsif ($type eq 'imag') { | |
656 | print NEWULP "Function: Imaginary part of \"$fct\":\n"; | |
657 | } | |
658 | foreach $float (@all_floats) { | |
659 | if (exists $results{$fct}{$type}{'ulp'}{$float}) { | |
3a8e65a0 UD |
660 | print NEWULP "$float: ", |
661 | &clean_up_number ($results{$fct}{$type}{'ulp'}{$float}), | |
6815fabc UD |
662 | "\n"; |
663 | } | |
6815fabc UD |
664 | } |
665 | print NEWULP "\n"; | |
8847214f | 666 | } |
8847214f UD |
667 | } |
668 | } | |
669 | print NEWULP "# end of automatic generation\n"; | |
670 | close NEWULP; | |
671 | } | |
672 | ||
673 | sub get_ulps { | |
6815fabc UD |
674 | my ($test, $type, $float) = @_; |
675 | ||
676 | if ($type eq 'complex') { | |
677 | my ($res); | |
678 | # Return 0 instead of BUILD_COMPLEX (0,0) | |
679 | if (!exists $results{$test}{'real'}{'ulp'}{$float} && | |
680 | !exists $results{$test}{'imag'}{'ulp'}{$float}) { | |
681 | return "0"; | |
682 | } | |
683 | $res = 'BUILD_COMPLEX ('; | |
3a8e65a0 | 684 | $res .= (exists $results{$test}{'real'}{'ulp'}{$float} |
6815fabc UD |
685 | ? $results{$test}{'real'}{'ulp'}{$float} : "0"); |
686 | $res .= ', '; | |
687 | $res .= (exists $results{$test}{'imag'}{'ulp'}{$float} | |
688 | ? $results{$test}{'imag'}{'ulp'}{$float} : "0"); | |
689 | $res .= ')'; | |
690 | return $res; | |
691 | } | |
692 | return (exists $results{$test}{'normal'}{'ulp'}{$float} | |
693 | ? $results{$test}{'normal'}{'ulp'}{$float} : "0"); | |
8847214f UD |
694 | } |
695 | ||
8847214f UD |
696 | # Output the defines for a single test |
697 | sub output_test { | |
698 | my ($file, $test, $name) = @_; | |
699 | my ($ldouble, $double, $float, $ildouble, $idouble, $ifloat); | |
6815fabc | 700 | my ($type); |
8847214f | 701 | |
b7dab1e4 | 702 | # Do we have ulps? |
6815fabc UD |
703 | if (!exists $results{$test}{'type'}) { |
704 | return; | |
705 | } | |
706 | $type = $results{$test}{'type'}; | |
707 | if (exists $results{$test}{'has_ulps'}) { | |
708 | # XXX use all_floats (change order!) | |
709 | $ldouble = &get_ulps ($test, $type, "ldouble"); | |
710 | $double = &get_ulps ($test, $type, "double"); | |
711 | $float = &get_ulps ($test, $type, "float"); | |
712 | $ildouble = &get_ulps ($test, $type, "ildouble"); | |
713 | $idouble = &get_ulps ($test, $type, "idouble"); | |
714 | $ifloat = &get_ulps ($test, $type, "ifloat"); | |
8847214f UD |
715 | print $file "#define DELTA$name CHOOSE($ldouble, $double, $float, $ildouble, $idouble, $ifloat)\t/* $test */\n"; |
716 | } | |
8847214f UD |
717 | } |
718 | ||
719 | # Print include file | |
720 | sub output_ulps { | |
fe559c5e | 721 | my ($file, $ulps_filename) = @_; |
8847214f UD |
722 | my ($i, $fct); |
723 | ||
724 | open ULP, ">$file" or die ("Can't open $file: $!"); | |
725 | ||
fe559c5e UD |
726 | print ULP "/* This file is automatically generated\n"; |
727 | print ULP " from $ulps_filename with gen-libm-test.pl.\n"; | |
8847214f UD |
728 | print ULP " Don't change it - change instead the master files. */\n\n"; |
729 | ||
fe559c5e | 730 | print ULP "\n/* Maximal error of functions. */\n"; |
8847214f UD |
731 | foreach $fct (@functions) { |
732 | output_test (\*ULP, $fct, $fct); | |
733 | } | |
734 | ||
fe559c5e | 735 | print ULP "\n/* Error of single function calls. */\n"; |
8847214f UD |
736 | for ($i = 0; $i < $count; $i++) { |
737 | output_test (\*ULP, $tests[$i], $i); | |
738 | } | |
739 | close ULP; | |
740 | } |