annotate src/number-gmp.c @ 2421:ab71ad6ff3dd

[xemacs-hg @ 2004-12-06 03:50:53 by ben] (none) README.packages: Document use of --package-prefix. Fix error in specifying standard package location. make-docfile.c: Use QXE_PATH_MAX. info.el: Correct doc string giving example package path. menubar-items.el: Move Prefix Rectangle command up one level. xemacs/packages.texi: Add long form of Lisp Reference Manual to links. Add links pointing to Lisp Reference Manual for more detailed package discussion. lispref/range-tables.texi: Document range-table changes. internals/internals.texi: Update history section. elhash.c, elhash.h, profile.c: Create inchash_eq() to allow direct incrementing of hash-table entry. Use in profile.c to try to reduce profiling overhead. Increase initial size of profile hash tables to reduce profiling overhead. buffer.c, device-msw.c, dialog-msw.c, dired-msw.c, editfns.c, event-msw.c, events.c, glyphs-msw.c, keymap.c, objects-msw.c, process-nt.c, syswindows.h, text.c, text.h, unexnt.c: Rename xetcs* -> qxetcs* for consistency with qxestr*. Rename ei*_c(_*) -> ei*_ascii(_*) since they work with ASCII-only strings not "C strings", whatever those are. This is the last place where "c" was incorrectly being used for "ascii". dialog-msw.c, dumper.c, event-msw.c, fileio.c, glyphs-gtk.c, glyphs-x.c, nt.c, process-nt.c, realpath.c, sysdep.c, sysfile.h, unexcw.c, unexnext.c, unexnt.c: Try to avoid differences in systems that do or do not include final null byte in PATH_MAX. Create PATH_MAX_INTERNAL and PATH_MAX_EXTERNAL and use them everywhere. Rewrite code in dumper.c to avoid use of PATH_MAX. When necessary in nt.c, use _MAX_PATH instead of MAX_PATH to be consistent with other places. text.c: Code to short-circuit when binary or Unicode was not working due to EOL wrapping. Fix this code to work when either no EOL autodetection or no CR's or LF's in the text. lisp.h, rangetab.c, rangetab.h, regex.c, search.c: Implement different types of ranges (open/closed start and end). Change default to be start-closed, end-open.
author ben
date Mon, 06 Dec 2004 03:52:23 +0000
parents ecf1ebac70d8
children ee35a8fdcfcd
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
1 /* Numeric types for XEmacs using the GNU MP library.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
2 Copyright (C) 2004 Jerry James.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
3
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
4 This file is part of XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
5
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
9 later version.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
10
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
14 for more details.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
15
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
20
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
21 /* Synched up with: Not in FSF. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
22
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
23 #include <config.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
24 #include <limits.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
25 #include <math.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
26 #include "lisp.h"
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
27 #include "sysproc.h" /* For qxe_getpid */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
28
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
29 static mpf_t float_print_min, float_print_max;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
30 gmp_randstate_t random_state;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
31
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
32 CIbyte *
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
33 bigfloat_to_string(mpf_t f, int base)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
34 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
35 mp_exp_t expt;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
36 CIbyte *str = mpf_get_str (NULL, &expt, base, 0, f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
37 const int sign = mpf_sgn (f);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
38 const int neg = (sign < 0) ? 1 : 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
39 int len = strlen (str) + 1; /* Count the null terminator */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
40
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
41 if (sign == 0 || (mpf_cmp (float_print_min, f) <= 0 &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
42 mpf_cmp (f, float_print_max) <= 0))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
43 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
44 /* Move digits down to insert a radix point */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
45 if (expt <= 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
46 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
47 /* We need room for a radix point and leading zeroes */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
48 const int space = -expt + 2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
49 XREALLOC_ARRAY (str, CIbyte, len + space);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
50 memmove (&str[space + neg], &str[neg], len - neg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
51 memset (&str[neg], '0', space);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
52 str[neg + 1] = '.';
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
53 len += space;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
54 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
55 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
56 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
57 /* We just need room for a radix point */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
58 XREALLOC_ARRAY (str, CIbyte, len + 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
59 memmove (&str[expt + neg + 1], &str[expt + neg], len - (expt + neg));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
60 str[expt + neg] = '.';
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
61 len++;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
62 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
63 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
64 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
65 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
66 /* Computerized scientific notation */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
67 /* We need room for a radix point, format identifier, and exponent */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
68 const int space = (expt < 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
69 ? (int)(log (-expt) / log (base)) + 3
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
70 : (int)(log (expt) / log (base)) + 2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
71 XREALLOC_ARRAY (str, CIbyte, len + space);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
72 memmove (&str[neg + 2], &str[neg + 1], len - neg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
73 str[len + 1] = 'l';
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
74 sprintf (&str[len + 2], "%ld", expt);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
75 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
76 return str;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
77 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
78
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
79 /* We need the next two functions since GNU MP insists on giving us an extra
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
80 parameter. */
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1995
diff changeset
81 static void *gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
82 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
83 return xrealloc (ptr, new_size);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
84 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
85
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1995
diff changeset
86 static void gmp_free (void *ptr, size_t UNUSED (size))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
87 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
88 xfree (ptr, void *);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
89 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
90
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
91 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
92 init_number_gmp ()
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
93 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
94 mp_set_memory_functions ((void *(*) (size_t)) xmalloc, gmp_realloc,
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
95 gmp_free);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
96
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
97 /* The smallest number that is printed without exponents */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
98 mpf_init_set_d (float_print_min, 0.001);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
99
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
100 /* The largest number that is printed without exponents */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
101 mpf_init_set_ui (float_print_max, 10000000UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
102
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
103 /* Prepare the bignum/bigfloat random number generator */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
104 gmp_randinit_default (random_state);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
105 gmp_randseed_ui (random_state, qxe_getpid () + time (NULL));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
106 }