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. */
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) 
91d0102014-10-14Martin Nilsson #if !defined(HAVE_GMP_H)
e7dab22014-04-23Henrik Grubbström (Grubba) #error "Gmp is required to build Pike!"
91d0102014-10-14Martin Nilsson #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
2b1c922013-12-24Henrik Grubbström (Grubba) #include "my_gmp.h"
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"
fa62492016-01-18Martin Nilsson #include "mapping.h" #include "constants.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
c4f94b2014-10-31Martin Nilsson #if GMP_NUMB_BITS != SIZEOF_MP_LIMB_T * CHAR_BIT #error Cannot cope with GMP using nail bits. #endif
531c172002-05-11Martin Nilsson #define sp Pike_sp
4690901998-04-23Fredrik Hübinette (Hubbe) #undef THIS
8f6a362014-12-02Martin Nilsson #define DECLARE_THIS() struct pike_frame *_fp = Pike_fp #define THIS ((MP_INT *)(_fp->current_storage)) #define THIS_PROGRAM (_fp->context->prog) #define THIS_OBJECT (_fp->current_object)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
a35b262004-03-21Henrik Grubbström (Grubba) struct program *mpzmod_program = NULL;
07bb4a2014-10-29Martin Nilsson PMOD_EXPORT struct program *bignum_program = NULL;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
982a0c2003-03-28Martin Stjernholm static mpz_t mpz_int_type_min;
2355e32014-10-29Martin Nilsson PMOD_EXPORT int mpz_from_svalue(MP_INT *dest, struct svalue *s)
2b1c922013-12-24Henrik Grubbström (Grubba) {
43a3892013-12-26Henrik Grubbström (Grubba)  if (!s) return 0; if (TYPEOF(*s) == T_INT) { #if SIZEOF_LONG >= SIZEOF_INT64
8a11eb2014-10-31Martin Nilsson  mpz_set_si(dest, s->u.integer);
43a3892013-12-26Henrik Grubbström (Grubba) #else INT_TYPE i = s->u.integer; int neg = i < 0;
30f5b22016-04-09Martin Nilsson  UINT64 bits = (UINT64) (neg ? -i : i);
43a3892013-12-26Henrik Grubbström (Grubba)  mpz_import(dest, 1, 1, SIZEOF_INT64, 0, 0, &bits); if (neg) mpz_neg(dest, dest); #endif /* SIZEOF_LONG < SIZEOF_INT64 */ return 1; } if ((TYPEOF(*s) != T_OBJECT) || !IS_MPZ_OBJ(s->u.object)) return 0; mpz_set(dest, OBTOMPZ(s->u.object)); return 1;
2b1c922013-12-24Henrik Grubbström (Grubba) }
2355e32014-10-29Martin Nilsson PMOD_EXPORT void push_bignum(MP_INT *mpz)
2b1c922013-12-24Henrik Grubbström (Grubba) { push_object(fast_clone_object(bignum_program)); mpz_set(OBTOMPZ(Pike_sp[-1].u.object), mpz); }
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);
d8f9ad2016-05-30Per Hedbor #if SIZEOF_INT_TYPE == SIZEOF_LONG if( mpz_fits_slong_p( mpz ) ) { push_int( mpz_get_si( mpz ) ); free_object(o); } else push_object(o); return; #else /*int type is not signed long. */
982a0c2003-03-28Martin Stjernholm  int neg = mpz_sgn (mpz) < 0; INT_TYPE res = 0;
2355e32014-10-29Martin Nilsson  /* Note: Similar code in int64_from_bignum. */
4a0a9c2003-05-19Martin Stjernholm 
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. */
b6ff9d2014-10-31Martin Nilsson  res = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
49cb142003-05-19Henrik Grubbström (Grubba) #elif INT_TYPE_BITS < GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  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--) {
b6ff9d2014-10-31Martin Nilsson  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
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);
d8f9ad2016-05-30Per Hedbor #endif /* sizeof int_type == sizeof long */
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)
2355e32014-10-29Martin Nilsson PMOD_EXPORT void reduce_stack_top_bignum (void)
00cf022003-11-15Martin Stjernholm { struct object *o; #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_OBJECT || sp[-1].u.object->prog != bignum_program)
00cf022003-11-15Martin Stjernholm  Pike_fatal ("Not a Gmp.bignum.\n"); #endif o = (--sp)->u.object; debug_malloc_touch (o); mpzmod_reduce (o); }
2355e32014-10-29Martin Nilsson PMOD_EXPORT void push_int64 (INT64 i)
982a0c2003-03-28Martin Stjernholm {
cc7cf42015-10-14Martin Nilsson  if(i == (INT_TYPE)i)
982a0c2003-03-28Martin Stjernholm  {
cc7cf42015-10-14Martin Nilsson  push_int((INT_TYPE)i);
982a0c2003-03-28Martin Stjernholm  } 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
8a11eb2014-10-31Martin Nilsson  mpz_set_si (mpz, i);
982a0c2003-03-28Martin Stjernholm #else {
fd45d52003-04-02Martin Stjernholm  int neg = i < 0;
30f5b22016-04-09Martin Nilsson  UINT64 bits = (UINT64) (neg ? -i : i);
fd45d52003-04-02Martin Stjernholm 
04d4952003-05-17Henrik Grubbström (Grubba)  mpz_import (mpz, 1, 1, SIZEOF_INT64, 0, 0, &bits);
fd45d52003-04-02Martin Stjernholm  if (neg) mpz_neg (mpz, mpz); }
2f8d142003-04-03Martin Stjernholm #endif /* SIZEOF_LONG < SIZEOF_INT64 */
982a0c2003-03-28Martin Stjernholm  } }
d8f9ad2016-05-30Per Hedbor #if SIZEOF_INT64 != SIZEOF_LONG || SIZEOF_INT_TYPE != SIZEOF_LONG
982a0c2003-03-28Martin Stjernholm static mpz_t mpz_int64_min;
d8f9ad2016-05-30Per Hedbor #endif
982a0c2003-03-28Martin Stjernholm 
2355e32014-10-29Martin Nilsson PMOD_EXPORT int int64_from_bignum (INT64 *i, struct object *bignum)
982a0c2003-03-28Martin Stjernholm { MP_INT *mpz = OBTOMPZ (bignum);
d8f9ad2016-05-30Per Hedbor #if SIZEOF_INT64 == SIZEOF_LONG if( !mpz_fits_slong_p( mpz ) ) return 0; *i = mpz_get_si( mpz ); return 1; #else /*int64 is not signed long. */
982a0c2003-03-28Martin Stjernholm  int neg = mpz_sgn (mpz) < 0;
e324b02016-05-09Martin Nilsson  /* Note: Similar code in mpzmod_reduce */
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)) {
552fc52016-04-17Martin Nilsson  Pike_fatal("cast(): Not a Gmp.bignum or Gmp.mpz.\n");
1d81992007-12-27Henrik Grubbström (Grubba)  }
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
b6ff9d2014-10-31Martin Nilsson  res = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm #elif INT64_BITS < GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  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;
cc7cf42015-10-14Martin Nilsson  res = (INT64) val;
982a0c2003-03-28Martin Stjernholm #else
576cff2008-05-01Martin Stjernholm  res = 0;
982a0c2003-03-28Martin Stjernholm  for (;; pos--) {
b6ff9d2014-10-31Martin Nilsson  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;
d8f9ad2016-05-30Per Hedbor #endif /*int64 is not signed long. */
982a0c2003-03-28Martin Stjernholm  return 0; }
0a3c552016-05-09Martin Nilsson PMOD_EXPORT void push_ulongest (UINT64 i)
dccaa22008-05-01Martin Stjernholm { if (i <= MAX_INT_TYPE) {
cc7cf42015-10-14Martin Nilsson  push_int((INT_TYPE)i);
dccaa22008-05-01Martin Stjernholm  } else { MP_INT *mpz; push_object (fast_clone_object (bignum_program)); mpz = OBTOMPZ (sp[-1].u.object);
0a3c552016-05-09Martin Nilsson #if SIZEOF_LONG >= SIZEOF_INT64
dccaa22008-05-01Martin Stjernholm  mpz_set_ui (mpz, i); #else
0a3c552016-05-09Martin Nilsson  mpz_import (mpz, 1, 1, SIZEOF_INT64, 0, 0, &i); #endif /* SIZEOF_LONG < SIZEOF_INT64 */
dccaa22008-05-01Martin Stjernholm  } }
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) {
ace2d32012-07-24Martin Nilsson  if (digits->size_shift) Pike_error("Invalid digits, cannot convert to Gmp.mpz.\n");
f145402015-02-13Martin Nilsson  if(!base || ((base >= 2) && (base <= 62)))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
5656451999-10-26Fredrik Noring  int offset = 0;
b333ef2000-06-09Fredrik Noring  int neg = 0; if(digits->len > 1)
5656451999-10-26Fredrik Noring  {
ace2d32012-07-24Martin Nilsson  if(STR0(digits)[0] == '+')
b333ef2000-06-09Fredrik Noring  offset += 1;
ace2d32012-07-24Martin Nilsson  else if(STR0(digits)[0] == '-')
b333ef2000-06-09Fredrik Noring  {
5656451999-10-26Fredrik Noring  offset += 1;
b333ef2000-06-09Fredrik Noring  neg = 1; }
ef1fff2015-02-13Martin Nilsson #ifndef HAVE_GMP5 /* mpz_set_str() will parse leading "0x" and "0X" as hex and * leading "0" as octal. "0b" and "0B" for binary are supported * from GMP 5.0.
04d4952003-05-17Henrik Grubbström (Grubba)  */
b333ef2000-06-09Fredrik Noring  if(!base && digits->len > 2)
5656451999-10-26Fredrik Noring  {
ace2d32012-07-24Martin Nilsson  if((STR0(digits)[offset] == '0') && ((STR0(digits)[offset+1] == 'b') || (STR0(digits)[offset+1] == 'B')))
b333ef2000-06-09Fredrik Noring  { offset += 2; base = 2; }
5656451999-10-26Fredrik Noring  }
ef1fff2015-02-13Martin Nilsson #endif
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  mpz_import (tmp, digits->len, 1, 1, 0, 0, digits->str);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  }
5d8d002015-02-11Henrik Grubbström (Grubba)  else if(base == -256) { mpz_import (tmp, digits->len, -1, 1, 0, 0, digits->str); }
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) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*s))
0226201997-03-10Niels Möller  { case T_INT:
9c96882003-03-29Martin Stjernholm #ifndef BIG_PIKE_INT
8a11eb2014-10-31Martin Nilsson  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;
e5cbd92014-10-31Martin Nilsson  if (neg) i = -i;
f72f712003-03-29Martin Stjernholm  mpz_import (tmp, 1, 1, SIZEOF_INT_TYPE, 0, 0, &i); if (neg) mpz_neg (tmp, tmp);
982a0c2003-03-28Martin Stjernholm  }
b875ff2001-03-04Mirar (Pontus Hagland) #endif
0226201997-03-10Niels Möller  break;
13670c2015-05-25Martin Nilsson 
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;
13670c2015-05-25Martin Nilsson #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)
017b572011-10-28Henrik Grubbström (Grubba)  || (TYPEOF(ITEM(s->u.array)[0]) != T_STRING) || (TYPEOF(ITEM(s->u.array)[1]) != 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; }
51f3702015-08-06Per Hedbor PMOD_EXPORT struct object *create_double_bignum( INT_TYPE low, INT_TYPE high ) { struct object *res = fast_clone_object( bignum_program ); MP_INT *mpz = (MP_INT*)res->storage; INT_TYPE data[2]; if( UNLIKELY(high < 0) ) { data[0] = -low; data[1] = -high; mpz_import( mpz, 2, -1, sizeof(INT_TYPE), 0, 0, data ); mpz_neg( mpz,mpz ); } else { data[0] = low; data[1] = high; mpz_import( mpz, 2, -1, sizeof(INT_TYPE), 0, 0, data ); } return res; }
afcf782003-03-28Martin Stjernholm /* 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);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*s, T_OBJECT, 0, object, o);
afcf782003-03-28Martin Stjernholm  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)
5d8d002015-02-11Henrik Grubbström (Grubba)  *! @decl void create(string value, @
f145402015-02-13Martin Nilsson  *! int(2..62)|int(256..256)|int(-256..-256) base)
33bd9a2002-02-06Henrik Grubbström (Grubba)  *! *! 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
f145402015-02-13Martin Nilsson  *! 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), in the range @tt{[37..62]@} (inclusive), in *! which case the ASCII range will be case sensitive, or either of *! the values @expr{256@} or @expr{-256@}, in which case @[value] *! is taken to be the unsigned binary representation in network *! byte order or reversed byte order respectively.
33bd9a2002-02-06Henrik Grubbström (Grubba)  *!
f145402015-02-13Martin Nilsson  *! Values in base @tt{[2..62]@} can be prefixed with @expr{"+"@} or *! @expr{"-"@}. If no base is given, values prefixed with *! @expr{"0b"@} or @expr{"0B"@} will be interpreted as binary. *! Values prefixed with @expr{"0x"@} or @expr{"0X"@} will be *! interpreted as hexadecimal. Values prefixed with @expr{"0"@} *! will be interpreted as octal.
ace2d32012-07-24Martin Nilsson  *!
33bd9a2002-02-06Henrik Grubbström (Grubba)  *! @note
ace2d32012-07-24Martin Nilsson  *! Leading zeroes in @[value] are not significant when a base is *! explicitly given. In particular leading NUL characters are not
5d8d002015-02-11Henrik Grubbström (Grubba)  *! preserved in the base 256 modes.
f145402015-02-13Martin Nilsson  *! *! Before GMP 5.0 only bases 2-36 and 256 were supported.
33bd9a2002-02-06Henrik Grubbström (Grubba)  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_create(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  switch(args) { case 1:
4c73712014-07-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_STRING) { if (sp[-args].u.string->flags & STRING_CLEAR_ON_EXIT) {
65ec122014-12-02Martin Nilsson  THIS_OBJECT->flags |= OBJECT_CLEAR_ON_EXIT;
4c73712014-07-28Henrik Grubbström (Grubba)  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  get_mpz_from_digits(THIS, sp[-args].u.string, 0);
4c73712014-07-28Henrik Grubbström (Grubba)  } else { if ((TYPEOF(sp[-args]) == T_OBJECT) && (sp[-args].u.object->flags & OBJECT_CLEAR_ON_EXIT)) {
65ec122014-12-02Martin Nilsson  THIS_OBJECT->flags |= OBJECT_CLEAR_ON_EXIT;
4c73712014-07-28Henrik Grubbström (Grubba)  }
afcf782003-03-28Martin Stjernholm  get_new_mpz(THIS, sp-args, 1, "Gmp.mpz", 1, args);
4c73712014-07-28Henrik Grubbström (Grubba)  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  break; case 2: /* Args are string of digits and integer base */
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) != T_STRING)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("create", 1, "string");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[1-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("create", 2, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
4c73712014-07-28Henrik Grubbström (Grubba)  if (sp[-args].u.string->flags & STRING_CLEAR_ON_EXIT) {
65ec122014-12-02Martin Nilsson  THIS_OBJECT->flags |= OBJECT_CLEAR_ON_EXIT;
4c73712014-07-28Henrik Grubbström (Grubba)  }
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 __hash()
88f57f2009-10-28Henrik Grubbström (Grubba)  *! *! Calculate a hash of the value. *! *! @note *! Prior to Pike 7.8.359 this function returned the low *! 32-bits as an unsigned integer. This could in some *! common cases lead to very unbalanced mappings. *! *! @seealso *! @[hash_value()]
815ad12003-04-07Martin Nilsson  */
04edf32000-01-09Fredrik Hübinette (Hubbe) static void mpzmod___hash(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
88f57f2009-10-28Henrik Grubbström (Grubba)  MP_INT *mpz = THIS;
34ccc82014-11-03Martin Nilsson  size_t len = mpz_size(mpz) * sizeof(mp_limb_t); size_t h = hashmem(mpz->_mp_d, len, len);
88f57f2009-10-28Henrik Grubbström (Grubba) 
04edf32000-01-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
88f57f2009-10-28Henrik Grubbström (Grubba)  if (mpz_sgn(mpz) < 0)
34ccc82014-11-03Martin Nilsson  push_int(-h);
88f57f2009-10-28Henrik Grubbström (Grubba)  else
34ccc82014-11-03Martin Nilsson  push_int(h); return;
04edf32000-01-09Fredrik 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;
13670c2015-05-25Martin Nilsson 
49f84a2015-02-13Martin Nilsson  if ( #ifdef HAVE_GMP5
ec63112015-02-13Martin Nilsson  (base >= 2) && (base <= 62) /* -2..-36 is also available for upper case conversions, but it's just confusing together with the -256 notation, so let's leave that out of the Pike API. */
49f84a2015-02-13Martin Nilsson #else (base >= 2) && (base <= 36) #endif )
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { 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)  }
5d8d002015-02-11Henrik Grubbström (Grubba)  else if ((base == 256) || (base == -256))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
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) 
2618ee1998-02-11Niels Möller  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. */
06b9af2014-10-31Martin Nilsson #ifdef PIKE_DEBUG
1323f01998-02-11Niels Möller  if (len != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("mpz->low_get_mpz_digits: strange mpz state!\n");
06b9af2014-10-31Martin Nilsson #endif
1323f01998-02-11Niels Möller  s->str[0] = 0;
5d8d002015-02-11Henrik Grubbström (Grubba)  } else if (base < 0) { mpz_export(s->str, NULL, -1, 1, 0, 0, mpz);
1323f01998-02-11Niels Möller  } else {
5d8d002015-02-11Henrik Grubbström (Grubba)  mpz_export(s->str, NULL, 1, 1, 0, 0, mpz);
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");
9282fd2015-09-27Martin Nilsson  UNREACHABLE(return 0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } return s; }
552fc52016-04-17Martin Nilsson /*! @decl string encode_json() * Casts the object to a string.
815ad12003-04-07Martin Nilsson  */
552fc52016-04-17Martin Nilsson static void mpzmod_encode_json(INT32 args)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  push_string(low_get_mpz_digits(THIS, 10));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
ec63112015-02-13Martin Nilsson /*! @decl string digits(void|int(2..62)|int(256..256)|int(-256..-256) base)
cd8be42004-09-15Martin Stjernholm  *! *! Convert this mpz object to a string. If a @[base] is given the
68c8ab2016-04-17Martin Nilsson  *! number will be represented in that base. Valid bases are 2-62 and
5d8d002015-02-11Henrik Grubbström (Grubba)  *! @expr{256@} and @expr{-256@}. The default base is 10.
cd8be42004-09-15Martin Stjernholm  *!
68c8ab2016-04-17Martin Nilsson  *! @note *! The bases 37 to 62 are not available When compiled with GMP *! earlier than version 5.
37de6f2003-04-03Martin Nilsson  *! @seealso
552fc52016-04-17Martin Nilsson  *! @[cast]
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_digits(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  INT32 base;
2ac3721997-09-07Niels Möller  struct pike_string *s;
13670c2015-05-25Martin Nilsson 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!args) { base = 10; } else {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
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) 
65ec122014-12-02Martin Nilsson  debug_malloc_touch(THIS_OBJECT);
13670c2015-05-25Martin Nilsson 
c7549a2003-01-26Martin Nilsson  if(args < 2)
06bd612016-01-26Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR("_sprintf", 2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("_sprintf", 1, "int");
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[1-args]) != T_MAPPING)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("_sprintf", 2, "mapping");
4f8deb1999-10-26Fredrik Noring  push_svalue(&sp[1-args]);
75367d2014-08-22Arne Goedeke  push_static_text("precision");
4f8deb1999-10-26Fredrik Noring  f_index(2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("_sprintf", 2,
afcf782003-03-28Martin Stjernholm  "The field \"precision\" doesn't hold an integer.");
4f8deb1999-10-26Fredrik Noring  precision = (--sp)->u.integer;
13670c2015-05-25Martin Nilsson 
eccd0a1999-10-29Fredrik Noring  push_svalue(&sp[1-args]);
75367d2014-08-22Arne Goedeke  push_static_text("width");
eccd0a1999-10-29Fredrik Noring  f_index(2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("_sprintf", 2,
afcf782003-03-28Martin Stjernholm  "The field \"width\" doesn't hold an integer.");
017b572011-10-28Henrik Grubbström (Grubba)  width_undecided = (SUBTYPEOF(sp[-1]) != NUMBER_NUMBER);
eccd0a1999-10-29Fredrik Noring  width = (--sp)->u.integer;
310f601999-11-01Mirar (Pontus Hagland)  push_svalue(&sp[1-args]);
75367d2014-08-22Arne Goedeke  push_static_text("flag_left");
310f601999-11-01Mirar (Pontus Hagland)  f_index(2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("_sprintf", 2,
afcf782003-03-28Martin Stjernholm  "The field \"flag_left\" doesn't hold an integer.");
310f601999-11-01Mirar (Pontus Hagland)  flag_left=sp[-1].u.integer; pop_stack();
65ec122014-12-02Martin Nilsson  debug_malloc_touch(THIS_OBJECT);
1864682001-09-20Fredrik Hübinette (Hubbe) 
e9be8e2002-03-08Henrik Grubbström (Grubba)  switch(method = sp[-args].u.integer)
10f5031999-10-21Fredrik Noring  {
3905cf1999-11-11Fredrik Hübinette (Hubbe)  case 't': pop_n_elems(args); if(THIS_PROGRAM == bignum_program)
75367d2014-08-22Arne Goedeke  push_static_text("int");
3905cf1999-11-11Fredrik Hübinette (Hubbe)  else
75367d2014-08-22Arne Goedeke  push_static_text("object");
3905cf1999-11-11Fredrik Hübinette (Hubbe)  return;
fef5d02003-03-29Martin Stjernholm 
4f8deb1999-10-26Fredrik Noring  case 'O':
fef5d02003-03-29Martin Stjernholm  if (THIS_PROGRAM == mpzmod_program) {
5e9fc02015-08-18Per Hedbor  push_static_text ("Gmp.mpz(");
fef5d02003-03-29Martin Stjernholm  push_string (low_get_mpz_digits (THIS, 10));
5e9fc02015-08-18Per Hedbor  push_static_text (")");
fef5d02003-03-29Martin Stjernholm  f_add (3); s = (--sp)->u.string; break; } /* 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;
13670c2015-05-25Martin Nilsson 
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; }
13670c2015-05-25Martin Nilsson 
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;
13670c2015-05-25Martin Nilsson 
eccd0a1999-10-29Fredrik Noring  s = begin_shared_string(width);
13670c2015-05-25Martin Nilsson 
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) {
b6ff9d2014-10-31Martin Nilsson  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++) {
cc7cf42015-10-14Martin Nilsson  *(--dst) = (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++) {
cc7cf42015-10-14Martin Nilsson  *(dst++) = (unsigned char)((neg ? ~x : x) & 0xff);
310f601999-11-01Mirar (Pontus Hagland)  x >>= 8; if(!--width) break; }
eccd0a1999-10-29Fredrik Noring  }
13670c2015-05-25Martin Nilsson 
eccd0a1999-10-29Fredrik Noring  if(neg) { mpz_clear(tmp); }
13670c2015-05-25Martin Nilsson 
eccd0a1999-10-29Fredrik Noring  s = end_shared_string(s); } break;
10f5031999-10-21Fredrik Noring  }
65ec122014-12-02Martin Nilsson  debug_malloc_touch(THIS_OBJECT);
1864682001-09-20Fredrik Hübinette (Hubbe) 
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 {
017b572011-10-28Henrik Grubbström (Grubba)  push_undefined();
eccd0a1999-10-29Fredrik Noring  }
10f5031999-10-21Fredrik Noring }
772d1a2014-05-22Per Hedbor /* protected int(0..1) _is_type(string type)
815ad12003-04-07Martin Nilsson  */
b359622014-07-28Per Hedbor static void mpzmod__is_type(INT32 UNUSED(args))
10f5031999-10-21Fredrik Noring {
772d1a2014-05-22Per Hedbor  int is_int;
6a932b2014-08-18Martin Nilsson  is_int = Pike_sp[-1].u.string == literal_int_string ? 1 : 0;
772d1a2014-05-22Per Hedbor  pop_stack(); push_int( is_int );
10f5031999-10-21Fredrik Noring }
9eeb732014-04-12Henrik Grubbström (Grubba) /*! @decl int(0..) 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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  int base; if (!args) { /* Default is number of bits */ base = 2; } else {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("size", 1, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  base = sp[-args].u.integer;
67a49f2015-02-13Martin Nilsson  if ((base != 256) && (base != -256) && ((base < 2) || (base > 62)))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("size", 1, "Invalid base.");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } pop_n_elems(args);
67a49f2015-02-13Martin Nilsson  if (base == 256 || base == -256)
c77d152016-05-17Per Hedbor  push_int((mpz_sizeinbase(THIS, 2) + 7) / 8);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  else
c77d152016-05-17Per Hedbor  push_int(mpz_sizeinbase(THIS, base));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
7a74cc2014-08-26Per Hedbor /*! @decl string|int|float 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  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_cast(INT32 args) {
552fc52016-04-17Martin Nilsson  DECLARE_THIS();
68ec3f2014-08-18Martin Nilsson  struct pike_string *s = sp[-args].u.string;
7f3b992014-10-28Per Hedbor  if( args ) pop_stack(); /* s have at least one more reference. */
68ec3f2014-08-18Martin Nilsson  if( s == literal_int_string )
552fc52016-04-17Martin Nilsson  { add_ref(THIS_OBJECT); mpzmod_reduce(THIS_OBJECT); if( TYPEOF(Pike_sp[-1]) == T_OBJECT && Pike_sp[-1].u.object->prog != bignum_program ) { push_object(clone_object(bignum_program, 1)); } return; }
68ec3f2014-08-18Martin Nilsson  else if( s == literal_string_string )
552fc52016-04-17Martin Nilsson  push_string(low_get_mpz_digits(THIS, 10));
68ec3f2014-08-18Martin Nilsson  else if( s == literal_float_string )
552fc52016-04-17Martin Nilsson  push_float((FLOAT_TYPE)mpz_get_d(THIS));
68ec3f2014-08-18Martin Nilsson  else push_undefined();
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) double double_from_sval(struct svalue *s) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*s))
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  { case T_INT: return (double)s->u.integer; case T_FLOAT: return (double)s->u.float_number;
13670c2015-05-25Martin Nilsson  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));
5736aa2015-04-18Martin Nilsson  /* Fallthrough */
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  default:
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Bad argument, expected a number of some sort.\n");
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  }
9282fd2015-09-27Martin Nilsson  UNREACHABLE(return (double)0.0);
4d21fc1999-12-15Fredrik Hübinette (Hubbe) }
fda0de1999-10-08Fredrik Noring 
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) \ { \
8f6a362014-12-02Martin Nilsson  DECLARE_THIS(); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  INT32 e; \ struct object *res; \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e-args])) \
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 && \
017b572011-10-28Henrik Grubbström (Grubba)  ((p = o->prog->inherits[SUBTYPEOF(sp[e-args])].prog) != \
b5e4fe2005-09-15Henrik Grubbström (Grubba)  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++; \
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(Pike_sp[-args], T_OBJECT, 0 /* FIXME? */, object, \
65ec122014-12-02Martin Nilsson  THIS_OBJECT); \ add_ref(THIS_OBJECT); \
b5e4fe2005-09-15Henrik Grubbström (Grubba)  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: \
68c0a82014-09-03Martin Nilsson  memmove(sp-args+1, sp-args, sizeof(struct svalue)*args); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  sp++; args++; \
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL_TYPE(sp[-args], PIKE_T_FREE); \ SET_SVAL(sp[-args], T_STRING, 0, string, \ low_get_mpz_digits(THIS, 10)); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  f_add(args); \ return; ) \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  } \ } \
0311712013-06-17Martin Nilsson  } \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  for(e=0; e<args; e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "`" 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++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  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) \ { \
8f6a362014-12-02Martin Nilsson  DECLARE_THIS(); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  INT32 e; \ struct object *res; \ if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e-args])) \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  { \ 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; \ } \ } \
0311712013-06-17Martin Nilsson  } \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  for(e=0; e<args; e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "``" 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++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT) \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  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); \ } \
7ce9dd2014-08-13Per Hedbor )
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
6547ef2000-03-01Fredrik Hübinette (Hubbe) #define STRINGCONV(X) X
815ad12003-04-07Martin Nilsson 
7ce9dd2014-08-13Per Hedbor static void mpzmod_add_eq(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
7ce9dd2014-08-13Per Hedbor  INT32 e; if(THIS_PROGRAM == bignum_program) { double ret; for(e=0; e<args; e++) { switch(TYPEOF(sp[e-args])) { case T_FLOAT: ret=mpz_get_d(THIS); for(e=0; e<args; e++) ret = ret + double_from_sval(sp-args); pop_n_elems(args); push_float( (FLOAT_TYPE)ret ); return; case T_STRING:
68c0a82014-09-03Martin Nilsson  memmove(sp-args+1, sp-args, sizeof(struct svalue)*args);
7ce9dd2014-08-13Per Hedbor  sp++; args++; SET_SVAL_TYPE(sp[-args], PIKE_T_FREE); SET_SVAL(sp[-args], T_STRING, 0, string, low_get_mpz_digits(THIS, 10)); f_add(args); return; } } } for(e=0; e<args; e++) if(TYPEOF(sp[e-args]) != T_INT || !FITS_ULONG (sp[e-args].u.integer))
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "`+", e + 1, args);
7ce9dd2014-08-13Per Hedbor  for(e=0;e<args;e++) if(TYPEOF(sp[e-args]) != T_INT) mpz_add(THIS, THIS, OBTOMPZ(sp[e-args].u.object)); else mpz_add_ui(THIS,THIS, sp[e-args].u.integer);
65ec122014-12-02Martin Nilsson  add_ref(THIS_OBJECT); PUSH_REDUCED(THIS_OBJECT);
7ce9dd2014-08-13Per Hedbor }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `+(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``+(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
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 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `*(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``*(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
b5e4fe2005-09-15Henrik Grubbström (Grubba) BINFUN2(mpzmod_mul, "*", mpz_mul, *, f_multiply, MULTIPLY)
ee37801999-02-09Fredrik Hübinette (Hubbe) 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz gcd(object|int|float|string ... args)
7ce9dd2014-08-13Per Hedbor  *!
cd8be42004-09-15Martin Stjernholm  *! 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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  INT32 e; struct object *res; for(e=0; e<args; e++)
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || sp[e-args].u.integer<=0)
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "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++)
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT) mpz_gcd(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object));
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  else mpz_gcd_ui(OBTOMPZ(res), OBTOMPZ(res),sp[e-args].u.integer); pop_n_elems(args); PUSH_REDUCED(res); }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `-(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sub(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  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++)
de22f72014-08-25Martin Nilsson  get_mpz(sp + e - args, 1, "`-", e + 1, args);
13670c2015-05-25Martin Nilsson 
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) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``-(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rsub(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
13670c2015-05-25Martin Nilsson 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``-", 1);
afcf782003-03-28Martin Stjernholm 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
d8f9ad2016-05-30Per Hedbor  mpz_sub(OBTOMPZ(res), get_mpz(sp-1, 1, "``-", 1, 1), THIS);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `/(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_div(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  INT32 e;
79042c1997-03-11Niels Möller  struct object *res;
13670c2015-05-25Martin Nilsson 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || sp[e-args].u.integer<=0)
de22f72014-08-25Martin Nilsson  if (!mpz_sgn(get_mpz(sp+e-args, 1, "`/", e + 1, args))) SIMPLE_DIVISION_BY_ZERO_ERROR ("`/");
80a0e41999-03-02Fredrik Hübinette (Hubbe)  }
13670c2015-05-25Martin Nilsson 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
79042c1997-03-11Niels Möller  mpz_set(OBTOMPZ(res), THIS);
13670c2015-05-25Martin Nilsson  for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) == 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 {
de22f72014-08-25Martin Nilsson  MP_INT *tmp=get_mpz(sp+e-args,1,"`/",e,e);
a58a972004-02-17Mirar (Pontus Hagland)  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) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``/(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rdiv(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  MP_INT *a;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``/", 1);
afcf782003-03-28Martin Stjernholm  if(!mpz_sgn(THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("``/");
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
de22f72014-08-25Martin Nilsson  a=get_mpz(sp-1, 1, "``/", 1, 1);
13670c2015-05-25Martin Nilsson 
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) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `%(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_mod(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  INT32 e;
79042c1997-03-11Niels Möller  struct object *res;
13670c2015-05-25Martin Nilsson 
79042c1997-03-11Niels Möller  for(e=0;e<args;e++)
de22f72014-08-25Martin Nilsson  if (!mpz_sgn(get_mpz(sp+e-args, 1, "`%", e + 1, args))) SIMPLE_DIVISION_BY_ZERO_ERROR ("`%");
afcf782003-03-28Martin Stjernholm 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  mpz_set(OBTOMPZ(res), THIS);
13670c2015-05-25Martin Nilsson  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) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``%(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rmod(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  MP_INT *a;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``%", 1);
afcf782003-03-28Martin Stjernholm  if(!mpz_sgn(THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("``%");
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
de22f72014-08-25Martin Nilsson  a=get_mpz(sp-1, 1, "``%", 1, 1);
13670c2015-05-25Martin Nilsson 
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  struct object *g, *s, *t; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("gcdext", 1);
0226201997-03-10Niels Möller 
de22f72014-08-25Martin Nilsson  a = get_mpz(sp-1, 1, "gcdext", 1, 1);
13670c2015-05-25Martin Nilsson 
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  struct object *g, *s; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("gcdext2", 1);
0226201997-03-10Niels Möller 
de22f72014-08-25Martin Nilsson  a = get_mpz(sp-args, 1, "gcdext2", 1, 1);
13670c2015-05-25Martin Nilsson 
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);
13670c2015-05-25Martin Nilsson  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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  MP_INT *modulo;
0226201997-03-10Niels Möller  struct object *res;
79042c1997-03-11Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("invert", 1); modulo = get_mpz(sp-1, 1, "invert", 1, 1);
afcf782003-03-28Martin Stjernholm 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!mpz_sgn(modulo))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
cd8be42004-09-15Martin Stjernholm  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); } /*! @decl Gmp.mpz bin(int k)
7ce9dd2014-08-13Per Hedbor  *!
cd8be42004-09-15Martin Stjernholm  *! 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. */ static void mpzmod_bin(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
cd8be42004-09-15Martin Stjernholm  MP_INT *k; struct object *res; if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("bin", 1); k = get_mpz (sp-1, 1, "bin", 1, 1);
cd8be42004-09-15Martin Stjernholm  if (mpz_sgn (k) < 0) Pike_error ("Cannot calculate binomial with negative k value.\n"); if (!mpz_fits_ulong_p (k))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("bin", 1, "Argument too large.\n");
cd8be42004-09-15Martin Stjernholm  res = fast_clone_object(THIS_PROGRAM); mpz_bin_ui (OBTOMPZ (res), THIS, mpz_get_ui (k)); pop_n_elems(args); PUSH_REDUCED(res); }
afcf782003-03-28Martin Stjernholm #define BINFUN(name, errmsg_name, fun) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) static void name(INT32 args) \ { \
8f6a362014-12-02Martin Nilsson  DECLARE_THIS(); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  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); \ }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `&(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
de22f72014-08-25Martin Nilsson BINFUN(mpzmod_and, "`&", mpz_and)
815ad12003-04-07Martin Nilsson 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `|(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
de22f72014-08-25Martin Nilsson BINFUN(mpzmod_or, "`|", mpz_ior)
815ad12003-04-07Martin Nilsson 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `^(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
de22f72014-08-25Martin Nilsson BINFUN(mpzmod_xor, "`^", 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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  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) }
06bd612016-01-26Martin Nilsson #define CMPEQU(name,errmsg_name,cmp,default) \ static void name(INT32 args) \ { \ DECLARE_THIS(); \ INT32 i; \ MP_INT *arg; \ if(!args) SIMPLE_WRONG_NUM_ARGS_ERROR (errmsg_name, 1); \ if (!(arg = get_mpz(sp-args, 0, NULL, 0, 0))) \ default; \ else \ i=mpz_cmp(THIS, arg) cmp 0; \ pop_n_elems(args); \ push_int(i); \
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
7050b62016-06-03Per Hedbor #define RET_UNDEFINED do{push_undefined();return;}while(0)
d4bf622001-08-13Fredrik Hübinette (Hubbe) 
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) `>(mixed with) */
de22f72014-08-25Martin Nilsson CMPEQU(mpzmod_gt, "`>", >, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `<(mixed with) */
de22f72014-08-25Martin Nilsson CMPEQU(mpzmod_lt, "`<", <, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `==(mixed with) */
de22f72014-08-25Martin Nilsson CMPEQU(mpzmod_eq, "`==", ==, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson 
47456b2014-09-01Martin Nilsson /*! @decl int(0..1) probably_prime_p(int count)
cd8be42004-09-15Martin Stjernholm  *! *! Return 1 if this mpz object is a prime, and 0 most of the time if *! it is not.
47456b2014-09-01Martin Nilsson  *! *! @param count *! The prime number testing is using Donald Knuth's probabilistic *! primality test. The chance for a false positive is *! pow(0.25,count). The higher value, the more probable it is that *! the number is a prime. Default value is 25.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_probably_prime_p(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
65a5492000-08-10Per Hedbor  INT_TYPE count;
7da3191997-04-25Niels Möller  if (args) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("probably_prime_p", 1, "int(1..)");
afcf782003-03-28Martin Stjernholm  count = sp[-args].u.integer;
7da3191997-04-25Niels Möller  if (count <= 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("probably_prime_p", 1, "int(1..)");
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)); }
45f4322014-10-14Martin Nilsson /* Define NUMBER_OF_PRIMES and primes[] */
6117ef2014-12-07Tobias S. Josefowitz #include "prime_table.h"
45f4322014-10-14Martin Nilsson  /* Returns a small factor of n, or 0 if none is found.*/ static unsigned long mpz_small_factor(mpz_t n, int limit) { int i; unsigned long stop; if (limit > NUMBER_OF_PRIMES) limit = NUMBER_OF_PRIMES; stop = mpz_get_ui(n); if (mpz_cmp_ui(n, stop) != 0) stop = ULONG_MAX; stop = (long)sqrt(stop)+1; for (i = 0; (i < limit) && primes[i] < stop; i++) if (mpz_fdiv_ui(n, primes[i]) == 0) return primes[i]; return 0; }
815ad12003-04-07Martin Nilsson /*! @decl int small_factor(void|int(1..) limit) */
7da3191997-04-25Niels Möller static void mpzmod_small_factor(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
65a5492000-08-10Per Hedbor  INT_TYPE limit;
7da3191997-04-25Niels Möller  if (args) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("small_factor", 1, "int(1..)");
afcf782003-03-28Martin Stjernholm  limit = sp[-args].u.integer;
bd44cf1997-04-26Niels Möller  if (limit < 1)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("small_factor", 1, "int(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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
7da3191997-04-25Niels Möller  struct object *o; pop_n_elems(args);
13670c2015-05-25Martin Nilsson 
195b1c2003-02-15Henrik Grubbström (Grubba)  o = fast_clone_object(THIS_PROGRAM);
18a04e2014-05-05Martin Nilsson  mpz_nextprime(OBTOMPZ(o), THIS);
1598411999-10-20Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl int sgn()
d493622013-08-05Martin Nilsson  *! *! Return the sign of the integer, i.e. @expr{1@} for positive *! numbers and @expr{-1@} for negative numbers.
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sgn(INT32 args) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
9a44a41999-10-30Fredrik Noring  struct object *root = 0, *rem = 0; /* Make gcc happy. */
13670c2015-05-25Martin Nilsson 
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
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)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("`<<", 1);
afcf782003-03-28Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_INT) {
126bf22002-10-15Marcus Comstedt  if(sp[-1].u.integer < 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 1, "Got negative shift count.");
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT if (!FITS_ULONG (sp[-1].u.integer) && mpz_sgn (THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 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 {
de22f72014-08-25Martin Nilsson  mi = get_mpz(sp-1, 1, "`<<", 1, 1);
8632802003-10-11Henrik Grubbström (Grubba)  if(mpz_sgn(mi)<0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 1, "Got negative shift count.");
c77d152016-05-17Per Hedbor  if(!mpz_fits_ulong_p(mi))
99c6912003-01-27Mirar (Pontus Hagland)  { if(mpz_sgn(THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("`>>", 1);
afcf782003-03-28Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_INT)
3275be2003-01-27Mirar (Pontus Hagland)  { if (sp[-1].u.integer < 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`>>", 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);
13670c2015-05-25Martin Nilsson  }
3275be2003-01-27Mirar (Pontus Hagland)  }
9c96882003-03-29Martin Stjernholm  else
3275be2003-01-27Mirar (Pontus Hagland)  {
de22f72014-08-25Martin Nilsson  MP_INT *mi = get_mpz(sp-1, 1, "`>>", 1, 1);
afcf782003-03-28Martin Stjernholm  if(!mpz_fits_ulong_p (mi)) { if(mpz_sgn(mi)<0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`>>", 1, "Got negative shift count.");
afcf782003-03-28Martin Stjernholm  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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
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)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``<<", 1);
8632802003-10-11Henrik Grubbström (Grubba)  if(mpz_sgn(THIS) < 0) Pike_error ("Gmp.mpz->``<<(): Got negative shift count.\n");
de22f72014-08-25Martin Nilsson  mi = get_mpz(sp-1, 1, "``<<", 1, 1);
afcf782003-03-28Martin Stjernholm 
8632802003-10-11Henrik Grubbström (Grubba)  /* Cut off at 1MB ie 0x800000 bits. */
c77d152016-05-17Per Hedbor  if(!mpz_fits_ulong_p(THIS)) {
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
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)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``>>", 1); mi = get_mpz(sp-1, 1, "``>>", 1, 1);
afcf782003-03-28Martin Stjernholm  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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *n, *e;
13670c2015-05-25Martin Nilsson 
0226201997-03-10Niels Möller  if(args != 2)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("powm", 2);
afcf782003-03-28Martin Stjernholm 
de22f72014-08-25Martin Nilsson  e = get_mpz(sp - 2, 1, "powm", 1, 2); n = get_mpz(sp - 1, 1, "powm", 2, 2);
0226201997-03-10Niels Möller  if (!mpz_sgn(n))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("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) }
c95e962016-05-18Per Hedbor /*! @decl Gmp.mpz `**(int|float|Gmp.mpz x) *! *! Return x raised to the value of this object. The case when zero is *! raised to zero yields one. *! *! @seealso *! @[pow] */ static void mpzmod_rpow(INT32 args) { struct object *res; DECLARE_THIS(); if( TYPEOF(sp[-1]) == PIKE_T_FLOAT ) { sp[-1].u.float_number = pow(sp[-1].u.float_number, mpz_get_d(THIS)); return; } if( mpz_sgn(THIS) < 0 ) /* integer whatever ** -x -> 0 */ { push_int(0); return; } if( mpz_sgn(THIS) == 0 ) { push_int(1); return; } { unsigned long power = mpz_get_ui( THIS ); res = fast_clone_object(THIS_PROGRAM); if( TYPEOF(sp[-1]) == PIKE_T_INT ) { mpz_ui_pow_ui(OBTOMPZ(res), sp[-1].u.integer, power); } else { MP_INT *mi = get_mpz(sp-1, 1, "rpow", 1, 1); mpz_pow_ui(OBTOMPZ(res), mi, power); } } pop_stack(); PUSH_REDUCED(res); }
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
d96bb82003-02-07Mirar (Pontus Hagland)  MP_INT *mi;
c95e962016-05-18Per Hedbor  unsigned long exponent;
73f7de2016-05-29Martin Nilsson  size_t size;
7050b62016-06-03Per Hedbor  double ep;
6088882016-05-17Per Hedbor 
79042c1997-03-11Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("pow", 1);
c95e962016-05-18Per Hedbor  if (TYPEOF(sp[-1]) == T_INT) {
7050b62016-06-03Per Hedbor  if( sp[-1].u.integer < 0 )
c95e962016-05-18Per Hedbor  { push_int(0); return;
126bf22002-10-15Marcus Comstedt  }
7050b62016-06-03Per Hedbor  exponent = sp[-1].u.integer; } else if( TYPEOF(sp[-1]) == PIKE_T_FLOAT ) { sp[-1].u.float_number = pow(mpz_get_d(THIS),sp[-1].u.float_number); return; } if( TYPEOF(sp[-1]) == PIKE_T_OBJECT ) { double tmp; if( sp[-1].u.object->prog == mpq_program ) { // could use rpow in mpq.. But it does not handle mpz objects. tmp = mpq_get_d( (mpq_t*)sp[-1].u.object->storage ); push_float( pow(mpz_get_d(THIS),tmp) ); return; } else if( sp[-1].u.object->prog == mpf_program ) { tmp = mpf_get_d( (mpq_t*)sp[-1].u.object->storage ); push_float( pow(mpz_get_d(THIS),tmp) ); return; } else { mi = get_mpz(sp-1, 1, "pow", 1, 1); if(mpz_sgn(mi)<0) { pop_n_elems(args); push_int(0); return; } exponent=mpz_get_ui(mi); }
126bf22002-10-15Marcus Comstedt  }
c95e962016-05-18Per Hedbor 
ea34742016-05-29Henrik Grubbström (Grubba)  /* Cut off at 1GB. */ size = mpz_size(THIS); if (INT_TYPE_MUL_OVERFLOW(exponent, size) || size * exponent > (INT_TYPE)(0x40000000/sizeof(mp_limb_t))) { if(mpz_cmp_si(THIS, -1)<0 || mpz_cmp_si(THIS, 1)>0) SIMPLE_ARG_ERROR ("pow", 1, "Exponent too large."); }
c95e962016-05-18Per Hedbor  res = fast_clone_object(THIS_PROGRAM); mpz_pow_ui(OBTOMPZ(res), THIS, exponent);
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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
78130c1998-07-19Niels Möller  pop_n_elems(args);
91d0102014-10-14Martin Nilsson  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
78130c1998-07-19Niels Möller }
d4357f2015-02-13Martin Nilsson /*! @decl int hamdist(int x) *! Calculates the hamming distance between this number and @[x]. */ static void mpzmod_hamdist(INT32 args) { DECLARE_THIS(); MP_INT *x; if (args != 1) SIMPLE_WRONG_NUM_ARGS_ERROR ("hamdist", 1); x = get_mpz(sp-1, 1, "hamdist", 1, 1); push_int(mpz_hamdist(THIS, x)); stack_swap(); pop_stack(); }
5353542016-03-20Henrik Grubbström (Grubba) /*! @decl Gmp.mpz _random(function(int:string(8bit)) random_string, @ *! function(mixed:mixed) random)
815ad12003-04-07Martin Nilsson  */ static void mpzmod_random(INT32 args) {
8be35f2016-04-08Henrik Grubbström (Grubba)  struct object *res;
22856a2016-04-16Henrik Grubbström (Grubba)  MP_INT *mpz_res; unsigned bits, bytes; mp_limb_t mask;
68c8ab2016-04-17Martin Nilsson  int i, fast=0;
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
1cff4e2016-03-09Martin Nilsson 
5353542016-03-20Henrik Grubbström (Grubba)  /* NB: Nominally we could survive with just one argument too, but... */ if (args != 2) SIMPLE_WRONG_NUM_ARGS_ERROR("_random", 2);
815ad12003-04-07Martin Nilsson  if(mpz_sgn(THIS) <= 0)
e5affd2016-03-30Martin Nilsson  { push_int(0); return; }
815ad12003-04-07Martin Nilsson 
1cff4e2016-03-09Martin Nilsson  /* On stack: random_string, random */ pop_stack();
5353542016-03-20Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_FUNCTION)
1cff4e2016-03-09Martin Nilsson  Pike_error("_random called with non-function argument.\n");
5353542016-03-20Henrik Grubbström (Grubba) 
8be35f2016-04-08Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
4883e42016-03-19Martin Nilsson  push_object(res); stack_swap();
0f7d6e2016-02-23Henrik Grubbström (Grubba) 
22856a2016-04-16Henrik Grubbström (Grubba)  /* On stack: res, random_string */ mpz_res = OBTOMPZ(res);
8be35f2016-04-08Henrik Grubbström (Grubba)  bits = mpz_sizeinbase(THIS, 2); bytes = ((bits-1)>>3)+1;
22856a2016-04-16Henrik Grubbström (Grubba)  mask = (1UL<<(bits & ((sizeof(mp_limb_t)<<3) - 1)))-1;
0985192016-03-19Martin Nilsson 
22856a2016-04-16Henrik Grubbström (Grubba)  if (mpz_popcount(THIS) == 1) { /* The number of bits is a power of 2.
77ce1d2016-03-29Henrik Grubbström (Grubba)  * Ie the most significant bit of the masked result * should always be zero, so we can shrink the mask. */
22856a2016-04-16Henrik Grubbström (Grubba)  if (!mask) { mask = ~0; }
77ce1d2016-03-29Henrik Grubbström (Grubba)  mask >>= 1;
22856a2016-04-16Henrik Grubbström (Grubba)  bits--;
0985192016-03-19Martin Nilsson 
ee35072016-04-17Henrik Grubbström (Grubba)  /* There's also no need to compare the limit, as * all bitpatterns are valid after masking. */ fast=1;
22856a2016-04-16Henrik Grubbström (Grubba)  if (!(bits & 0x07)) { /* One less byte of random data needed. */ bytes--;
ee35072016-04-17Henrik Grubbström (Grubba)  fast = 2; /* No need for masking either. */
9bcc382016-03-29Martin Nilsson  }
22856a2016-04-16Henrik Grubbström (Grubba)  } if (!(bits & 0x07)) { /* Whole number of bytes. No need for masking. */ mask = 0; }
0985192016-03-19Martin Nilsson 
22856a2016-04-16Henrik Grubbström (Grubba)  i = 0; do {
0985192016-03-19Martin Nilsson  // FIXME: We replace the entire string if we are too large. We // could be smarter here, but it's easy to introduce bias by // mistake. push_int(bytes); apply_svalue(&sp[-2], 1);
22856a2016-04-16Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_STRING)
0985192016-03-19Martin Nilsson  Pike_error("random_string(%ld) returned non string.\n", bytes);
4ae9502016-03-19Martin Nilsson  if ((unsigned)sp[-1].u.string->len != bytes ||
22856a2016-04-16Henrik Grubbström (Grubba)  sp[-1].u.string->size_shift != 0)
0985192016-03-19Martin Nilsson  Pike_error("Wrong size random string generated.\n");
22856a2016-04-16Henrik Grubbström (Grubba)  mpz_import(mpz_res, bytes, 1, 1, 0, 0, sp[-1].u.string->str);
0985192016-03-19Martin Nilsson  pop_stack();
22856a2016-04-16Henrik Grubbström (Grubba) 
ee35072016-04-17Henrik Grubbström (Grubba)  if (fast == 2) {
22856a2016-04-16Henrik Grubbström (Grubba)  /* We've decreased the number of bytes above. * Ie we have the special case of an even number of random bytes. */ goto done; } if (mask && (mpz_res->_mp_size == THIS->_mp_size)) { /* Apply the mask. */ /* * CAVEAT: We're messing with Gmp internals here... */ /* NB: res is always positive, so the subtraction is safe. */ mpz_res->_mp_d[mpz_res->_mp_size - 1] &= mask; /* Get rid of leading zero limbs. Otherwise gmp will get * sad and zap innocent memory. */ while (mpz_res->_mp_size && !mpz_res->_mp_d[mpz_res->_mp_size - 1]) { mpz_res->_mp_size--; } }
ee35072016-04-17Henrik Grubbström (Grubba)  if( fast || mpz_cmp(THIS, mpz_res) > 0 )
22856a2016-04-16Henrik Grubbström (Grubba)  goto done; /* NB: With a rectangular distribution we have a probability * of success of at least 50% in the test above, so the * failure rate is less than 1 in 2^1000. */ } while (++i < 1000);
d853232016-03-29Henrik Grubbström (Grubba)  Pike_error("Unable to generate random data.\n");
0985192016-03-19Martin Nilsson  done:
22856a2016-04-16Henrik Grubbström (Grubba)  /* Pop the random_string() function. */
0985192016-03-19Martin Nilsson  pop_stack();
5353542016-03-20Henrik Grubbström (Grubba)  /* res is now at the top of the stack. Reduce it. */
03cc312003-06-10Henrik Grubbström (Grubba)  Pike_sp--; dmalloc_touch_svalue(Pike_sp);
815ad12003-04-07Martin Nilsson  PUSH_REDUCED(res); }
176e052009-11-17Henrik Grubbström (Grubba)  /*! @decl string(0..255) _encode()
13670c2015-05-25Martin Nilsson  */
176e052009-11-17Henrik Grubbström (Grubba) static void mpzmod__encode(INT32 args) { pop_n_elems(args); /* 256 would be better, but then negative numbers * won't work... /Hubbe */ push_int(36); mpzmod_digits(1); } /*! @decl void _decode(string(0..255)) */ static void mpzmod__decode(INT32 args) { /* 256 would be better, but then negative numbers * won't work... /Hubbe */ push_int(36); mpzmod_create(args+1); }
815ad12003-04-07Martin Nilsson /*! @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) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
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");
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("fac", 1, "int");
79042c1997-03-11Niels Möller  if (sp[-1].u.integer < 0)
c95e962016-05-18Per Hedbor  SIMPLE_ARG_ERROR ("fac", 1, "Got negative factorial.");
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) 
b359622014-07-28Per Hedbor static void mpzmod__size_object(INT32 UNUSED(args)) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
3f16a62014-12-17Henrik Grubbström (Grubba)  push_int(ALIMBS(THIS) * sizeof(mp_limb_t) + sizeof(mpz_t));
b359622014-07-28Per Hedbor }
74dfe82012-12-30Jonas Walldén static void init_mpz_glue(struct object * UNUSED(o))
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_init(THIS); }
74dfe82012-12-30Jonas Walldén static void exit_mpz_glue(struct object *UNUSED(o))
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
65ec122014-12-02Martin Nilsson  if( THIS_OBJECT->flags & OBJECT_CLEAR_ON_EXIT )
3f16a62014-12-17Henrik Grubbström (Grubba)  memset(LIMBS(THIS), 0, ALIMBS(THIS) * sizeof(mp_limb_t));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_clear(THIS); }
ad8d052008-05-02Martin Stjernholm  static void gc_recurse_mpz (struct object *o) {
8f6a362014-12-02Martin Nilsson  DECLARE_THIS();
b3f6732008-05-11Martin Stjernholm  if (mc_count_bytes (o))
3f16a62014-12-17Henrik Grubbström (Grubba)  mc_counted_bytes += ALIMBS(THIS) * sizeof(mp_limb_t) + sizeof(mpz_t);
ad8d052008-05-02Martin Stjernholm }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
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; }
74dfe82012-12-30Jonas Walldén static void pike_mp_free (void *ptr, size_t UNUSED(size))
64474b2008-03-28Martin Stjernholm { free (ptr); }
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_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); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`==",mpzmod_eq,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); \
696ae12014-10-28Per Hedbor  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)  \
19426a2013-05-19Martin Nilsson  ADD_FUNCTION("digits", mpzmod_digits,tFunc(tOr(tVoid,tInt),tStr8), 0);\
552fc52016-04-17Martin Nilsson  ADD_FUNCTION("encode_json", mpzmod_encode_json, \
19426a2013-05-19Martin Nilsson  tFunc(tOr(tVoid,tInt) tOr(tVoid,tInt),tStr7), 0); \
815ad12003-04-07Martin Nilsson  ADD_FUNCTION("_sprintf", mpzmod__sprintf, tFunc(tInt tMapping,tStr), \
ecc9382008-06-29Martin Nilsson  ID_PROTECTED); \
b359622014-07-28Per Hedbor  ADD_FUNCTION("_size_object",mpzmod__size_object, tFunc(tVoid,tInt),0);\
9eeb732014-04-12Henrik Grubbström (Grubba)  ADD_FUNCTION("size", mpzmod_size,tFunc(tOr(tVoid,tInt),tIntPos), 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ ADD_FUNCTION("probably_prime_p",mpzmod_probably_prime_p, \
47456b2014-09-01Martin Nilsson  tFunc(tOr(tVoid,tIntPos),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); \
91d0102014-10-14Martin Nilsson  ADD_FUNCTION("bin", mpzmod_bin, tFunc(tMpz_arg,tMpz_ret), 0); \
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); \
91d0102014-10-14Martin Nilsson  ADD_FUNCTION("sqrtrem",mpzmod_sqrtrem,tFunc(tNone,tArr(tMpz_ret)),0); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  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); \
fbff332016-05-17Per Hedbor  ADD_FUNCTION("`**", mpzmod_pow,tMpz_shift_type, 0); \
c95e962016-05-18Per Hedbor  ADD_FUNCTION("``**", mpzmod_rpow,tMpz_shift_type, 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ ADD_FUNCTION("popcount", mpzmod_popcount,tFunc(tVoid,tInt), 0); \
d4357f2015-02-13Martin Nilsson  ADD_FUNCTION("hamdist", mpzmod_hamdist,tFunc(tMpz_arg,tInt), 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
d7fdf72016-03-09Martin Nilsson  ADD_FUNCTION("_random",mpzmod_random,tFunc(tFunction tFunction,tMpz_ret),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
176e052009-11-17Henrik Grubbström (Grubba)  ADD_FUNCTION("_encode",mpzmod__encode,tFunc(tNone,tStr8),0); \ \ ADD_FUNCTION("_decode",mpzmod__decode,tFunc(tStr8,tVoid),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) {
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)  ADD_FUNCTION("fac", gmp_fac,tFunc(tInt,tObj), 0);
79042c1997-03-11Niels Möller 
0311712013-06-17Martin Nilsson  /* This program autoconverts to integers, Gmp.mpz does not!! * magic? no, just an if statement :) /Hubbe */ start_new_program();
0957531999-10-25Fredrik Hübinette (Hubbe) 
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #undef tMpz_ret #define tMpz_ret tInt
0311712013-06-17Martin Nilsson  /* 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();
0957531999-10-25Fredrik Hübinette (Hubbe) 
dffabf2014-02-24Per Hedbor  add_program_constant("bignum", bignum_program=end_program(), 0);
2b1c922013-12-24Henrik Grubbström (Grubba)  bignum_program->id = PROG_GMP_BIGNUM_ID;
0311712013-06-17Martin Nilsson  bignum_program->flags |= PROGRAM_NO_WEAK_FREE | PROGRAM_NO_EXPLICIT_DESTRUCT | PROGRAM_CONSTANT ;
982a0c2003-03-28Martin Stjernholm 
0311712013-06-17Martin Nilsson  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);
dffabf2014-02-24Per Hedbor 
d8f9ad2016-05-30Per Hedbor #if SIZEOF_INT64 != SIZEOF_LONG || SIZEOF_INT_TYPE != SIZEOF_LONG
0311712013-06-17Martin Nilsson  mpz_init (mpz_int64_min); mpz_setbit (mpz_int64_min, INT64_BITS); mpz_neg (mpz_int64_min, mpz_int64_min);
d8f9ad2016-05-30Per Hedbor #endif
d4bf622001-08-13Fredrik Hübinette (Hubbe)  pike_init_mpq_module();
df867c2001-09-04Fredrik Hübinette (Hubbe)  pike_init_mpf_module();
e2b9d82014-12-02Martin Nilsson  pike_init_smpz_module();
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
65ec122014-12-02Martin Nilsson PIKE_MODULE_EXIT { pike_exit_smpz_module(); pike_exit_mpf_module(); pike_exit_mpq_module();
d8f9ad2016-05-30Per Hedbor  free_program(mpzmod_program); free_program(bignum_program); bignum_program = NULL;
65ec122014-12-02Martin Nilsson  mpz_clear (mpz_int_type_min);
d8f9ad2016-05-30Per Hedbor #if SIZEOF_INT64 != SIZEOF_LONG || SIZEOF_INT_TYPE != SIZEOF_LONG
65ec122014-12-02Martin Nilsson  mpz_clear (mpz_int64_min);
d8f9ad2016-05-30Per Hedbor #endif
65ec122014-12-02Martin Nilsson }
a3edd72002-03-08Martin Nilsson /*! @endmodule */