e576bb2002-10-11Martin Nilsson /* || This file is part of Pike. For copyright information see COPYRIGHT. || Pike is distributed under GPL, LGPL and MPL. See the file COPYING || for more information.
1975dd2009-06-28Henrik Grubbström (Grubba) || $Id: mpz_glue.c,v 1.184 2009/06/28 10:08:26 grubba Exp $
e576bb2002-10-11Martin Nilsson */
aedfb12002-10-09Martin Nilsson 
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #include "global.h" #include "gmp_machine.h"
e9ceac2008-06-29Henrik Grubbström (Grubba) #include "pike_float.h"
51ef5c2002-10-21Marcus Comstedt #include "module.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
982a0c2003-03-28Martin Stjernholm /* Disable this for now to check that the fallbacks work correctly. */ #undef HAVE_MPZ_IMPORT
8e721c1998-07-11Henrik Grubbström (Grubba) #if defined(HAVE_GMP2_GMP_H) && defined(HAVE_LIBGMP2) #define USE_GMP2 #else /* !HAVE_GMP2_GMP_H || !HAVE_LIBGMP2 */ #if defined(HAVE_GMP_H) && defined(HAVE_LIBGMP) #define USE_GMP #endif /* HAVE_GMP_H && HAVE_LIBGMP */ #endif /* HAVE_GMP2_GMP_H && HAVE_LIBGMP2 */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
8e721c1998-07-11Henrik Grubbström (Grubba) #if defined(USE_GMP) || defined(USE_GMP2)
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  #include "interpret.h" #include "svalue.h" #include "stralloc.h" #include "array.h"
bb55f81997-03-16Fredrik Hübinette (Hubbe) #include "pike_macros.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #include "program.h" #include "stralloc.h" #include "object.h" #include "pike_types.h"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "builtin_functions.h"
7da3191997-04-25Niels Möller #include "module_support.h"
fda0de1999-10-08Fredrik Noring #include "bignum.h"
10f5031999-10-21Fredrik Noring #include "operators.h"
ad8d052008-05-02Martin Stjernholm #include "gc.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
7da3191997-04-25Niels Möller #include "my_gmp.h" #include <limits.h>
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
531c172002-05-11Martin Nilsson #define sp Pike_sp #define fp Pike_fp
18e3291999-08-06Fredrik Hübinette (Hubbe) #ifdef _MSC_VER /* No random()... provide one for gmp * This should possibly be a configure test * /Hubbe */ long random(void) { return my_rand(); } #endif
4690901998-04-23Fredrik Hübinette (Hubbe) #undef THIS
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #define THIS ((MP_INT *)(fp->current_storage))
fa93a52008-02-28Henrik Grubbström (Grubba) #define THIS_PROGRAM (fp->context->prog)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
a35b262004-03-21Henrik Grubbström (Grubba) struct program *mpzmod_program = NULL;
0957531999-10-25Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM
a35b262004-03-21Henrik Grubbström (Grubba) struct program *bignum_program = NULL;
0957531999-10-25Fredrik Hübinette (Hubbe) #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
110b3f1999-10-29Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM
982a0c2003-03-28Martin Stjernholm static mpz_t mpz_int_type_min;
d4bf622001-08-13Fredrik Hübinette (Hubbe) void mpzmod_reduce(struct object *o)
110b3f1999-10-29Fredrik Hübinette (Hubbe) {
982a0c2003-03-28Martin Stjernholm  MP_INT *mpz = OBTOMPZ (o); int neg = mpz_sgn (mpz) < 0; INT_TYPE res = 0;
4a0a9c2003-05-19Martin Stjernholm  /* Note: Similar code in gmp_int64_from_bignum. */
49cb142003-05-19Henrik Grubbström (Grubba)  /* Get the index of the highest limb that has bits within the range
a36bd12003-03-28Martin Stjernholm  * of the INT_TYPE. */
982a0c2003-03-28Martin Stjernholm  size_t pos = (INT_TYPE_BITS + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS - 1;
4f561d2003-05-19Martin Stjernholm  if (mpz_size (mpz) <= pos + 1) {
04d4952003-05-17Henrik Grubbström (Grubba)  /* NOTE: INT_TYPE is signed, while GMP_NUMB is unsigned.
49cb142003-05-19Henrik Grubbström (Grubba)  * Thus INT_TYPE_BITS is usually 31 and GMP_NUMB_BITS 32.
04d4952003-05-17Henrik Grubbström (Grubba)  */
49cb142003-05-19Henrik Grubbström (Grubba) #if INT_TYPE_BITS == GMP_NUMB_BITS /* NOTE: Overflow is not possible. */
4a0a9c2003-05-19Martin Stjernholm  res = MPZ_GETLIMBN (mpz, 0) & GMP_NUMB_MASK;
49cb142003-05-19Henrik Grubbström (Grubba) #elif INT_TYPE_BITS < GMP_NUMB_BITS
4a0a9c2003-05-19Martin Stjernholm  mp_limb_t val = MPZ_GETLIMBN (mpz, 0) & GMP_NUMB_MASK;
4f561d2003-05-19Martin Stjernholm  if (val >= (mp_limb_t) 1 << INT_TYPE_BITS) goto overflow; res = val;
982a0c2003-03-28Martin Stjernholm #else for (;; pos--) {
4a0a9c2003-05-19Martin Stjernholm  res |= MPZ_GETLIMBN (mpz, pos) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm  if (pos == 0) break;
49cb142003-05-19Henrik Grubbström (Grubba)  if (res >= (INT_TYPE) 1 << (INT_TYPE_BITS - GMP_NUMB_BITS)) goto overflow;
982a0c2003-03-28Martin Stjernholm  res <<= GMP_NUMB_BITS; } #endif
18099a2001-03-04Mirar (Pontus Hagland) 
4f561d2003-05-19Martin Stjernholm  if (neg) res = -res;
982a0c2003-03-28Martin Stjernholm  free_object (o); push_int (res); return;
18099a2001-03-04Mirar (Pontus Hagland)  }
982a0c2003-03-28Martin Stjernholm  overflow: if (neg && !mpz_cmp (mpz, mpz_int_type_min)) { /* No overflow afterall; it's MIN_INT_TYPE, the only valid integer * whose absolute value is INT_TYPE_BITS long. */ free_object (o); push_int (MIN_INT_TYPE);
110b3f1999-10-29Fredrik Hübinette (Hubbe)  }
982a0c2003-03-28Martin Stjernholm  else push_object (o);
110b3f1999-10-29Fredrik Hübinette (Hubbe) }
00cf022003-11-15Martin Stjernholm 
110b3f1999-10-29Fredrik Hübinette (Hubbe) #define PUSH_REDUCED(o) do { struct object *reducetmp__=(o); \ if(THIS_PROGRAM == bignum_program) \
d4bf622001-08-13Fredrik Hübinette (Hubbe)  mpzmod_reduce(reducetmp__); \
110b3f1999-10-29Fredrik Hübinette (Hubbe)  else \ push_object(reducetmp__); \ }while(0)
982a0c2003-03-28Martin Stjernholm #ifdef INT64
00cf022003-11-15Martin Stjernholm static void gmp_reduce_stack_top_bignum (void) { struct object *o; #ifdef PIKE_DEBUG if (sp[-1].type != T_OBJECT || sp[-1].u.object->prog != bignum_program) Pike_fatal ("Not a Gmp.bignum.\n"); #endif o = (--sp)->u.object; debug_malloc_touch (o); mpzmod_reduce (o); }
982a0c2003-03-28Martin Stjernholm static void gmp_push_int64 (INT64 i) { if(i == DO_NOT_WARN((INT_TYPE)i)) { push_int(DO_NOT_WARN((INT_TYPE)i)); } else { MP_INT *mpz; push_object (fast_clone_object (bignum_program)); mpz = OBTOMPZ (sp[-1].u.object);
fd45d52003-04-02Martin Stjernholm #if SIZEOF_LONG >= SIZEOF_INT64
04d4952003-05-17Henrik Grubbström (Grubba)  PIKE_MPZ_SET_SI (mpz, i);
982a0c2003-03-28Martin Stjernholm #else {
fd45d52003-04-02Martin Stjernholm  int neg = i < 0;
548d6e2003-06-12Martin Stjernholm  unsigned INT64 bits = (unsigned INT64) (neg ? -i : i);
fd45d52003-04-02Martin Stjernholm  #ifdef HAVE_MPZ_IMPORT
04d4952003-05-17Henrik Grubbström (Grubba)  mpz_import (mpz, 1, 1, SIZEOF_INT64, 0, 0, &bits);
fd45d52003-04-02Martin Stjernholm #else { size_t n = ((SIZEOF_INT64 + SIZEOF_LONG - 1) / SIZEOF_LONG - 1) /* The above is the position of the top unsigned long in the INT64. */ * ULONG_BITS;
04d4952003-05-17Henrik Grubbström (Grubba)  mpz_set_ui (mpz, (unsigned long) (bits >> n));
fd45d52003-04-02Martin Stjernholm  while (n) { n -= ULONG_BITS; mpz_mul_2exp (mpz, mpz, ULONG_BITS);
04d4952003-05-17Henrik Grubbström (Grubba)  mpz_add_ui (mpz, mpz, (unsigned long) (bits >> n));
fd45d52003-04-02Martin Stjernholm  }
982a0c2003-03-28Martin Stjernholm  }
fd45d52003-04-02Martin Stjernholm #endif /* !HAVE_MPZ_IMPORT */
982a0c2003-03-28Martin Stjernholm 
fd45d52003-04-02Martin Stjernholm  if (neg) mpz_neg (mpz, mpz); }
2f8d142003-04-03Martin Stjernholm #endif /* SIZEOF_LONG < SIZEOF_INT64 */
982a0c2003-03-28Martin Stjernholm  } } static mpz_t mpz_int64_min; static int gmp_int64_from_bignum (INT64 *i, struct object *bignum) { MP_INT *mpz = OBTOMPZ (bignum); int neg = mpz_sgn (mpz) < 0;
dccaa22008-05-01Martin Stjernholm  /* Note: Similar code in mpzmod_reduce and gmp_ulongest_from_bignum. */
4a0a9c2003-05-19Martin Stjernholm 
982a0c2003-03-28Martin Stjernholm  /* Get the index of the highest limb that have bits within the range * of the INT64. */ size_t pos = (INT64_BITS + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS - 1; #ifdef PIKE_DEBUG
1d81992007-12-27Henrik Grubbström (Grubba)  if ((bignum->prog != bignum_program) && (bignum->prog != mpzmod_program)) { Pike_fatal("cast_to_int(): Not a Gmp.bignum or Gmp.mpz.\n"); }
982a0c2003-03-28Martin Stjernholm #endif if (mpz_size (mpz) <= pos + 1) {
576cff2008-05-01Martin Stjernholm  INT64 res;
982a0c2003-03-28Martin Stjernholm #if INT64_BITS == GMP_NUMB_BITS
4a0a9c2003-05-19Martin Stjernholm  res = MPZ_GETLIMBN (mpz, 0) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm #elif INT64_BITS < GMP_NUMB_BITS
4a0a9c2003-05-19Martin Stjernholm  mp_limb_t val = MPZ_GETLIMBN (mpz, 0) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm  if (val >= (mp_limb_t) 1 << INT64_BITS) goto overflow;
576cff2008-05-01Martin Stjernholm  res = DO_NOT_WARN ((INT64) val);
982a0c2003-03-28Martin Stjernholm #else
576cff2008-05-01Martin Stjernholm  res = 0;
982a0c2003-03-28Martin Stjernholm  for (;; pos--) {
4a0a9c2003-05-19Martin Stjernholm  res |= MPZ_GETLIMBN (mpz, pos) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm  if (pos == 0) break; if (res >= (INT64) 1 << (INT64_BITS - GMP_NUMB_BITS)) goto overflow; res <<= GMP_NUMB_BITS; } #endif if (neg) res = -res; *i = res; return 1; } overflow: if (neg && !mpz_cmp (mpz, mpz_int64_min)) { /* No overflow afterall; it's MIN_INT64, the only valid integer * whose absolute value is INT64_BITS long. */ *i = MIN_INT64; return 1; } *i = neg ? MIN_INT64 : MAX_INT64; return 0; }
dccaa22008-05-01Martin Stjernholm #endif /* INT64 */ static void gmp_push_ulongest (unsigned LONGEST i) { if (i <= MAX_INT_TYPE) { push_int(DO_NOT_WARN((INT_TYPE)i)); } else { MP_INT *mpz; push_object (fast_clone_object (bignum_program)); mpz = OBTOMPZ (sp[-1].u.object); #if SIZEOF_LONG >= SIZEOF_LONGEST mpz_set_ui (mpz, i); #else
ccceef2008-05-02Martin Stjernholm  { #ifdef HAVE_MPZ_IMPORT mpz_import (mpz, 1, 1, SIZEOF_LONGEST, 0, 0, &i); #else { size_t n = ((SIZEOF_LONGEST + SIZEOF_LONG - 1) / SIZEOF_LONG - 1) /* The above is the position of the top unsigned long in the INT64. */ * ULONG_BITS; mpz_set_ui (mpz, (unsigned long) (i >> n)); while (n) { n -= ULONG_BITS; mpz_mul_2exp (mpz, mpz, ULONG_BITS); mpz_add_ui (mpz, mpz, (unsigned long) (i >> n)); } } #endif /* !HAVE_MPZ_IMPORT */ } #endif /* SIZEOF_LONG < SIZEOF_LONGEST */
dccaa22008-05-01Martin Stjernholm  } } static int gmp_ulongest_from_bignum (unsigned LONGEST *i, struct object *bignum)
576cff2008-05-01Martin Stjernholm { MP_INT *mpz = OBTOMPZ (bignum); /* Note: Similar code in gmp_int64_from_bignum. */ /* Get the index of the highest limb that have bits within the range
dccaa22008-05-01Martin Stjernholm  * of LONGEST. */ size_t pos = (ULONGEST_BITS + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS - 1;
576cff2008-05-01Martin Stjernholm  #ifdef PIKE_DEBUG if ((bignum->prog != bignum_program) && (bignum->prog != mpzmod_program)) { Pike_fatal("cast_to_int(): Not a Gmp.bignum or Gmp.mpz.\n"); } #endif if (mpz_sgn (mpz) < 0) return 0; if (mpz_size (mpz) <= pos + 1) {
dccaa22008-05-01Martin Stjernholm  unsigned LONGEST res; #if ULONGEST_BITS == GMP_NUMB_BITS
576cff2008-05-01Martin Stjernholm  res = MPZ_GETLIMBN (mpz, 0) & GMP_NUMB_MASK;
dccaa22008-05-01Martin Stjernholm #elif ULONGEST_BITS < GMP_NUMB_BITS
576cff2008-05-01Martin Stjernholm  mp_limb_t val = MPZ_GETLIMBN (mpz, 0) & GMP_NUMB_MASK;
dccaa22008-05-01Martin Stjernholm  res = DO_NOT_WARN ((unsigned LONGEST) val); if (val != res) return 0;
576cff2008-05-01Martin Stjernholm #else res = 0; for (;; pos--) { res |= MPZ_GETLIMBN (mpz, pos) & GMP_NUMB_MASK; if (pos == 0) break;
dccaa22008-05-01Martin Stjernholm  if (res >= (unsigned LONGEST) 1 << (ULONGEST_BITS - GMP_NUMB_BITS)) return 0;
576cff2008-05-01Martin Stjernholm  res <<= GMP_NUMB_BITS; } #endif *i = res; return 1; } return 0; }
110b3f1999-10-29Fredrik Hübinette (Hubbe) #else #define PUSH_REDUCED(o) push_object(o) #endif /* AUTO_BIGNUM */
a3edd72002-03-08Martin Nilsson /*! @module Gmp
25616a2004-03-23Martin Nilsson  *! GMP is a free library for arbitrary precision arithmetic, *! operating on signed integers, rational numbers, and floating point *! numbers. There is no practical limit to the precision except the *! ones implied by the available memory in the machine GMP runs on. *! @url{http://www.swox.com/gmp/@}
a3edd72002-03-08Martin Nilsson  */
d1648c2004-01-12Martin Nilsson /*! @class bignum *! This program is used by the internal auto-bignum conversion. It
25616a2004-03-23Martin Nilsson  *! can be used to explicitly type integers that are too big to be
d1648c2004-01-12Martin Nilsson  *! INT_TYPE. Best is however to not use this program unless you *! really know what you are doing.
cd8be42004-09-15Martin Stjernholm  *! *! Due to the auto-bignum conversion, all integers can be treated as *! @[Gmp.mpz] objects insofar as that they can be indexed with the *! functions in the @[Gmp.mpz] class. For instance, to calculate the *! greatest common divisor between @expr{51@} and @expr{85@}, you can *! do @expr{51->gcd(85)@}. In other words, all the functions in *! @[Gmp.mpz] are also available here.
c8153e2004-01-14Martin Nilsson  *! @endclass
d1648c2004-01-12Martin Nilsson  */
a3edd72002-03-08Martin Nilsson /*! @class mpz
815ad12003-04-07Martin Nilsson  *! Gmp.mpz implements very large integers. In fact,
37de6f2003-04-03Martin Nilsson  *! the only limitation on these integers is the available memory. *! The mpz object implements all the normal integer operations.
cd8be42004-09-15Martin Stjernholm  *! *! Note that the auto-bignum feature also makes these operations *! available "in" normal integers. For instance, to calculate the *! greatest common divisor between @expr{51@} and @expr{85@}, you can *! do @expr{51->gcd(85)@}.
a3edd72002-03-08Martin Nilsson  */
110b3f1999-10-29Fredrik Hübinette (Hubbe) 
d4bf622001-08-13Fredrik Hübinette (Hubbe) void get_mpz_from_digits(MP_INT *tmp, struct pike_string *digits, int base)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) { if(!base || ((base >= 2) && (base <= 36))) {
5656451999-10-26Fredrik Noring  int offset = 0;
b333ef2000-06-09Fredrik Noring  int neg = 0; if(digits->len > 1)
5656451999-10-26Fredrik Noring  {
b333ef2000-06-09Fredrik Noring  if(INDEX_CHARP(digits->str, 0, digits->size_shift) == '+') offset += 1; else if(INDEX_CHARP(digits->str, 0, digits->size_shift) == '-') {
5656451999-10-26Fredrik Noring  offset += 1;
b333ef2000-06-09Fredrik Noring  neg = 1; } /* We need to fix the case with binary
04d4952003-05-17Henrik Grubbström (Grubba)  * 0b101... and -0b101... numbers. *
4f561d2003-05-19Martin Stjernholm  * What about hexadecimal and octal?
04d4952003-05-17Henrik Grubbström (Grubba)  * /grubba 2003-05-16
4f561d2003-05-19Martin Stjernholm  * * No sweat - they are handled by mpz_set_str. /mast
04d4952003-05-17Henrik Grubbström (Grubba)  */
b333ef2000-06-09Fredrik Noring  if(!base && digits->len > 2)
5656451999-10-26Fredrik Noring  {
b333ef2000-06-09Fredrik Noring  if((INDEX_CHARP(digits->str, offset, digits->size_shift) == '0') && ((INDEX_CHARP(digits->str, offset+1, digits->size_shift) == 'b') || (INDEX_CHARP(digits->str, offset+1, digits->size_shift) == 'B'))) { offset += 2; base = 2; }
5656451999-10-26Fredrik Noring  } } if (mpz_set_str(tmp, digits->str + offset, base))
c7549a2003-01-26Martin Nilsson  Pike_error("Invalid digits, cannot convert to Gmp.mpz.\n");
5656451999-10-26Fredrik Noring 
b333ef2000-06-09Fredrik Noring  if(neg)
5656451999-10-26Fredrik Noring  mpz_neg(tmp, tmp);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else if(base == 256) {
982a0c2003-03-28Martin Stjernholm  if (digits->size_shift) Pike_error("Invalid digits, cannot convert to Gmp.mpz.\n"); #ifdef HAVE_MPZ_IMPORT mpz_import (tmp, digits->len, 1, 1, 0, 0, digits->str); #else
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
982a0c2003-03-28Martin Stjernholm  int i; mpz_t digit; mpz_init(digit); mpz_set_ui(tmp, 0); for (i = 0; i < digits->len; i++) { mpz_set_ui(digit, EXTRACT_UCHAR(digits->str + i)); mpz_mul_2exp(digit, digit, DO_NOT_WARN((unsigned long)(digits->len - i - 1) * 8)); mpz_ior(tmp, tmp, digit); } mpz_clear(digit);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  }
982a0c2003-03-28Martin Stjernholm #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else {
c7549a2003-01-26Martin Nilsson  Pike_error("Invalid base.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } }
afcf782003-03-28Martin Stjernholm int get_new_mpz(MP_INT *tmp, struct svalue *s, int throw_error, const char *arg_func, int arg, int args)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) { switch(s->type)
0226201997-03-10Niels Möller  { case T_INT:
9c96882003-03-29Martin Stjernholm #ifndef BIG_PIKE_INT
04d4952003-05-17Henrik Grubbström (Grubba)  PIKE_MPZ_SET_SI(tmp, (signed long int) s->u.integer);
982a0c2003-03-28Martin Stjernholm #else {
f72f712003-03-29Martin Stjernholm  INT_TYPE i = s->u.integer; int neg = i < 0; if (neg) i = -i; #ifdef HAVE_MPZ_IMPORT mpz_import (tmp, 1, 1, SIZEOF_INT_TYPE, 0, 0, &i); #else { size_t n = ((SIZEOF_INT_TYPE + SIZEOF_LONG - 1) / SIZEOF_LONG - 1) /* The above is the position of the top unsigned long in the INT_TYPE. */ * ULONG_BITS;
f6a5c62003-04-02Martin Stjernholm  mpz_set_ui (tmp, (unsigned long) (i >> n));
f72f712003-03-29Martin Stjernholm  while (n) { n -= ULONG_BITS; mpz_mul_2exp (tmp, tmp, ULONG_BITS);
f6a5c62003-04-02Martin Stjernholm  mpz_add_ui (tmp, tmp, (unsigned long) (i >> n));
f72f712003-03-29Martin Stjernholm  }
982a0c2003-03-28Martin Stjernholm  }
f72f712003-03-29Martin Stjernholm #endif if (neg) mpz_neg (tmp, tmp);
982a0c2003-03-28Martin Stjernholm  }
b875ff2001-03-04Mirar (Pontus Hagland) #endif
0226201997-03-10Niels Möller  break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  case T_FLOAT:
e9ceac2008-06-29Henrik Grubbström (Grubba)  { double val = (double)s->u.float_number; if (PIKE_ISNAN(val) || PIKE_ISINF(val)) return 0; mpz_set_d(tmp, val); }
0226201997-03-10Niels Möller  break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  case T_OBJECT:
afcf782003-03-28Martin Stjernholm  if(IS_MPZ_OBJ (s->u.object)) { mpz_set(tmp, OBTOMPZ(s->u.object)); break; }
df867c2001-09-04Fredrik Hübinette (Hubbe)  if(s->u.object->prog == mpf_program) { mpz_set_f(tmp, OBTOMPF(s->u.object)); break; } if(s->u.object->prog == mpq_program) { mpz_set_q(tmp, OBTOMPQ(s->u.object)); break; }
afcf782003-03-28Martin Stjernholm  if (s->u.object->prog) { if (throw_error) SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpz|Gmp.mpf|Gmp.mpq"); else return 0;
f8afca2001-02-02Henrik Grubbström (Grubba)  } else {
afcf782003-03-28Martin Stjernholm  /* Destructed object. Use as zero. */ mpz_set_si(tmp, 0);
f8afca2001-02-02Henrik Grubbström (Grubba)  }
0226201997-03-10Niels Möller  break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #if 0
0226201997-03-10Niels Möller  case T_STRING: mpz_set_str(tmp, s->u.string->str, 0); break; case T_ARRAY: /* Experimental */ if ( (s->u.array->size != 2) || (ITEM(s->u.array)[0].type != T_STRING) || (ITEM(s->u.array)[1].type != T_INT))
c7549a2003-01-26Martin Nilsson  Pike_error("Cannot convert array to Gmp.mpz.\n");
0226201997-03-10Niels Möller  get_mpz_from_digits(tmp, ITEM(s->u.array)[0].u.string, ITEM(s->u.array)[1]); break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  default:
afcf782003-03-28Martin Stjernholm  if (throw_error) SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpz|Gmp.mpf|Gmp.mpq"); else return 0; } return 1; } /* Converts an svalue, located on the stack, to an mpz object */ MP_INT *debug_get_mpz(struct svalue *s, int throw_error, const char *arg_func, int arg, int args) { struct object *o = fast_clone_object (mpzmod_program); ONERROR uwp; SET_ONERROR (uwp, do_free_object, o); if (get_new_mpz (OBTOMPZ (o), s, throw_error, arg_func, arg, args)) { UNSET_ONERROR (uwp); free_svalue(s); s->u.object=o; s->type=T_OBJECT; return OBTOMPZ (o); } else { UNSET_ONERROR (uwp);
aaaab72003-03-29Martin Stjernholm  free_object (o);
afcf782003-03-28Martin Stjernholm  return NULL;
0226201997-03-10Niels Möller  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
33bd9a2002-02-06Henrik Grubbström (Grubba) /*! @decl void create() *! @decl void create(string|int|float|object value) *! @decl void create(string value, int(2..36)|int(256..256) base) *! *! Create and initialize a @[Gmp.mpz] object. *! *! @param value *! Initial value. If no value is specified, the object will be initialized *! to zero. *! *! @param base *! Base the value is specified in. The default base is base 10. *! The base can be either a value in the range @tt{[2..36]@} (inclusive), *! in which case the numbers are taken from the ASCII range *! @tt{0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ@} (case-insensitive), *! or the value 256, in which case @[value] is taken to be the binary *! representation in network byte order. *! *! @note *! Leading zeroes in @[value] are not significant. In particular leading *! NUL characters are not preserved in base 256 mode. */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_create(INT32 args) { switch(args) { case 1: if(sp[-args].type == T_STRING) get_mpz_from_digits(THIS, sp[-args].u.string, 0); else
afcf782003-03-28Martin Stjernholm  get_new_mpz(THIS, sp-args, 1, "Gmp.mpz", 1, args);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  break; case 2: /* Args are string of digits and integer base */ if(sp[-args].type != T_STRING)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz", 1, "string");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (sp[1-args].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz", 2, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  get_mpz_from_digits(THIS, sp[-args].u.string, sp[1-args].u.integer); break; case 0: break; /* Needed by AIX cc */ } pop_n_elems(args); }
815ad12003-04-07Martin Nilsson /*! @decl int cast_to_int() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_get_int(INT32 args) { pop_n_elems(args);
110b3f1999-10-29Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM add_ref(fp->current_object);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  mpzmod_reduce(fp->current_object);
5b2e4b2006-10-20Martin Nilsson  if( Pike_sp[-1].type == T_OBJECT && Pike_sp[-1].u.object->prog != bignum_program ) { apply_svalue(&auto_bignum_program, 1); }
110b3f1999-10-29Fredrik Hübinette (Hubbe) #else
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  push_int(mpz_get_si(THIS));
110b3f1999-10-29Fredrik Hübinette (Hubbe) #endif /* AUTO_BIGNUM */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl int __hash() */
04edf32000-01-09Fredrik Hübinette (Hubbe) static void mpzmod___hash(INT32 args) { pop_n_elems(args); push_int(mpz_get_si(THIS)); }
815ad12003-04-07Martin Nilsson /*! @decl float cast_to_float() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_get_float(INT32 args) { pop_n_elems(args);
6172662000-08-08Henrik Grubbström (Grubba)  push_float((FLOAT_TYPE)mpz_get_d(THIS));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
d4bf622001-08-13Fredrik Hübinette (Hubbe) struct pike_string *low_get_mpz_digits(MP_INT *mpz, int base)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
3ef2481999-10-22Fredrik Noring  struct pike_string *s = 0; /* Make gcc happy. */
6172662000-08-08Henrik Grubbström (Grubba)  ptrdiff_t len;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if ( (base >= 2) && (base <= 36)) { len = mpz_sizeinbase(mpz, base) + 2; s = begin_shared_string(len); mpz_get_str(s->str, base, mpz); /* Find NULL character */ len-=4; if (len < 0) len = 0; while(s->str[len]) len++;
84c7de2001-01-30Fredrik Hübinette (Hubbe)  s=end_and_resize_shared_string(s, len);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else if (base == 256) {
6172662000-08-08Henrik Grubbström (Grubba)  size_t i;
3445e71998-01-30Mirar (Pontus Hagland) 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (mpz_sgn(mpz) < 0)
c7549a2003-01-26Martin Nilsson  Pike_error("Only non-negative numbers can be converted to base 256.\n");
3445e71998-01-30Mirar (Pontus Hagland)  /* lets optimize this /Mirar & Per */
982a0c2003-03-28Martin Stjernholm  /* len = mpz_size(mpz)*sizeof(mp_limb_t); */
2618ee1998-02-11Niels Möller  /* This function should not return any leading zeros. /Nisse */ len = (mpz_sizeinbase(mpz, 2) + 7) / 8;
3445e71998-01-30Mirar (Pontus Hagland)  s = begin_shared_string(len);
982a0c2003-03-28Martin Stjernholm  if (!mpz_size (mpz))
3445e71998-01-30Mirar (Pontus Hagland)  {
1323f01998-02-11Niels Möller  /* Zero is a special case. There are no limbs at all, but * the size is still 1 bit, and one digit should be produced. */ if (len != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("mpz->low_get_mpz_digits: strange mpz state!\n");
1323f01998-02-11Niels Möller  s->str[0] = 0; } else {
982a0c2003-03-28Martin Stjernholm #if GMP_NUMB_BITS != SIZEOF_MP_LIMB_T * CHAR_BIT #error Cannot cope with GMP using nail bits. #endif size_t pos = 0;
c66a901998-04-30Henrik Grubbström (Grubba)  unsigned char *dst = (unsigned char *)s->str+s->len;
1323f01998-02-11Niels Möller  while (len > 0) {
4a0a9c2003-05-19Martin Stjernholm  mp_limb_t x = MPZ_GETLIMBN (mpz, pos++);
1323f01998-02-11Niels Möller  for (i=0; i<sizeof(mp_limb_t); i++)
78130c1998-07-19Niels Möller  {
340c562001-06-13Henrik Grubbström (Grubba)  *(--dst) = DO_NOT_WARN((unsigned char)(x & 0xff));
6172662000-08-08Henrik Grubbström (Grubba)  x >>= 8;
78130c1998-07-19Niels Möller  if (!--len) break; }
1323f01998-02-11Niels Möller  }
3445e71998-01-30Mirar (Pontus Hagland)  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  s = end_shared_string(s); } else {
c7549a2003-01-26Martin Nilsson  Pike_error("Invalid base.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return 0; /* Make GCC happy */ } return s; }
815ad12003-04-07Martin Nilsson /*! @decl string cast_to_string() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_get_string(INT32 args) { pop_n_elems(args);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  push_string(low_get_mpz_digits(THIS, 10));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
37de6f2003-04-03Martin Nilsson /*! @decl string digits(void|int(2..36)|int(256..256) base)
cd8be42004-09-15Martin Stjernholm  *! *! Convert this mpz object to a string. If a @[base] is given the
37de6f2003-04-03Martin Nilsson  *! number will be represented in that base. Valid bases are 2-36 and *! 256. The default base is 10.
cd8be42004-09-15Martin Stjernholm  *!
37de6f2003-04-03Martin Nilsson  *! @seealso *! @[cast_to_string] */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_digits(INT32 args) { INT32 base;
2ac3721997-09-07Niels Möller  struct pike_string *s;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!args) { base = 10; } else { if (sp[-args].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->digits", 1, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  base = sp[-args].u.integer; }
2ac3721997-09-07Niels Möller 
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(THIS, base);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
2ac3721997-09-07Niels Möller  push_string(s);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl string _sprintf(int ind, mapping opt) */
10f5031999-10-21Fredrik Noring static void mpzmod__sprintf(INT32 args) {
eccd0a1999-10-29Fredrik Noring  INT_TYPE precision, width, width_undecided, base = 0, mask_shift = 0;
10f5031999-10-21Fredrik Noring  struct pike_string *s = 0;
e9be8e2002-03-08Henrik Grubbström (Grubba)  INT_TYPE flag_left, method;
1864682001-09-20Fredrik Hübinette (Hubbe)  debug_malloc_touch(Pike_fp->current_object);
10f5031999-10-21Fredrik Noring 
c7549a2003-01-26Martin Nilsson  if(args < 2) SIMPLE_TOO_FEW_ARGS_ERROR("Gmp.mpz->_sprintf", 2); if(sp[-args].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->_sprintf", 1, "int");
c7549a2003-01-26Martin Nilsson  if(sp[1-args].type != T_MAPPING)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->_sprintf", 2, "mapping");
4f8deb1999-10-26Fredrik Noring  push_svalue(&sp[1-args]); push_constant_text("precision"); f_index(2); if(sp[-1].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->_sprintf", 2, "The field \"precision\" doesn't hold an integer.");
4f8deb1999-10-26Fredrik Noring  precision = (--sp)->u.integer;
eccd0a1999-10-29Fredrik Noring  push_svalue(&sp[1-args]); push_constant_text("width"); f_index(2); if(sp[-1].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->_sprintf", 2, "The field \"width\" doesn't hold an integer.");
eccd0a1999-10-29Fredrik Noring  width_undecided = ((sp-1)->subtype != NUMBER_NUMBER); width = (--sp)->u.integer;
310f601999-11-01Mirar (Pontus Hagland)  push_svalue(&sp[1-args]); push_constant_text("flag_left"); f_index(2); if(sp[-1].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->_sprintf", 2, "The field \"flag_left\" doesn't hold an integer.");
310f601999-11-01Mirar (Pontus Hagland)  flag_left=sp[-1].u.integer; pop_stack();
1864682001-09-20Fredrik Hübinette (Hubbe)  debug_malloc_touch(Pike_fp->current_object);
e9be8e2002-03-08Henrik Grubbström (Grubba)  switch(method = sp[-args].u.integer)
10f5031999-10-21Fredrik Noring  {
3905cf1999-11-11Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM case 't': pop_n_elems(args); if(THIS_PROGRAM == bignum_program) push_constant_text("int"); else push_constant_text("object"); return;
fef5d02003-03-29Martin Stjernholm #endif
4f8deb1999-10-26Fredrik Noring  case 'O':
fef5d02003-03-29Martin Stjernholm #ifdef AUTO_BIGNUM if (THIS_PROGRAM == mpzmod_program) { #endif push_constant_text ("Gmp.mpz("); push_string (low_get_mpz_digits (THIS, 10)); push_constant_text (")"); f_add (3); s = (--sp)->u.string; break; #ifdef AUTO_BIGNUM } #endif /* Fall through */
4f8deb1999-10-26Fredrik Noring  case 'u': /* Note: 'u' is not really supported. */ case 'd':
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(THIS, 10);
4f8deb1999-10-26Fredrik Noring  break; case 'x': case 'X': base += 8; mask_shift += 1; /* Fall-through. */ case 'o':
5656451999-10-26Fredrik Noring  base += 6; mask_shift += 2; /* Fall-through. */ case 'b': base += 2; mask_shift += 1;
4f8deb1999-10-26Fredrik Noring  if(precision > 0) { mpz_t mask; mpz_init_set_ui(mask, 1); mpz_mul_2exp(mask, mask, precision * mask_shift); mpz_sub_ui(mask, mask, 1); mpz_and(mask, mask, THIS);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(mask, base);
4f8deb1999-10-26Fredrik Noring  mpz_clear(mask); } else
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(THIS, base);
4f8deb1999-10-26Fredrik Noring  break;
eccd0a1999-10-29Fredrik Noring  case 'c': {
dd9add2003-03-28Martin Stjernholm  INT_TYPE neg = mpz_sgn (THIS) < 0;
eccd0a1999-10-29Fredrik Noring  unsigned char *dst;
dd9add2003-03-28Martin Stjernholm  size_t pos, length = mpz_size (THIS);
eccd0a1999-10-29Fredrik Noring  mpz_t tmp; MP_INT *n; INT_TYPE i; if(width_undecided) { p_wchar2 ch = mpz_get_ui(THIS);
dd9add2003-03-28Martin Stjernholm  if(neg)
eccd0a1999-10-29Fredrik Noring  ch = (~ch)+1; s = make_shared_binary_string2(&ch, 1); break; }
dd9add2003-03-28Martin Stjernholm  if (neg)
eccd0a1999-10-29Fredrik Noring  { mpz_init_set(tmp, THIS); mpz_add_ui(tmp, tmp, 1);
dd9add2003-03-28Martin Stjernholm  length = mpz_size (tmp);
eccd0a1999-10-29Fredrik Noring  n = tmp; } else n = THIS; if(width < 1) width = 1; s = begin_shared_string(width);
310f601999-11-01Mirar (Pontus Hagland)  if (!flag_left) dst = (unsigned char *)STR0(s) + width; else dst = (unsigned char *)STR0(s);
eccd0a1999-10-29Fredrik Noring 
982a0c2003-03-28Martin Stjernholm  pos = 0;
eccd0a1999-10-29Fredrik Noring  while(width > 0) {
982a0c2003-03-28Martin Stjernholm #if GMP_NUMB_BITS != SIZEOF_MP_LIMB_T * CHAR_BIT #error Cannot cope with GMP using nail bits. #endif
4a0a9c2003-05-19Martin Stjernholm  mp_limb_t x = (length-->0? MPZ_GETLIMBN(n, pos++) : 0);
310f601999-11-01Mirar (Pontus Hagland)  if (!flag_left) for(i = 0; i < (INT_TYPE)sizeof(mp_limb_t); i++) {
340c562001-06-13Henrik Grubbström (Grubba)  *(--dst) = DO_NOT_WARN((unsigned char)((neg ? ~x : x) & 0xff));
310f601999-11-01Mirar (Pontus Hagland)  x >>= 8; if(!--width) break; } else for(i = 0; i < (INT_TYPE)sizeof(mp_limb_t); i++) {
340c562001-06-13Henrik Grubbström (Grubba)  *(dst++) = DO_NOT_WARN((unsigned char)((neg ? ~x : x) & 0xff));
310f601999-11-01Mirar (Pontus Hagland)  x >>= 8; if(!--width) break; }
eccd0a1999-10-29Fredrik Noring  } if(neg) { mpz_clear(tmp); } s = end_shared_string(s); } break;
10f5031999-10-21Fredrik Noring  }
1864682001-09-20Fredrik Hübinette (Hubbe)  debug_malloc_touch(Pike_fp->current_object);
10f5031999-10-21Fredrik Noring  pop_n_elems(args);
e9be8e2002-03-08Henrik Grubbström (Grubba)  if(s) {
10f5031999-10-21Fredrik Noring  push_string(s);
e9be8e2002-03-08Henrik Grubbström (Grubba)  if (method == 'X') { f_upper_case(1); } } else {
10f5031999-10-21Fredrik Noring  push_int(0); /* Push false? */
eccd0a1999-10-29Fredrik Noring  sp[-1].subtype = 1; }
10f5031999-10-21Fredrik Noring }
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) _is_type(string type) */
10f5031999-10-21Fredrik Noring static void mpzmod__is_type(INT32 args) {
c7549a2003-01-26Martin Nilsson  if(args < 1) SIMPLE_TOO_FEW_ARGS_ERROR("Gmp.mpz->_is_type", 1); if(sp[-args].type != T_STRING)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->_is_type", 1, "string");
10f5031999-10-21Fredrik Noring  pop_n_elems(args-1); push_constant_text("int"); f_eq(2); }
37de6f2003-04-03Martin Nilsson /*! @decl int size(void|int base)
cd8be42004-09-15Martin Stjernholm  *! *! Return how long this mpz would be represented in the specified *! @[base]. The default base is 2.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_size(INT32 args) { int base; if (!args) { /* Default is number of bits */ base = 2; } else { if (sp[-args].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->size", 1, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  base = sp[-args].u.integer; if ((base != 256) && ((base < 2) || (base > 36)))
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->size", 1, "Invalid base.");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } pop_n_elems(args); if (base == 256)
340c562001-06-13Henrik Grubbström (Grubba)  push_int(DO_NOT_WARN((INT32)((mpz_sizeinbase(THIS, 2) + 7) / 8)));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  else
340c562001-06-13Henrik Grubbström (Grubba)  push_int(DO_NOT_WARN((INT32)(mpz_sizeinbase(THIS, base))));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
37de6f2003-04-03Martin Nilsson /*! @decl mixed cast(string type)
cd8be42004-09-15Martin Stjernholm  *! *! Cast this mpz object to another type. Allowed types are string, *! int and float. *!
37de6f2003-04-03Martin Nilsson  *! @seealso *! @[cast_to_int], @[cast_to_float], @[cast_to_string] */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_cast(INT32 args) {
9305551998-01-30Henrik Grubbström (Grubba)  struct pike_string *s;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(args < 1)
c7549a2003-01-26Martin Nilsson  SIMPLE_TOO_FEW_ARGS_ERROR("Gmp.mpz->cast", 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(sp[-args].type != T_STRING)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->cast", 1, "string");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
9305551998-01-30Henrik Grubbström (Grubba)  s = sp[-args].u.string;
d6ac731998-04-20Henrik Grubbström (Grubba)  add_ref(s);
9305551998-01-30Henrik Grubbström (Grubba)  pop_n_elems(args); switch(s->str[0])
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { case 'i':
b660c81999-03-01Fredrik Hübinette (Hubbe)  if(!strncmp(s->str, "int", 3))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
eccd0a1999-10-29Fredrik Noring  free_string(s);
9305551998-01-30Henrik Grubbström (Grubba)  mpzmod_get_int(0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return; } break; case 's':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "string"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
9305551998-01-30Henrik Grubbström (Grubba)  free_string(s); mpzmod_get_string(0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return; } break; case 'f':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "float"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
9305551998-01-30Henrik Grubbström (Grubba)  free_string(s); mpzmod_get_float(0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return; } break; case 'o':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "object"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { push_object(this_object()); } break; case 'm':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "mixed"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { push_object(this_object()); } break; }
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  push_string(s); /* To get it freed when Pike_error() pops the stack. */
9305551998-01-30Henrik Grubbström (Grubba) 
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->cast", 1, "Cannot cast to other type than int, string or float.");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
0226201997-03-10Niels Möller /* Non-reentrant */ #if 0
a80a9c1997-02-11Fredrik Hübinette (Hubbe) /* These two functions are here so we can allocate temporary * objects without having to worry about them leaking in * case of errors.. */ static struct object *temporary;
be478c1997-08-30Henrik Grubbström (Grubba) MP_INT *get_tmp(void)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) { if(!temporary)
e709751997-03-12Fredrik Hübinette (Hubbe)  temporary=clone_object(mpzmod_program,0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return (MP_INT *)temporary->storage; } static void return_temporary(INT32 args) { pop_n_elems(args); push_object(temporary); temporary=0; }
0226201997-03-10Niels Möller #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
4d21fc1999-12-15Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM #define DO_IF_AUTO_BIGNUM(X) X double double_from_sval(struct svalue *s) { switch(s->type) { case T_INT: return (double)s->u.integer; case T_FLOAT: return (double)s->u.float_number; case T_OBJECT:
afcf782003-03-28Martin Stjernholm  if(IS_MPZ_OBJ (s->u.object))
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  return mpz_get_d(OBTOMPZ(s->u.object)); default:
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Bad argument, expected a number of some sort.\n");
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  }
9509c52000-03-27Henrik Grubbström (Grubba)  /* NOT_REACHED */ return (double)0.0; /* Keep the compiler happy. */
4d21fc1999-12-15Fredrik Hübinette (Hubbe) }
fda0de1999-10-08Fredrik Noring 
4d21fc1999-12-15Fredrik Hübinette (Hubbe) #else #define DO_IF_AUTO_BIGNUM(X) #endif
b5e4fe2005-09-15Henrik Grubbström (Grubba) #define BINFUN2(name, errmsg_op, fun, OP, f_op, LFUN) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) static void name(INT32 args) \ { \ INT32 e; \ struct object *res; \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  DO_IF_AUTO_BIGNUM( \ if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  switch(sp[e-args].type) \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  { \
b5e4fe2005-09-15Henrik Grubbström (Grubba)  case T_OBJECT: \ { \ struct object *o = sp[e-args].u.object; \ struct program *p = NULL; \ int fun = -1; \ if (o->prog && \ ((p = o->prog->inherits[sp[e-args].subtype].prog) != \ bignum_program) && \ ((fun = FIND_LFUN(p, PIKE_CONCAT(LFUN_R, LFUN))) != \ -1)) { \ /* Found non-bignum program with double back operator. */ \ memmove(Pike_sp+1-args, Pike_sp-args, \ args * sizeof(struct svalue)); \ Pike_sp++; \ args++; \ e++; \ Pike_sp[-args].type = T_OBJECT; \ Pike_sp[-args].subtype = 0; /* FIXME? */ \ add_ref(Pike_sp[-args].u.object = Pike_fp->current_object); \ args = low_rop(o, fun, e, args); \ if (args > 1) { \ f_op(args); \ } \ return; \ } \ } \ break; \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  case T_FLOAT: \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  ret=mpz_get_d(THIS); \ for(e=0; e<args; e++) \
6f18502000-04-25Marcus Comstedt  ret = ret OP double_from_sval(sp-args); \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  \ pop_n_elems(args); \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  push_float( (FLOAT_TYPE)ret ); \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  return; \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  STRINGCONV( \ case T_STRING: \ MEMMOVE(sp-args+1, sp-args, sizeof(struct svalue)*args); \ sp++; args++; \
1ab4ac2008-01-26Martin Stjernholm  sp[-args].type=PIKE_T_FREE; \
d4bf622001-08-13Fredrik Hübinette (Hubbe)  sp[-args].u.string=low_get_mpz_digits(THIS, 10); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  sp[-args].type=T_STRING; \ f_add(args); \ return; ) \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  } \ } \ } ) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  for(e=0; e<args; e++) \
9c96882003-03-29Martin Stjernholm  if(sp[e-args].type != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
36f19c2005-09-15Henrik Grubbström (Grubba)  get_mpz(sp+e-args, 1, "Gmp.mpz->`" errmsg_op, e + 1, args); \
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \ if(sp[e-args].type != T_INT) \ fun(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); \ else \ PIKE_CONCAT(fun,_ui)(OBTOMPZ(res), OBTOMPZ(res), \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  sp[e-args].u.integer); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  \
18099a2001-03-04Mirar (Pontus Hagland)  pop_n_elems(args); \ PUSH_REDUCED(res); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) } \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  \ STRINGCONV( \ static void PIKE_CONCAT(name,_rhs)(INT32 args) \ { \ INT32 e; \ struct object *res; \ DO_IF_AUTO_BIGNUM( \ if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \ switch(sp[e-args].type) \ { \ case T_FLOAT: \ ret=mpz_get_d(THIS); \ for(e=0; e<args; e++) \
6f18502000-04-25Marcus Comstedt  ret = ret OP double_from_sval(sp-args); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  \ pop_n_elems(args); \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  push_float( (FLOAT_TYPE)ret ); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  return; \ case T_STRING: \
d4bf622001-08-13Fredrik Hübinette (Hubbe)  push_string(low_get_mpz_digits(THIS, 10)); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  f_add(args+1); \ return; \ } \ } \ } ) \ for(e=0; e<args; e++) \
9c96882003-03-29Martin Stjernholm  if(sp[e-args].type != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
36f19c2005-09-15Henrik Grubbström (Grubba)  get_mpz(sp+e-args, 1, "Gmp.mpz->``" errmsg_op, e + 1, args); \
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \ if(sp[e-args].type != T_INT) \ fun(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); \ else \ PIKE_CONCAT(fun,_ui)(OBTOMPZ(res), OBTOMPZ(res), \ sp[e-args].u.integer); \ \ pop_n_elems(args); \ PUSH_REDUCED(res); \ } \ ) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  \ static void PIKE_CONCAT(name,_eq)(INT32 args) \ { \ INT32 e; \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  DO_IF_AUTO_BIGNUM( \ if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  switch(sp[e-args].type) \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  { \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  case T_FLOAT: \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  ret=mpz_get_d(THIS); \ for(e=0; e<args; e++) \
6f18502000-04-25Marcus Comstedt  ret = ret OP double_from_sval(sp-args); \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  \ pop_n_elems(args); \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  push_float( (FLOAT_TYPE)ret ); \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  return; \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  case T_STRING: \ MEMMOVE(sp-args+1, sp-args, sizeof(struct svalue)*args); \ sp++; args++; \
1ab4ac2008-01-26Martin Stjernholm  sp[-args].type=PIKE_T_FREE; \
d4bf622001-08-13Fredrik Hübinette (Hubbe)  sp[-args].u.string=low_get_mpz_digits(THIS, 10); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  sp[-args].type=T_STRING; \ f_add(args); \ return; \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  } \ } \ } ) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  for(e=0; e<args; e++) \
9c96882003-03-29Martin Stjernholm  if(sp[e-args].type != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
afcf782003-03-28Martin Stjernholm  get_mpz(sp+e-args, 1, "Gmp.mpz->`" errmsg_op "=", e + 1, args); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++) \ if(sp[e-args].type != T_INT) \ fun(THIS, THIS, OBTOMPZ(sp[e-args].u.object)); \ else \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  PIKE_CONCAT(fun,_ui)(THIS,THIS, sp[e-args].u.integer); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  add_ref(fp->current_object); \ PUSH_REDUCED(fp->current_object); \
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
6547ef2000-03-01Fredrik Hübinette (Hubbe) #define STRINGCONV(X) X
815ad12003-04-07Martin Nilsson  /*! @decl Gmp.mpz `+(int|float|Gmp.mpz ... x) */ /*! @decl Gmp.mpz ``+(int|float|Gmp.mpz ... x) */ /*! @decl Gmp.mpz `+=(int|float|Gmp.mpz ... x) */
b5e4fe2005-09-15Henrik Grubbström (Grubba) BINFUN2(mpzmod_add, "+", mpz_add, +, f_add, ADD)
6547ef2000-03-01Fredrik Hübinette (Hubbe)  #undef STRINGCONV #define STRINGCONV(X)
815ad12003-04-07Martin Nilsson  /*! @decl Gmp.mpz `*(int|float|Gmp.mpz ... x) */ /*! @decl Gmp.mpz ``*(int|float|Gmp.mpz ... x) */ /*! @decl Gmp.mpz `*=(int|float|Gmp.mpz ... x) */
b5e4fe2005-09-15Henrik Grubbström (Grubba) BINFUN2(mpzmod_mul, "*", mpz_mul, *, f_multiply, MULTIPLY)
ee37801999-02-09Fredrik Hübinette (Hubbe) 
cd8be42004-09-15Martin Stjernholm /*! @decl Gmp.mpz gcd(object|int|float|string... arg) *! *! Return the greatest common divisor between this mpz object and *! all the arguments.
37de6f2003-04-03Martin Nilsson  */
4d21fc1999-12-15Fredrik Hübinette (Hubbe) static void mpzmod_gcd(INT32 args) { INT32 e; struct object *res; for(e=0; e<args; e++) if(sp[e-args].type != T_INT || sp[e-args].u.integer<=0)
afcf782003-03-28Martin Stjernholm  get_mpz(sp+e-args, 1, "Gmp.mpz->gcd", e + 1, args);
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); for(e=0;e<args;e++) if(sp[e-args].type != T_INT) mpz_gcd(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); else mpz_gcd_ui(OBTOMPZ(res), OBTOMPZ(res),sp[e-args].u.integer); pop_n_elems(args); PUSH_REDUCED(res); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `-(int|float|Gmp.mpz ... x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sub(INT32 args) { INT32 e;
79042c1997-03-11Niels Möller  struct object *res;
751aee1999-10-15Fredrik Noring 
79042c1997-03-11Niels Möller  if (args) for (e = 0; e<args; e++)
afcf782003-03-28Martin Stjernholm  get_mpz(sp + e - args, 1, "Gmp.mpz->`-", e + 1, args);
79042c1997-03-11Niels Möller 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  mpz_set(OBTOMPZ(res), THIS);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(args) { for(e=0;e<args;e++)
79042c1997-03-11Niels Möller  mpz_sub(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  }else{
0226201997-03-10Niels Möller  mpz_neg(OBTOMPZ(res), OBTOMPZ(res));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  }
0226201997-03-10Niels Möller  pop_n_elems(args);
bb4a9c1999-10-21Fredrik Hübinette (Hubbe)  debug_malloc_touch(res);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``-(int|float|Gmp.mpz ... x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rsub(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  MP_INT *a; if(args!=1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->``-", 1); a=get_mpz(sp-1, 1, "Gmp.mpz->``-", 1, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_sub(OBTOMPZ(res), a, THIS); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `/(int|float|Gmp.mpz ... x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_div(INT32 args) { INT32 e;
79042c1997-03-11Niels Möller  struct object *res;
0226201997-03-10Niels Möller 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  { if(sp[e-args].type != T_INT || sp[e-args].u.integer<=0)
afcf782003-03-28Martin Stjernholm  if (!mpz_sgn(get_mpz(sp+e-args, 1, "Gmp.mpz->`/", e + 1, args))) SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpz->`/");
80a0e41999-03-02Fredrik Hübinette (Hubbe)  }
79042c1997-03-11Niels Möller 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
79042c1997-03-11Niels Möller  mpz_set(OBTOMPZ(res), THIS); for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  { if(sp[e-args].type == T_INT)
a58a972004-02-17Mirar (Pontus Hagland) #ifdef BIG_PIKE_INT { INT_TYPE i=sp[e-args].u.integer; if ( (unsigned long int)i == i) { mpz_fdiv_q_ui(OBTOMPZ(res), OBTOMPZ(res), i); } else { MP_INT *tmp=get_mpz(sp+e-args,1,"Gmp.mpz->`/",e,e); mpz_fdiv_q(OBTOMPZ(res), OBTOMPZ(res), tmp); /* will this leak? there is no simple way of poking at the references to tmp */ } } #else
80a0e41999-03-02Fredrik Hübinette (Hubbe)  mpz_fdiv_q_ui(OBTOMPZ(res), OBTOMPZ(res), sp[e-args].u.integer);
a58a972004-02-17Mirar (Pontus Hagland) #endif
80a0e41999-03-02Fredrik Hübinette (Hubbe)  else mpz_fdiv_q(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); }
79042c1997-03-11Niels Möller 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``/(int|float|Gmp.mpz ... x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rdiv(INT32 args) { MP_INT *a;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->``/", 1); if(!mpz_sgn(THIS)) SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpz->``/");
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
afcf782003-03-28Martin Stjernholm  a=get_mpz(sp-1, 1, "Gmp.mpz->``/", 1, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  res=fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_fdiv_q(OBTOMPZ(res), a, THIS); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `%(int|float|Gmp.mpz ... x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_mod(INT32 args) { INT32 e;
79042c1997-03-11Niels Möller  struct object *res; for(e=0;e<args;e++)
afcf782003-03-28Martin Stjernholm  if (!mpz_sgn(get_mpz(sp+e-args, 1, "Gmp.mpz->`%", e + 1, args))) SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpz->`%");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  mpz_set(OBTOMPZ(res), THIS);
79042c1997-03-11Niels Möller  for(e=0;e<args;e++)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  mpz_fdiv_r(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``%(int|float|Gmp.mpz ... x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rmod(INT32 args) { MP_INT *a;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->``%", 1); if(!mpz_sgn(THIS)) SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpz->``%");
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
afcf782003-03-28Martin Stjernholm  a=get_mpz(sp-1, 1, "Gmp.mpz->``%", 1, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  res=fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_fdiv_r(OBTOMPZ(res), a, THIS); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl array(Gmp.mpz) gcdext(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Compute the greatest common divisor between this mpz object and *! @[x]. An array @expr{({g,s,t})@} is returned where @expr{g@} is *! the greatest common divisor, and @expr{s@} and @expr{t@} are the *! coefficients that satisfies *! *! @code *! this * s + @[x] * t = g *! @endcode *! *! @seealso *! @[gcdext2], @[gcd]
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_gcdext(INT32 args) { struct object *g, *s, *t; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->gcdext", 1);
0226201997-03-10Niels Möller 
afcf782003-03-28Martin Stjernholm  a = get_mpz(sp-1, 1, "Gmp.mpz->gcdext", 1, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  g = fast_clone_object(THIS_PROGRAM); s = fast_clone_object(THIS_PROGRAM); t = fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_gcdext(OBTOMPZ(g), OBTOMPZ(s), OBTOMPZ(t), THIS, a); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(g); PUSH_REDUCED(s); PUSH_REDUCED(t);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  f_aggregate(3); }
815ad12003-04-07Martin Nilsson /*! @decl array(Gmp.mpz) gcdext2(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Compute the greatest common divisor between this mpz object and *! @[x]. An array @expr{({g,s})@} is returned where @expr{g@} is the *! greatest common divisor, and @expr{s@} is a coefficient that *! satisfies *! *! @code *! this * s + @[x] * t = g *! @endcode *! *! where @expr{t@} is some integer value. *! *! @seealso *! @[gcdext], @[gcd]
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_gcdext2(INT32 args) { struct object *g, *s; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->gcdext2", 1);
0226201997-03-10Niels Möller 
afcf782003-03-28Martin Stjernholm  a = get_mpz(sp-args, 1, "Gmp.mpz->gcdext2", 1, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  g = fast_clone_object(THIS_PROGRAM); s = fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_gcdext(OBTOMPZ(g), OBTOMPZ(s), NULL, THIS, a); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(g); PUSH_REDUCED(s);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  f_aggregate(2); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz invert(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Return the inverse of this mpz value modulo @[x]. The returned *! value satisfies @expr{0 <= result < x@}. *! *! @throws *! An error is thrown if no inverse exists.
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_invert(INT32 args) { MP_INT *modulo;
0226201997-03-10Niels Möller  struct object *res;
79042c1997-03-11Niels Möller  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->invert", 1);
cd8be42004-09-15Martin Stjernholm  modulo = get_mpz(sp-1, 1, "Gmp.mpz->invert", 1, 1);
afcf782003-03-28Martin Stjernholm 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!mpz_sgn(modulo))
afcf782003-03-28Martin Stjernholm  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpz->invert");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  if (mpz_invert(OBTOMPZ(res), THIS, modulo) == 0) {
0620631997-10-29Fredrik Hübinette (Hubbe)  free_object(res);
afcf782003-03-28Martin Stjernholm  Pike_error("Not invertible.\n");
0226201997-03-10Niels Möller  } pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
cd8be42004-09-15Martin Stjernholm /*! @decl Gmp.mpz fac() *! *! Return the factorial of this mpz object. *! *! @throws *! Since factorials grow very quickly, only small integers are *! supported. An error is thrown if the value in this mpz object is *! too large. */ static void mpzmod_fac(INT32 args) { struct object *res; if (mpz_sgn (THIS) < 0) Pike_error ("Cannot calculate factorial for negative integer.\n"); if (!mpz_fits_ulong_p (THIS)) Pike_error ("Integer too large for factorial calculation.\n"); res = fast_clone_object (THIS_PROGRAM); mpz_fac_ui (OBTOMPZ(res), mpz_get_ui (THIS)); pop_n_elems (args); PUSH_REDUCED (res); }
1975dd2009-06-28Henrik Grubbström (Grubba) #ifdef HAVE_MPZ_BIN_UI
cd8be42004-09-15Martin Stjernholm /*! @decl Gmp.mpz bin(int k) *! *! Return the binomial coefficient @expr{n@} over @[k], where *! @expr{n@} is the value of this mpz object. Negative values of *! @expr{n@} are supported using the identity *! *! @code *! (-n)->bin(k) == (-1)->pow(k) * (n+k-1)->bin(k) *! @endcode *! *! (See Knuth volume 1, section 1.2.6 part G.) *! *! @throws *! The @[k] value can't be arbitrarily large. An error is thrown if *! it's too large.
1975dd2009-06-28Henrik Grubbström (Grubba)  *! *! @note *! This function is currently (Pike 7.8) not available with old *! releases of the gmp libraries.
cd8be42004-09-15Martin Stjernholm  */ static void mpzmod_bin(INT32 args) { MP_INT *k; struct object *res; if (args != 1) SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->bin", 1); k = get_mpz (sp-1, 1, "Gmp.mpz->bin", 1, 1); if (mpz_sgn (k) < 0) Pike_error ("Cannot calculate binomial with negative k value.\n"); if (!mpz_fits_ulong_p (k)) SIMPLE_ARG_ERROR ("Gmp.mpz->bin", 1, "Argument too large.\n"); res = fast_clone_object(THIS_PROGRAM); mpz_bin_ui (OBTOMPZ (res), THIS, mpz_get_ui (k)); pop_n_elems(args); PUSH_REDUCED(res); }
1975dd2009-06-28Henrik Grubbström (Grubba) #else /* FIXME: Implement mpz_bin_ui() using primitives. */ /* Note: When fixing; note IF_MPZ_BIN_UI further below. */ #endif /* HAVE_MPZ_BIN_UI */
cd8be42004-09-15Martin Stjernholm 
afcf782003-03-28Martin Stjernholm #define BINFUN(name, errmsg_name, fun) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) static void name(INT32 args) \ { \ INT32 e; \ struct object *res; \ for(e=0; e<args; e++) \
afcf782003-03-28Martin Stjernholm  get_mpz(sp+e-args, 1, errmsg_name, e + 1, args); \
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \ fun(OBTOMPZ(res), OBTOMPZ(res), \ OBTOMPZ(sp[e-args].u.object)); \ pop_n_elems(args); \ PUSH_REDUCED(res); \ }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `&(int|float|Gmp.mpz ... x) */
69afdb2005-04-08Henrik Grubbström (Grubba) BINFUN(mpzmod_and, "Gmp.mpz->`&", mpz_and)
815ad12003-04-07Martin Nilsson  /*! @decl Gmp.mpz `|(int|float|Gmp.mpz ... x) */
69afdb2005-04-08Henrik Grubbström (Grubba) BINFUN(mpzmod_or, "Gmp.mpz->`|", mpz_ior)
815ad12003-04-07Martin Nilsson  /*! @decl Gmp.mpz `^(int|float|Gmp.mpz ... x) */
69afdb2005-04-08Henrik Grubbström (Grubba) BINFUN(mpzmod_xor, "Gmp.mpz->`^", mpz_xor)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `~() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_compl(INT32 args) { struct object *o; pop_n_elems(args);
195b1c2003-02-15Henrik Grubbström (Grubba)  o=fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_com(OBTOMPZ(o), THIS);
9b55461999-10-16Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
afcf782003-03-28Martin Stjernholm #define CMPEQU(name,errmsg_name,cmp,default) \
c089471997-04-09Niels Möller static void name(INT32 args) \ { \ INT32 i; \ MP_INT *arg; \
afcf782003-03-28Martin Stjernholm  if(!args) SIMPLE_TOO_FEW_ARGS_ERROR (errmsg_name, 1); \
e9ceac2008-06-29Henrik Grubbström (Grubba)  if (!(arg = get_mpz(sp-args, 0, NULL, 0, 0))) \
195b1c2003-02-15Henrik Grubbström (Grubba)  default; \
c089471997-04-09Niels Möller  else \ i=mpz_cmp(THIS, arg) cmp 0; \
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); \ push_int(i); \ }
d4bf622001-08-13Fredrik Hübinette (Hubbe) #define RET_UNDEFINED do{pop_n_elems(args);push_undefined();return;}while(0)
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) `>(mixed with) */
69afdb2005-04-08Henrik Grubbström (Grubba) CMPEQU(mpzmod_gt, "Gmp.mpz->`>", >, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `<(mixed with) */
69afdb2005-04-08Henrik Grubbström (Grubba) CMPEQU(mpzmod_lt, "Gmp.mpz->`<", <, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `>=(mixed with) */
69afdb2005-04-08Henrik Grubbström (Grubba) CMPEQU(mpzmod_ge, "Gmp.mpz->`>=", >=, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `<=(mixed with) */
69afdb2005-04-08Henrik Grubbström (Grubba) CMPEQU(mpzmod_le, "Gmp.mpz->`<=", <=, RET_UNDEFINED)
d4bf622001-08-13Fredrik Hübinette (Hubbe) 
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) `==(mixed with) */
69afdb2005-04-08Henrik Grubbström (Grubba) CMPEQU(mpzmod_eq, "Gmp.mpz->`==", ==, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `!=(mixed with) */
69afdb2005-04-08Henrik Grubbström (Grubba) CMPEQU(mpzmod_nq, "Gmp.mpz->`!=", !=, i=1)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
37de6f2003-04-03Martin Nilsson /*! @decl int(0..1) probably_prime_p()
cd8be42004-09-15Martin Stjernholm  *! *! Return 1 if this mpz object is a prime, and 0 most of the time if *! it is not.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_probably_prime_p(INT32 args) {
65a5492000-08-10Per Hedbor  INT_TYPE count;
7da3191997-04-25Niels Möller  if (args) {
afcf782003-03-28Martin Stjernholm  if (sp[-args].type != T_INT) SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->probably_prime_p", 1, "int"); count = sp[-args].u.integer;
7da3191997-04-25Niels Möller  if (count <= 0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->probably_prime_p", 1, "The count must be positive.");
7da3191997-04-25Niels Möller  } else count = 25;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
7da3191997-04-25Niels Möller  push_int(mpz_probab_prime_p(THIS, count)); }
815ad12003-04-07Martin Nilsson /*! @decl int small_factor(void|int(1..) limit) */
7da3191997-04-25Niels Möller static void mpzmod_small_factor(INT32 args) {
65a5492000-08-10Per Hedbor  INT_TYPE limit;
7da3191997-04-25Niels Möller  if (args) {
afcf782003-03-28Martin Stjernholm  if (sp[-args].type != T_INT) SIMPLE_ARG_TYPE_ERROR ("Gmp.mpz->small_factor", 1, "int"); limit = sp[-args].u.integer;
bd44cf1997-04-26Niels Möller  if (limit < 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->small_factor", 1, "The limit must be at least 1.");
7da3191997-04-25Niels Möller  } else limit = INT_MAX; pop_n_elems(args); push_int(mpz_small_factor(THIS, limit)); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz next_prime(void|int count, void|int limit) */
7da3191997-04-25Niels Möller static void mpzmod_next_prime(INT32 args) {
65a5492000-08-10Per Hedbor  INT_TYPE count = 25; INT_TYPE limit = INT_MAX;
7da3191997-04-25Niels Möller  struct object *o; switch(args) { case 0: break; case 1: get_all_args("Gmp.mpz->next_prime", args, "%i", &count);
bd44cf1997-04-26Niels Möller  break;
7da3191997-04-25Niels Möller  default: get_all_args("Gmp.mpz->next_prime", args, "%i%i", &count, &limit);
bd44cf1997-04-26Niels Möller  break;
7da3191997-04-25Niels Möller  } pop_n_elems(args);
195b1c2003-02-15Henrik Grubbström (Grubba)  o = fast_clone_object(THIS_PROGRAM);
7da3191997-04-25Niels Möller  mpz_next_prime(OBTOMPZ(o), THIS, count, limit);
1598411999-10-20Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl int sgn() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sgn(INT32 args) { pop_n_elems(args); push_int(mpz_sgn(THIS)); }
37de6f2003-04-03Martin Nilsson /*! @decl Gmp.mpz sqrt()
cd8be42004-09-15Martin Stjernholm  *! *! Return the the truncated integer part of the square root of this *! mpz object.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sqrt(INT32 args) {
9a44a41999-10-30Fredrik Noring  struct object *o = 0; /* Make gcc happy. */
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); if(mpz_sgn(THIS)<0)
c7549a2003-01-26Martin Nilsson  Pike_error("Gmp.mpz->sqrt() on negative number.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  o=fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_sqrt(OBTOMPZ(o), THIS);
751aee1999-10-15Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl array(Gmp.mpz) sqrtrem() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sqrtrem(INT32 args) {
9a44a41999-10-30Fredrik Noring  struct object *root = 0, *rem = 0; /* Make gcc happy. */
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); if(mpz_sgn(THIS)<0)
c7549a2003-01-26Martin Nilsson  Pike_error("Gmp.mpz->sqrtrem() on negative number.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  root = fast_clone_object(THIS_PROGRAM); rem = fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_sqrtrem(OBTOMPZ(root), OBTOMPZ(rem), THIS);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(root); PUSH_REDUCED(rem);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  f_aggregate(2); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `<<(int|float|Gmp.mpz x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_lsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
d96bb82003-02-07Mirar (Pontus Hagland)  MP_INT *mi;
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->`<<", 1);
126bf22002-10-15Marcus Comstedt  if(sp[-1].type == T_INT) { if(sp[-1].u.integer < 0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->`<<", 1, "Got negative shift count.");
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT if (!FITS_ULONG (sp[-1].u.integer) && mpz_sgn (THIS)) SIMPLE_ARG_ERROR ("Gmp.mpz->`<<", 1, "Shift count too large.");
3275be2003-01-27Mirar (Pontus Hagland) #endif
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_mul_2exp(OBTOMPZ(res), THIS, sp[-1].u.integer); } else {
afcf782003-03-28Martin Stjernholm  mi = get_mpz(sp-1, 1, "Gmp.mpz->`<<", 1, 1);
8632802003-10-11Henrik Grubbström (Grubba)  if(mpz_sgn(mi)<0) SIMPLE_ARG_ERROR ("Gmp.mpz->`<<", 1, "Got negative shift count."); /* Cut off at 1MB ie 0x800000 bits. */ if(!mpz_fits_ulong_p(mi) || (mpz_get_ui(THIS) > 0x800000))
99c6912003-01-27Mirar (Pontus Hagland)  { if(mpz_sgn(THIS))
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->`<<", 1, "Shift count too large.");
99c6912003-01-27Mirar (Pontus Hagland)  else { /* Special case: shifting 0 left any number of bits still yields 0 */
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
99c6912003-01-27Mirar (Pontus Hagland)  mpz_set_si(OBTOMPZ(res), 0); }
126bf22002-10-15Marcus Comstedt  } else {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
afcf782003-03-28Martin Stjernholm  mpz_mul_2exp(OBTOMPZ(res), THIS, mpz_get_ui (mi));
126bf22002-10-15Marcus Comstedt  } }
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `>>(int|float|Gmp.mpz x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_rsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->`>>", 1);
3275be2003-01-27Mirar (Pontus Hagland)  if(sp[-1].type == T_INT) { if (sp[-1].u.integer < 0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->`>>", 1, "Got negative shift count.");
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT if (!FITS_ULONG (sp[-1].u.integer))
3275be2003-01-27Mirar (Pontus Hagland)  {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
3275be2003-01-27Mirar (Pontus Hagland)  mpz_set_si(OBTOMPZ(res), mpz_sgn(THIS)<0? -1:0); } else #endif {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
3275be2003-01-27Mirar (Pontus Hagland)  mpz_fdiv_q_2exp(OBTOMPZ(res), THIS, sp[-1].u.integer); } }
9c96882003-03-29Martin Stjernholm  else
3275be2003-01-27Mirar (Pontus Hagland)  {
afcf782003-03-28Martin Stjernholm  MP_INT *mi = get_mpz(sp-1, 1, "Gmp.mpz->`>>", 1, 1); if(!mpz_fits_ulong_p (mi)) { if(mpz_sgn(mi)<0) SIMPLE_ARG_ERROR ("Gmp.mpz->`>>", 1, "Got negative shift count."); res = fast_clone_object(THIS_PROGRAM); mpz_set_si(OBTOMPZ(res), mpz_sgn(THIS)<0? -1:0); } else { res = fast_clone_object(THIS_PROGRAM); mpz_fdiv_q_2exp(OBTOMPZ(res), THIS, mpz_get_ui (mi)); }
126bf22002-10-15Marcus Comstedt  }
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``<<(int|float|Gmp.mpz x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rlsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *mi;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->``<<", 1);
8632802003-10-11Henrik Grubbström (Grubba)  if(mpz_sgn(THIS) < 0) Pike_error ("Gmp.mpz->``<<(): Got negative shift count.\n");
afcf782003-03-28Martin Stjernholm  mi = get_mpz(sp-1, 1, "Gmp.mpz->``<<", 1, 1);
8632802003-10-11Henrik Grubbström (Grubba)  /* Cut off at 1MB ie 0x800000 bits. */ if(!mpz_fits_ulong_p(THIS) || (mpz_get_ui(THIS) > 0x800000)) {
afcf782003-03-28Martin Stjernholm  if(mpz_sgn(mi)) Pike_error ("Gmp.mpz->``<<(): Shift count too large.\n");
126bf22002-10-15Marcus Comstedt  else { /* Special case: shifting 0 left any number of bits still yields 0 */
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_set_si(OBTOMPZ(res), 0); } } else {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
afcf782003-03-28Martin Stjernholm  mpz_mul_2exp(OBTOMPZ(res), mi, mpz_get_ui (THIS));
126bf22002-10-15Marcus Comstedt  }
afcf782003-03-28Martin Stjernholm 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``>>(int|float|Gmp.mpz x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rrsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *mi;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->``>>", 1); mi = get_mpz(sp-1, 1, "Gmp.mpz->``>>", 1, 1); if (!mpz_fits_ulong_p (THIS)) { if(mpz_sgn(THIS) < 0) Pike_error ("Gmp.mpz->``>>(): Got negative shift count.\n"); res = fast_clone_object(THIS_PROGRAM); mpz_set_si(OBTOMPZ(res), mpz_sgn(mi)<0? -1:0); } else { res = fast_clone_object(THIS_PROGRAM); mpz_fdiv_q_2exp(OBTOMPZ(res), mi, mpz_get_ui (THIS)); }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
cd8be42004-09-15Martin Stjernholm /*! @decl Gmp.mpz powm(int|string|float|Gmp.mpz exp,@ *! int|string|float|Gmp.mpz mod) *! *! Return @expr{( this->pow(@[exp]) ) % @[mod]@}. *! *! @seealso *! @[pow]
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_powm(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *n, *e;
0226201997-03-10Niels Möller  if(args != 2)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->powm", 2); e = get_mpz(sp - 2, 1, "Gmp.mpz->powm", 1, 2); n = get_mpz(sp - 1, 1, "Gmp.mpz->powm", 2, 2);
0226201997-03-10Niels Möller  if (!mpz_sgn(n))
afcf782003-03-28Martin Stjernholm  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpz->powm");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
afcf782003-03-28Martin Stjernholm  mpz_powm(OBTOMPZ(res), THIS, e, n);
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz pow(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Return this mpz object raised to @[x]. The case when zero is *! raised to zero yields one. *! *! @seealso *! @[powm]
815ad12003-04-07Martin Nilsson  */
79042c1997-03-11Niels Möller static void mpzmod_pow(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
d96bb82003-02-07Mirar (Pontus Hagland)  INT32 i; MP_INT *mi;
79042c1997-03-11Niels Möller  if (args != 1)
afcf782003-03-28Martin Stjernholm  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpz->pow", 1);
126bf22002-10-15Marcus Comstedt  if (sp[-1].type == T_INT) { if (sp[-1].u.integer < 0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->pow", 1, "Negative exponent.");
390ccc2003-10-12Henrik Grubbström (Grubba)  /* Cut off at 1 MB. */ if ((mpz_size(THIS)*sp[-1].u.integer>(0x100000/sizeof(mp_limb_t))))
ccbc102003-01-26Mirar (Pontus Hagland)  if(mpz_cmp_si(THIS, -1)<0 || mpz_cmp_si(THIS, 1)>0)
99c6912003-01-27Mirar (Pontus Hagland)  goto too_large;
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_pow_ui(OBTOMPZ(res), THIS, sp[-1].u.integer); } else {
d96bb82003-02-07Mirar (Pontus Hagland) too_large:
afcf782003-03-28Martin Stjernholm  mi = get_mpz(sp-1, 1, "Gmp.mpz->pow", 1, 1);
126bf22002-10-15Marcus Comstedt  if(mpz_sgn(mi)<0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->pow", 1, "Negative exponent.");
126bf22002-10-15Marcus Comstedt  i=mpz_get_si(mi);
390ccc2003-10-12Henrik Grubbström (Grubba)  /* Cut off at 1 MB. */ if(mpz_cmp_si(mi, i) || (mpz_size(THIS)*i>(0x100000/sizeof(mp_limb_t))))
99c6912003-01-27Mirar (Pontus Hagland)  { if(mpz_cmp_si(THIS, -1)<0 || mpz_cmp_si(THIS, 1)>0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.mpz->pow", 1, "Exponent too large.");
99c6912003-01-27Mirar (Pontus Hagland)  else { /* Special case: these three integers can be raised to any power without overflowing. */
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
99c6912003-01-27Mirar (Pontus Hagland)  switch(mpz_get_si(THIS)) { case 0: mpz_set_si(OBTOMPZ(res), 0); break; case 1: mpz_set_si(OBTOMPZ(res), 1); break; case -1: mpz_set_si(OBTOMPZ(res), mpz_odd_p(mi)? -1:1); break; } } }
126bf22002-10-15Marcus Comstedt  else {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_pow_ui(OBTOMPZ(res), THIS, i); } }
79042c1997-03-11Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
79042c1997-03-11Niels Möller }
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) `!() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_not(INT32 args) { pop_n_elems(args); push_int(!mpz_sgn(THIS)); }
815ad12003-04-07Martin Nilsson /*! @decl int popcount()
0620ff2003-08-07Johan Sundström  *! For values >= 0, returns the population count (the number of set bits). *! For negative values (who have an infinite number of leading ones in a *! binary representation), -1 is returned.
815ad12003-04-07Martin Nilsson  */
78130c1998-07-19Niels Möller static void mpzmod_popcount(INT32 args) { pop_n_elems(args);
6f18502000-04-25Marcus Comstedt #ifdef HAVE_MPZ_POPCOUNT push_int(mpz_popcount(THIS));
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT
2dd8c12003-01-27Mirar (Pontus Hagland) /* need conversion from MAXUINT32 to -1 (otherwise it's done already) */ if (Pike_sp[-1].u.integer==0xffffffffLL) Pike_sp[-1].u.integer=-1; #endif
6f18502000-04-25Marcus Comstedt #else
78130c1998-07-19Niels Möller  switch (mpz_sgn(THIS)) { case 0: push_int(0); break; case -1:
818df82000-04-26Marcus Comstedt  push_int(-1);
6f18502000-04-25Marcus Comstedt  break;
78130c1998-07-19Niels Möller  case 1: push_int(mpn_popcount(THIS->_mp_d, THIS->_mp_size));
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT
2dd8c12003-01-27Mirar (Pontus Hagland)  if (Pike_sp[-1].u.integer==0xffffffffLL) Pike_sp[-1].u.integer=-1; #endif
78130c1998-07-19Niels Möller  break; default:
982a0c2003-03-28Martin Stjernholm #ifdef PIKE_DEBUG
5aad932002-08-15Marcus Comstedt  Pike_fatal("Gmp.mpz->popcount: Unexpected sign!\n");
982a0c2003-03-28Martin Stjernholm #endif
78130c1998-07-19Niels Möller  }
6f18502000-04-25Marcus Comstedt #endif
78130c1998-07-19Niels Möller }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz _random() */ static void mpzmod_random(INT32 args) { struct object *res = 0; /* Make gcc happy. */ pop_n_elems(args);
03cc312003-06-10Henrik Grubbström (Grubba)  args = 0;
815ad12003-04-07Martin Nilsson  if(mpz_sgn(THIS) <= 0) Pike_error("Random on negative number.\n");
03cc312003-06-10Henrik Grubbström (Grubba)  push_object(res=fast_clone_object(THIS_PROGRAM)); /* We add four to assure reasonably uniform randomness */ push_int(mpz_size(THIS)*sizeof(mp_limb_t) + 4); f_random_string(1); if (sp[-1].type != T_STRING) {
e494ac2004-11-14Martin Nilsson  Pike_error("random_string(%ld) returned non string.\n",
03cc312003-06-10Henrik Grubbström (Grubba)  mpz_size(THIS)*sizeof(mp_limb_t) + 4); } get_mpz_from_digits(OBTOMPZ(res), sp[-1].u.string, 256); pop_stack();
815ad12003-04-07Martin Nilsson  mpz_fdiv_r(OBTOMPZ(res), OBTOMPZ(res), THIS); /* modulo */
03cc312003-06-10Henrik Grubbström (Grubba)  Pike_sp--; dmalloc_touch_svalue(Pike_sp);
815ad12003-04-07Martin Nilsson  PUSH_REDUCED(res); } /*! @endclass */ /*! @decl Gmp.mpz fac(int x)
0620ff2003-08-07Johan Sundström  *! Returns the factorial of @[x] (@[x]!).
815ad12003-04-07Martin Nilsson  */
79042c1997-03-11Niels Möller static void gmp_fac(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
79042c1997-03-11Niels Möller  if (args != 1)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Gmp.fac: Wrong number of arguments.\n");
79042c1997-03-11Niels Möller  if (sp[-1].type != T_INT)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ("Gmp.fac", 1, "int");
79042c1997-03-11Niels Möller  if (sp[-1].u.integer < 0)
afcf782003-03-28Martin Stjernholm  SIMPLE_ARG_ERROR ("Gmp.fac", 1, "Got negative exponent.");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(mpzmod_program);
79042c1997-03-11Niels Möller  mpz_fac_ui(OBTOMPZ(res), sp[-1].u.integer); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
79042c1997-03-11Niels Möller }
42918d1999-10-25Fredrik Hübinette (Hubbe) 
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void init_mpz_glue(struct object *o) {
4f72502001-01-03Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5aad932002-08-15Marcus Comstedt  if(!fp) Pike_fatal("ZERO FP\n"); if(!THIS) Pike_fatal("ZERO THIS\n");
4f72502001-01-03Fredrik Hübinette (Hubbe) #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_init(THIS); } static void exit_mpz_glue(struct object *o) {
4f72502001-01-03Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5aad932002-08-15Marcus Comstedt  if(!fp) Pike_fatal("ZERO FP\n"); if(!THIS) Pike_fatal("ZERO THIS\n");
4f72502001-01-03Fredrik Hübinette (Hubbe) #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_clear(THIS); }
ad8d052008-05-02Martin Stjernholm  static void gc_recurse_mpz (struct object *o) {
b3f6732008-05-11Martin Stjernholm  if (mc_count_bytes (o)) mc_counted_bytes +=
ad8d052008-05-02Martin Stjernholm #ifdef MPZ_T_HAS__MP_ALLOC THIS[0]._mp_alloc * sizeof (mp_limb_t) + #else mpz_size (THIS) * sizeof (mp_limb_t) + #endif sizeof (mpz_t); }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
51ef5c2002-10-21Marcus Comstedt PIKE_MODULE_EXIT
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
df867c2001-09-04Fredrik Hübinette (Hubbe)  pike_exit_mpf_module();
d4bf622001-08-13Fredrik Hübinette (Hubbe)  pike_exit_mpq_module();
8e721c1998-07-11Henrik Grubbström (Grubba) #if defined(USE_GMP) || defined(USE_GMP2)
04e1c31999-11-23Fredrik Hübinette (Hubbe)  if(mpzmod_program) { free_program(mpzmod_program); mpzmod_program=0; }
0957531999-10-25Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM
04e1c31999-11-23Fredrik Hübinette (Hubbe)  {
bf44ca2003-03-29Henrik Grubbström (Grubba)  extern struct svalue auto_bignum_program; free_svalue(&auto_bignum_program);
1ab4ac2008-01-26Martin Stjernholm  auto_bignum_program.type=PIKE_T_FREE;
bf44ca2003-03-29Henrik Grubbström (Grubba)  if(bignum_program) { free_program(bignum_program); bignum_program=0; } mpz_clear (mpz_int_type_min);
982a0c2003-03-28Martin Stjernholm #ifdef INT64
bf44ca2003-03-29Henrik Grubbström (Grubba)  mpz_clear (mpz_int64_min);
982a0c2003-03-28Martin Stjernholm #endif
dccaa22008-05-01Martin Stjernholm  hook_in_gmp_funcs ( #ifdef INT64 NULL, NULL, NULL, #endif NULL, NULL);
bf44ca2003-03-29Henrik Grubbström (Grubba)  }
0957531999-10-25Fredrik Hübinette (Hubbe) #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif }
64474b2008-03-28Martin Stjernholm static void *pike_mp_alloc (size_t alloc_size) { void *ret = malloc (alloc_size); if (!ret) /* According to gmp docs, we're neither allowed to return zero nor * longjmp here. */ Pike_fatal ("Failed to allocate %"PRINTSIZET"db in gmp library.\n", alloc_size); return ret; } static void *pike_mp_realloc (void *ptr, size_t old_size, size_t new_size) { void *ret = realloc (ptr, new_size); if (!ret) /* According to gmp docs, we're neither allowed to return zero nor * longjmp here. */ Pike_fatal ("Failed to reallocate %"PRINTSIZET"db block " "to %"PRINTSIZET"db in gmp library.\n", old_size, new_size); return ret; }
0775f02008-03-28Martin Stjernholm static void pike_mp_free (void *ptr, size_t size)
64474b2008-03-28Martin Stjernholm { free (ptr); }
d412602008-03-28Martin Stjernholm  #define tMpz_arg tOr3(tInt,tFloat,tObj) #define tMpz_ret tObjIs_GMP_MPZ #define tMpz_shift_type tFunc(tMpz_arg,tMpz_ret) #define tMpz_binop_type tFuncV(tNone, tMpz_arg, tMpz_ret) #define tMpz_cmpop_type tFunc(tMixed, tInt01)
1975dd2009-06-28Henrik Grubbström (Grubba) #ifdef HAVE_MPZ_BIN_UI #define IF_MPZ_BIN_UI(X) X #else #define IF_MPZ_BIN_UI(X) #endif
0957531999-10-25Fredrik Hübinette (Hubbe) #define MPZ_DEFS() \ ADD_STORAGE(MP_INT); \ \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  /* function(void|string|int|float|object:void)" */ \ /* "|function(string,int:void) */ \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("create", mpzmod_create, \ tOr(tFunc(tOr5(tVoid,tStr,tInt,tFlt, \ tObj),tVoid), \
ecc9382008-06-29Martin Nilsson  tFunc(tStr tInt,tVoid)), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`+",mpzmod_add,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`+=",mpzmod_add_eq,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``+",mpzmod_add_rhs,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`-",mpzmod_sub,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``-",mpzmod_rsub,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`*",mpzmod_mul,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``*",mpzmod_mul,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`*=",mpzmod_mul_eq,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`/",mpzmod_div,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``/",mpzmod_rdiv,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`%",mpzmod_mod,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``%",mpzmod_rmod,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`&",mpzmod_and,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``&",mpzmod_and,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`|",mpzmod_or,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``|",mpzmod_or,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`^",mpzmod_xor,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``^",mpzmod_xor,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`~",mpzmod_compl,tFunc(tNone,tObj), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`<<",mpzmod_lsh,tMpz_shift_type, ID_PROTECTED); \ ADD_FUNCTION("`>>",mpzmod_rsh,tMpz_shift_type, ID_PROTECTED); \ ADD_FUNCTION("``<<",mpzmod_rlsh,tMpz_shift_type, ID_PROTECTED); \ ADD_FUNCTION("``>>",mpzmod_rrsh,tMpz_shift_type, ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`>", mpzmod_gt,tMpz_cmpop_type, ID_PROTECTED); \ ADD_FUNCTION("`<", mpzmod_lt,tMpz_cmpop_type, ID_PROTECTED); \ ADD_FUNCTION("`>=",mpzmod_ge,tMpz_cmpop_type, ID_PROTECTED); \ ADD_FUNCTION("`<=",mpzmod_le,tMpz_cmpop_type, ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`==",mpzmod_eq,tMpz_cmpop_type, ID_PROTECTED); \ ADD_FUNCTION("`!=",mpzmod_nq,tMpz_cmpop_type, ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`!",mpzmod_not,tFunc(tNone,tInt01), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("__hash",mpzmod___hash,tFunc(tNone,tInt), ID_PROTECTED); \ ADD_FUNCTION("cast",mpzmod_cast,tFunc(tStr,tMix), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
815ad12003-04-07Martin Nilsson  ADD_FUNCTION("_is_type", mpzmod__is_type, tFunc(tStr,tInt01), \
ecc9382008-06-29Martin Nilsson  ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ ADD_FUNCTION("digits", mpzmod_digits,tFunc(tOr(tVoid,tInt),tStr), 0); \
815ad12003-04-07Martin Nilsson  ADD_FUNCTION("_sprintf", mpzmod__sprintf, tFunc(tInt tMapping,tStr), \
ecc9382008-06-29Martin Nilsson  ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("size", mpzmod_size,tFunc(tOr(tVoid,tInt),tInt), 0); \ \
a454202003-04-02Martin Nilsson  ADD_FUNCTION("cast_to_int",mpzmod_get_int,tFunc(tNone,tInt),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("cast_to_string",mpzmod_get_string,tFunc(tNone,tStr),0); \ ADD_FUNCTION("cast_to_float",mpzmod_get_float,tFunc(tNone,tFlt),0); \ \ ADD_FUNCTION("probably_prime_p",mpzmod_probably_prime_p, \
37de6f2003-04-03Martin Nilsson  tFunc(tNone,tInt01),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("small_factor", mpzmod_small_factor, \ tFunc(tOr(tInt,tVoid),tInt), 0); \ ADD_FUNCTION("next_prime", mpzmod_next_prime, \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  tFunc(tOr(tInt,tVoid) tOr(tInt,tVoid),tMpz_ret), 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("gcd",mpzmod_gcd, tMpz_binop_type, 0); \ ADD_FUNCTION("gcdext",mpzmod_gcdext,tFunc(tMpz_arg,tArr(tMpz_ret)),0);\ ADD_FUNCTION("gcdext2",mpzmod_gcdext2,tFunc(tMpz_arg,tArr(tMpz_ret)),0);\ ADD_FUNCTION("invert", mpzmod_invert,tFunc(tMpz_arg,tMpz_ret),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
cd8be42004-09-15Martin Stjernholm  ADD_FUNCTION("fac", mpzmod_fac, tFunc(tNone,tMpz_ret), 0); \
1975dd2009-06-28Henrik Grubbström (Grubba)  IF_MPZ_BIN_UI(ADD_FUNCTION("bin", mpzmod_bin, \ tFunc(tMpz_arg,tMpz_ret), 0)); \
cd8be42004-09-15Martin Stjernholm  \
195b1c2003-02-15Henrik Grubbström (Grubba)  ADD_FUNCTION("sgn", mpzmod_sgn, tFunc(tNone,tInt), 0); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("sqrt", mpzmod_sqrt,tFunc(tNone,tMpz_ret),0); \
9a44a41999-10-30Fredrik Noring  ADD_FUNCTION("_sqrt", mpzmod_sqrt,tFunc(tNone,tMpz_ret),0); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("sqrtrem",mpzmod_sqrtrem,tFunc(tNone,tArr(tMpz_ret)),0);\ ADD_FUNCTION("powm",mpzmod_powm,tFunc(tMpz_arg tMpz_arg,tMpz_ret),0); \
126bf22002-10-15Marcus Comstedt  ADD_FUNCTION("pow", mpzmod_pow,tMpz_shift_type, 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ ADD_FUNCTION("popcount", mpzmod_popcount,tFunc(tVoid,tInt), 0); \ \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("_random",mpzmod_random,tFunc(tNone,tMpz_ret),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ set_init_callback(init_mpz_glue); \
ad8d052008-05-02Martin Stjernholm  set_exit_callback(exit_mpz_glue); \ set_gc_recurse_callback (gc_recurse_mpz);
45ee5d1999-02-10Fredrik Hübinette (Hubbe) 
51ef5c2002-10-21Marcus Comstedt PIKE_MODULE_INIT
0957531999-10-25Fredrik Hübinette (Hubbe) { #if defined(USE_GMP) || defined(USE_GMP2)
a35b262004-03-21Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (mpzmod_program) { fatal("Gmp.mpz initialized twice!\n"); } #endif /* PIKE_DEBUG */
64474b2008-03-28Martin Stjernholm  /* Make sure that gmp uses the same malloc functions as we do since * we got code that frees blocks allocated inside gmp (e.g. * mpf.get_string). This also ensures that gmp uses dlmalloc if we * do on Windows. In case gmp already uses the same malloc, this is * essentially just a NOP. */ mp_set_memory_functions (pike_mp_alloc, pike_mp_realloc, pike_mp_free);
0957531999-10-25Fredrik Hübinette (Hubbe)  start_new_program();
78130c1998-07-19Niels Möller 
0957531999-10-25Fredrik Hübinette (Hubbe)  MPZ_DEFS();
42918d1999-10-25Fredrik Hübinette (Hubbe) 
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #if 0 /* These are not implemented yet */
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(:int) */
e64f5a1999-06-19Fredrik Hübinette (Hubbe)  ADD_FUNCTION("squarep", mpzmod_squarep,tFunc(tNone,tInt), 0);
9ee2e52002-10-15Marcus Comstedt  ADD_FUNCTION("divmod", mpzmod_divmod, tFunc(tMpz_arg,tArr(tMpz_ret)), 0); ADD_FUNCTION("divm", mpzmod_divm, tFunc(tMpz_arg tMpz_arg,tMpz_ret), 0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
42918d1999-10-25Fredrik Hübinette (Hubbe) 
e9ce612001-03-29Per Hedbor  mpzmod_program=end_program(); mpzmod_program->id = PROG_GMP_MPZ_ID; add_program_constant("mpz", mpzmod_program, 0);
0226201997-03-10Niels Möller 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(int:object) */ ADD_FUNCTION("fac", gmp_fac,tFunc(tInt,tObj), 0);
79042c1997-03-11Niels Möller 
e28b471999-10-25Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM {
0957531999-10-25Fredrik Hübinette (Hubbe)  int id;
c84bd12003-01-13Henrik Grubbström (Grubba)  extern struct svalue auto_bignum_program;
0957531999-10-25Fredrik Hübinette (Hubbe) 
a35b262004-03-21Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (bignum_program) { fatal("Gmp.bignum initialized twice!\n"); } #endif /* PIKE_DEBUG */
0957531999-10-25Fredrik Hübinette (Hubbe)  /* This program autoconverts to integers, Gmp.mpz does not!! * magic? no, just an if statement :) /Hubbe */ start_new_program();
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #undef tMpz_ret #define tMpz_ret tInt
0957531999-10-25Fredrik Hübinette (Hubbe)  /* I first tried to just do an inherit here, but it becomes too hard * to tell the programs apart when I do that.. /Hubbe */ MPZ_DEFS(); id=add_program_constant("bignum", bignum_program=end_program(), 0);
f3c7152001-04-14Fredrik Hübinette (Hubbe)  bignum_program->flags |= PROGRAM_NO_WEAK_FREE | PROGRAM_NO_EXPLICIT_DESTRUCT | PROGRAM_CONSTANT ;
982a0c2003-03-28Martin Stjernholm  mpz_init (mpz_int_type_min); mpz_setbit (mpz_int_type_min, INT_TYPE_BITS); mpz_neg (mpz_int_type_min, mpz_int_type_min);
0957531999-10-25Fredrik Hübinette (Hubbe) 
c84bd12003-01-13Henrik Grubbström (Grubba)  /* Magic hook in... */
a35b262004-03-21Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG if (auto_bignum_program.type <= MAX_REF_TYPE) { Pike_fatal("Strange initial value for auto_bignum_program\n"); } #endif /* PIKE_DEBUG */
c84bd12003-01-13Henrik Grubbström (Grubba)  free_svalue(&auto_bignum_program); add_ref(auto_bignum_program.u.program = bignum_program); auto_bignum_program.type = PIKE_T_PROGRAM;
982a0c2003-03-28Martin Stjernholm #ifdef INT64 mpz_init (mpz_int64_min); mpz_setbit (mpz_int64_min, INT64_BITS); mpz_neg (mpz_int64_min, mpz_int64_min); #endif
dccaa22008-05-01Martin Stjernholm  hook_in_gmp_funcs ( #ifdef INT64 gmp_push_int64, gmp_int64_from_bignum, gmp_reduce_stack_top_bignum, #endif gmp_push_ulongest, gmp_ulongest_from_bignum);
982a0c2003-03-28Martin Stjernholm 
e28b471999-10-25Fredrik Hübinette (Hubbe) #if 0 /* magic /Hubbe * This seems to break more than it fixes though... /Hubbe */
7b99f62002-04-25Henrik Grubbström (Grubba)  free_type(ID_FROM_INT(Pike_compiler->new_program, id)->type);
bad5162000-06-23Fredrik Hübinette (Hubbe)  ID_FROM_INT(Pike_compiler->new_program, id)->type=CONSTTYPE(tOr(tFunc(tOr5(tVoid,tStr,tInt,tFlt,tObj),tInt),tFunc(tStr tInt,tInt)));
e28b471999-10-25Fredrik Hübinette (Hubbe) #endif }
c84bd12003-01-13Henrik Grubbström (Grubba) 
e28b471999-10-25Fredrik Hübinette (Hubbe) #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
d4bf622001-08-13Fredrik Hübinette (Hubbe)  pike_init_mpq_module();
df867c2001-09-04Fredrik Hübinette (Hubbe)  pike_init_mpf_module();
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
a3edd72002-03-08Martin Nilsson /*! @endmodule */