mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: libguile/guile.c libguile/numbers.c
This commit is contained in:
commit
ea0582c283
3 changed files with 44 additions and 2 deletions
|
@ -77,6 +77,7 @@ main (int argc, char **argv)
|
||||||
if (setlocale (LC_ALL, "") == NULL)
|
if (setlocale (LC_ALL, "") == NULL)
|
||||||
fprintf (stderr, "guile: warning: failed to install locale\n");
|
fprintf (stderr, "guile: warning: failed to install locale\n");
|
||||||
|
|
||||||
|
scm_install_gmp_memory_functions = 1;
|
||||||
scm_boot_guile (argc, argv, inner_main, 0);
|
scm_boot_guile (argc, argv, inner_main, 0);
|
||||||
return 0; /* never reached */
|
return 0; /* never reached */
|
||||||
}
|
}
|
||||||
|
|
|
@ -114,6 +114,10 @@ typedef scm_t_signed_bits scm_t_inum;
|
||||||
/* the macro above will not work as is with fractions */
|
/* the macro above will not work as is with fractions */
|
||||||
|
|
||||||
|
|
||||||
|
/* Default to 1, because as we used to hard-code `free' as the
|
||||||
|
deallocator, we know that overriding these functions with
|
||||||
|
instrumented `malloc' / `free' is OK. */
|
||||||
|
int scm_install_gmp_memory_functions = 1;
|
||||||
static SCM flo0;
|
static SCM flo0;
|
||||||
static SCM exactly_one_half;
|
static SCM exactly_one_half;
|
||||||
static SCM flo_log10e;
|
static SCM flo_log10e;
|
||||||
|
@ -172,6 +176,7 @@ scm_from_complex_double (complex double z)
|
||||||
static mpz_t z_negative_one;
|
static mpz_t z_negative_one;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
/* Clear the `mpz_t' embedded in bignum PTR. */
|
/* Clear the `mpz_t' embedded in bignum PTR. */
|
||||||
static void
|
static void
|
||||||
finalize_bignum (GC_PTR ptr, GC_PTR data)
|
finalize_bignum (GC_PTR ptr, GC_PTR data)
|
||||||
|
@ -182,6 +187,31 @@ finalize_bignum (GC_PTR ptr, GC_PTR data)
|
||||||
mpz_clear (SCM_I_BIG_MPZ (bignum));
|
mpz_clear (SCM_I_BIG_MPZ (bignum));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* The next three functions (custom_libgmp_*) are passed to
|
||||||
|
mp_set_memory_functions (in GMP) so that memory used by the digits
|
||||||
|
themselves is known to the garbage collector. This is needed so
|
||||||
|
that GC will be run at appropriate times. Otherwise, a program which
|
||||||
|
creates many large bignums would malloc a huge amount of memory
|
||||||
|
before the GC runs. */
|
||||||
|
static void *
|
||||||
|
custom_gmp_malloc (size_t alloc_size)
|
||||||
|
{
|
||||||
|
return scm_malloc (alloc_size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void *
|
||||||
|
custom_gmp_realloc (void *old_ptr, size_t old_size, size_t new_size)
|
||||||
|
{
|
||||||
|
return scm_realloc (old_ptr, new_size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
custom_gmp_free (void *ptr, size_t size)
|
||||||
|
{
|
||||||
|
free (ptr);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Return a new uninitialized bignum. */
|
/* Return a new uninitialized bignum. */
|
||||||
static inline SCM
|
static inline SCM
|
||||||
make_bignum (void)
|
make_bignum (void)
|
||||||
|
@ -5359,9 +5389,12 @@ int
|
||||||
scm_bigprint (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
|
scm_bigprint (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
|
||||||
{
|
{
|
||||||
char *str = mpz_get_str (NULL, 10, SCM_I_BIG_MPZ (exp));
|
char *str = mpz_get_str (NULL, 10, SCM_I_BIG_MPZ (exp));
|
||||||
|
size_t len = strlen (str);
|
||||||
|
void (*freefunc) (void *, size_t);
|
||||||
|
mp_get_memory_functions (NULL, NULL, &freefunc);
|
||||||
scm_remember_upto_here_1 (exp);
|
scm_remember_upto_here_1 (exp);
|
||||||
scm_lfwrite_unlocked (str, (size_t) strlen (str), port);
|
scm_lfwrite_unlocked (str, len, port);
|
||||||
free (str);
|
freefunc (str, len + 1);
|
||||||
return !0;
|
return !0;
|
||||||
}
|
}
|
||||||
/*** END nums->strs ***/
|
/*** END nums->strs ***/
|
||||||
|
@ -9655,6 +9688,11 @@ scm_init_numbers ()
|
||||||
{
|
{
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
|
if (scm_install_gmp_memory_functions)
|
||||||
|
mp_set_memory_functions (custom_gmp_malloc,
|
||||||
|
custom_gmp_realloc,
|
||||||
|
custom_gmp_free);
|
||||||
|
|
||||||
mpz_init_set_si (z_negative_one, -1);
|
mpz_init_set_si (z_negative_one, -1);
|
||||||
|
|
||||||
/* It may be possible to tune the performance of some algorithms by using
|
/* It may be possible to tune the performance of some algorithms by using
|
||||||
|
|
|
@ -519,6 +519,9 @@ SCM_API double scm_c_angle (SCM z);
|
||||||
|
|
||||||
SCM_API int scm_is_number (SCM val);
|
SCM_API int scm_is_number (SCM val);
|
||||||
|
|
||||||
|
/* If nonzero, tell gmp to use GC_malloc for its allocations. */
|
||||||
|
SCM_API int scm_install_gmp_memory_functions;
|
||||||
|
|
||||||
SCM_INTERNAL void scm_init_numbers (void);
|
SCM_INTERNAL void scm_init_numbers (void);
|
||||||
|
|
||||||
#endif /* SCM_NUMBERS_H */
|
#endif /* SCM_NUMBERS_H */
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue