Mercurial > hg > xemacs-beta
annotate src/number-gmp.c @ 5555:a39cd9dc92ba
Correct a typo from Mats' merge, process.el, thank you the byte-compiler
lisp/ChangeLog addition:
2011-08-24 Aidan Kehoe <kehoea@parhasard.net>
* process.el (shell-command-on-region):
Correct typo from the merge, nnot -> not.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 24 Aug 2011 11:22:30 +0100 |
| parents | 2aa9cd456ae7 |
| children | 3192994c49ca |
| 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 | |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 1983 | 7 under the terms of the GNU General Public License as published by the |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
9 option) any later version. |
| 1983 | 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 | |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 1983 | 18 |
| 19 /* Synched up with: Not in FSF. */ | |
| 20 | |
| 21 #include <config.h> | |
| 22 #include <limits.h> | |
| 23 #include <math.h> | |
| 24 #include "lisp.h" | |
| 1995 | 25 #include "sysproc.h" /* For qxe_getpid */ |
| 1983 | 26 |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
27 static mp_exp_t float_print_min, float_print_max; |
| 1983 | 28 gmp_randstate_t random_state; |
| 29 | |
| 30 CIbyte * | |
| 31 bigfloat_to_string(mpf_t f, int base) | |
| 32 { | |
| 33 mp_exp_t expt; | |
| 34 CIbyte *str = mpf_get_str (NULL, &expt, base, 0, f); | |
| 35 const int sign = mpf_sgn (f); | |
| 36 const int neg = (sign < 0) ? 1 : 0; | |
| 37 int len = strlen (str) + 1; /* Count the null terminator */ | |
| 38 | |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
39 if (sign == 0) |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
40 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
41 XREALLOC_ARRAY (str, CIbyte, 4); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
42 strncpy (str, "0.0", 4); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
43 } |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
44 else if (float_print_min <= expt && expt <= float_print_max) |
| 1983 | 45 { |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
46 if (expt < 0) |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
47 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
48 /* 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
|
49 const int space = -expt + 2; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
50 XREALLOC_ARRAY (str, CIbyte, len + space); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
51 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
|
52 memset (&str[neg], '0', space); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
53 str[neg + 1] = '.'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
54 } |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
55 else if (len <= expt + 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 /* 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
|
58 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
|
59 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
|
60 str[expt + neg] = '.'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
61 str[expt + neg + 2] = '\0'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
62 } |
| 1983 | 63 else |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
64 { |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
65 /* 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
|
66 XREALLOC_ARRAY (str, CIbyte, len + 1); |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
67 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
|
68 str[expt + neg] = '.'; |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
69 } |
| 1983 | 70 } |
| 71 else | |
| 72 { | |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
73 /* 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
|
74 point, format identifier, and exponent */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
75 /* 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
|
76 expt--; |
|
5016
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
77 { |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
78 const int point = (len == neg + 2) ? 0 : 1; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
79 const int exponent = (expt < 0) |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
80 ? (int)(log ((double) (-expt)) / log ((double) base)) + 3 |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
81 : (int)(log ((double) expt) / log ((double) base)) + 2; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
82 const int space = point + exponent; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
83 XREALLOC_ARRAY (str, CIbyte, len + space); |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
84 if (point > 0) |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
85 { |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
86 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
|
87 str[neg + 1] = '.'; |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
88 } |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
89 sprintf (&str[len + point - 1], "E%ld", expt); |
|
2ade80e8c640
enable more warnings and fix them
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
90 } |
| 1983 | 91 } |
| 92 return str; | |
| 93 } | |
| 94 | |
| 95 /* We need the next two functions since GNU MP insists on giving us an extra | |
| 96 parameter. */ | |
| 2286 | 97 static void *gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size) |
| 1983 | 98 { |
| 99 return xrealloc (ptr, new_size); | |
| 100 } | |
| 101 | |
| 2286 | 102 static void gmp_free (void *ptr, size_t UNUSED (size)) |
| 1983 | 103 { |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4802
diff
changeset
|
104 xfree (ptr); |
| 1983 | 105 } |
| 106 | |
| 107 void | |
| 108 init_number_gmp () | |
| 109 { | |
| 2367 | 110 mp_set_memory_functions ((void *(*) (size_t)) xmalloc, gmp_realloc, |
| 111 gmp_free); | |
| 1983 | 112 |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
113 /* 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
|
114 notation. */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
115 float_print_min = -4; |
| 1983 | 116 |
|
4612
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
117 /* 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
|
118 notation. */ |
|
313c2cc696b9
Fix the broken bigfloat-to-string conversion function.
Jerry James <james@xemacs.org>
parents:
2956
diff
changeset
|
119 float_print_max = 8; |
| 1983 | 120 |
| 121 /* Prepare the bignum/bigfloat random number generator */ | |
| 122 gmp_randinit_default (random_state); | |
| 123 gmp_randseed_ui (random_state, qxe_getpid () + time (NULL)); | |
| 124 } |