Mercurial > hg > xemacs-beta
annotate src/number-gmp.c @ 5315:2a7b6ddb8063
#'float: if handed a bigfloat, give the same bigfloat back.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* floatfns.c (Ffloat): If we've been handed a bigfloat here, it's
appropriate to give the same bigfloat back.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 29 Dec 2010 23:51:08 +0000 |
| parents | ba07c880114a |
| children | 2aa9cd456ae7 |
| rev | line source |
|---|---|
| 1983 | 1 /* Numeric types for XEmacs using the GNU MP library. |
| 2 Copyright (C) 2004 Jerry James. | |
| 3 | |
| 4 This file is part of XEmacs. | |
| 5 | |
| 6 XEmacs is free software; you can redistribute it and/or modify it | |
| 7 under the terms of the GNU General Public License as published by the | |
| 8 Free Software Foundation; either version 2, or (at your option) any | |
| 9 later version. | |
| 10 | |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
| 17 along with XEmacs; see the file COPYING. If not, write to | |
|
5231
ba07c880114a
Fix up FSF's Franklin Street address in many files.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5016
diff
changeset
|
18 the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, |
|
ba07c880114a
Fix up FSF's Franklin Street address in many files.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5016
diff
changeset
|
19 Boston, MA 02110-1301, USA. */ |
| 1983 | 20 |
| 21 /* Synched up with: Not in FSF. */ | |
| 22 | |
| 23 #include <config.h> | |
| 24 #include <limits.h> | |
| 25 #include <math.h> | |
| 26 #include "lisp.h" | |
| 1995 | 27 #include "sysproc.h" /* For qxe_getpid */ |
| 1983 | 28 |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
29 static mp_exp_t float_print_min, float_print_max; |
| 1983 | 30 gmp_randstate_t random_state; |
| 31 | |
| 32 CIbyte * | |
| 33 bigfloat_to_string(mpf_t f, int base) | |
| 34 { | |
| 35 mp_exp_t expt; | |
| 36 CIbyte *str = mpf_get_str (NULL, &expt, base, 0, f); | |
| 37 const int sign = mpf_sgn (f); | |
| 38 const int neg = (sign < 0) ? 1 : 0; | |
| 39 int len = strlen (str) + 1; /* Count the null terminator */ | |
| 40 | |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
41 if (sign == 0) |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
42 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
43 XREALLOC_ARRAY (str, CIbyte, 4); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
44 strncpy (str, "0.0", 4); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
45 } |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
46 else if (float_print_min <= expt && expt <= float_print_max) |
| 1983 | 47 { |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
48 if (expt < 0) |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
49 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
50 /* We need room for a radix point and leading zeroes */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
51 const int space = -expt + 2; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
52 XREALLOC_ARRAY (str, CIbyte, len + space); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
53 memmove (&str[space + neg], &str[neg], len - neg); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
54 memset (&str[neg], '0', space); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
55 str[neg + 1] = '.'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
56 } |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
57 else if (len <= expt + neg + 1) |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
58 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
59 /* We need room for a radix point and trailing zeroes */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
60 XREALLOC_ARRAY (str, CIbyte, expt + neg + 3); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
61 memset (&str[len - 1], '0', expt + neg + 3 - len); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
62 str[expt + neg] = '.'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
63 str[expt + neg + 2] = '\0'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
64 } |
| 1983 | 65 else |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
66 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
67 /* We just need room for a radix point */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
68 XREALLOC_ARRAY (str, CIbyte, len + 1); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
69 memmove (&str[expt + neg + 1], &str[expt + neg], len - (expt + neg)); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
70 str[expt + neg] = '.'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
71 } |
| 1983 | 72 } |
| 73 else | |
| 74 { | |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
75 /* Computerized scientific notation: We need room for a possible radix |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
76 point, format identifier, and exponent */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
77 /* GMP's idea of the exponent is 1 greater than scientific notation's */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
78 expt--; |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
79 { |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
80 const int point = (len == neg + 2) ? 0 : 1; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
81 const int exponent = (expt < 0) |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
82 ? (int)(log ((double) (-expt)) / log ((double) base)) + 3 |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
83 : (int)(log ((double) expt) / log ((double) base)) + 2; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
84 const int space = point + exponent; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
85 XREALLOC_ARRAY (str, CIbyte, len + space); |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
86 if (point > 0) |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
87 { |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
88 memmove (&str[neg + 2], &str[neg + 1], len - neg); |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
89 str[neg + 1] = '.'; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
90 } |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
91 sprintf (&str[len + point - 1], "E%ld", expt); |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
92 } |
| 1983 | 93 } |
| 94 return str; | |
| 95 } | |
| 96 | |
| 97 /* We need the next two functions since GNU MP insists on giving us an extra | |
| 98 parameter. */ | |
| 2286 | 99 static void *gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size) |
| 1983 | 100 { |
| 101 return xrealloc (ptr, new_size); | |
| 102 } | |
| 103 | |
| 2286 | 104 static void gmp_free (void *ptr, size_t UNUSED (size)) |
| 1983 | 105 { |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4802
diff
changeset
|
106 xfree (ptr); |
| 1983 | 107 } |
| 108 | |
| 109 void | |
| 110 init_number_gmp () | |
| 111 { | |
| 2367 | 112 mp_set_memory_functions ((void *(*) (size_t)) xmalloc, gmp_realloc, |
| 113 gmp_free); | |
| 1983 | 114 |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
115 /* Numbers with smaller exponents than this are printed in scientific |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
116 notation. */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
117 float_print_min = -4; |
| 1983 | 118 |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
119 /* Numbers with larger exponents than this are printed in scientific |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
120 notation. */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
121 float_print_max = 8; |
| 1983 | 122 |
| 123 /* Prepare the bignum/bigfloat random number generator */ | |
| 124 gmp_randinit_default (random_state); | |
| 125 gmp_randseed_ui (random_state, qxe_getpid () + time (NULL)); | |
| 126 } |