pike.git / src / modules / Gmp / mpq.cmod

version» Context lines:

pike.git/src/modules/Gmp/mpq.cmod:1:   /* -*- c -*-   || 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.   */      #include "global.h"   #include "gmp_machine.h" -  - #if defined(HAVE_GMP2_GMP_H) && defined(HAVE_LIBGMP2) - #define USE_GMP2 - #else /* !HAVE_GMP2_GMP_H || !HAVE_LIBGMP2 */ - #if defined(HAVE_GMP_H) && defined(HAVE_LIBGMP) - #define USE_GMP - #endif /* HAVE_GMP_H && HAVE_LIBGMP */ - #endif /* HAVE_GMP2_GMP_H && HAVE_LIBGMP2 */ -  - #if defined(USE_GMP) || defined(USE_GMP2) -  +    #include "my_gmp.h"      #include "interpret.h"   #include "svalue.h"   #include "stralloc.h"   #include "array.h"   #include "pike_macros.h"   #include "program.h" - #include "stralloc.h" +    #include "object.h"   #include "pike_types.h"   #include "pike_error.h"   #include "builtin_functions.h"   #include "module_support.h"   #include "bignum.h"   #include "operators.h"   #include "mapping.h"   #include "gc.h"    - #include <limits.h> +    #include <math.h>         #define sp Pike_sp   #define fp Pike_fp    -  + #define DEFAULT_CMOD_STORAGE +    DECLARATIONS      #define THISMPQ (&(THIS->n))    - #define PUSH_REDUCED(o) push_object(o) -  +    /*! @module Gmp    */      /*! @class mpq    *! Rational number stored in canonical form. The canonical from means    *! that the denominator and the numerator have no common factors, and    *! that the denominator is positive. Zero has the unique    *! representation 0/1. All functions canonicalize their result.    */   
pike.git/src/modules/Gmp/mpq.cmod:181:       int get_new_mpq(MP_RAT *tmp, struct svalue *s,    int throw_error, const char *arg_func, int arg, int args)    {    switch(TYPEOF(*s))    {    case T_FLOAT:    {    double t;    int y; -  t=FREXP((double) s->u.float_number, &y); +  t=frexp((double) s->u.float_number, &y);       t*=pow(2.0,48.0);    y-=48;       mpz_set_d(mpq_numref(tmp), t);    mpz_set_ui(mpq_denref(tmp), 1);    if(y>0)    mpz_mul_2exp(mpq_numref(tmp),mpq_numref(tmp),y);    else if(y<0)    mpz_mul_2exp(mpq_denref(tmp),mpq_denref(tmp),-y);
pike.git/src/modules/Gmp/mpq.cmod:215:    mpq_set_z(tmp, OBTOMPZ(s->u.object));    break;    }       if(s->u.object->prog == mpq_program)    {    mpq_set(tmp, OBTOMPQ(s->u.object));    break;    }    +  if(s->u.object->prog == mpf_program) +  { +  MP_INT z; +  long exponent; + #ifndef USE_MPFR +  // Acces mpf internals directly. +  // NOTE: Hacky! Must not free z "correctly" +  exponent = OBTOMPF(s->u.object)->_mp_exp*sizeof(mp_limb_t)*8; +  z._mp_size = OBTOMPF(s->u.object)->_mp_size; +  z._mp_d = OBTOMPF(s->u.object)->_mp_d; +  +  /* NB: For simplicity we assume that we won't have values with more +  * than GMP_NUMB_BITS * 0x7ffffff (typically 8 or 16 GB) bits. +  * +  * Further: As we don't perform any destructive operations on +  * the z below, the field will probably not be used. +  */ +  z._mp_alloc = abs((INT32)z._mp_size); + #else +  mpz_init(&z); +  exponent = mpfr_get_z_2exp(&z, OBTOMPF(s->u.object) ); + #endif +  mpz_set( mpq_numref(tmp), &z); +  mpz_set_ui(mpq_denref(tmp),1); +  if( exponent < 0 ) +  mpz_mul_2exp(mpq_denref(tmp),mpq_denref(tmp),-exponent); +  else if( exponent > 0 ) +  mpz_mul_2exp(mpq_numref(tmp),mpq_numref(tmp),exponent); +  mpq_canonicalize(tmp); +  + #ifdef USE_MPFR +  mpz_clear(&z); + #endif +  break; +  } +     if (s->u.object->prog) {    if (throw_error) -  SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpq|Gmp.mpz"); +  SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpq|Gmp.mpz|Gmp.mpf");    else    return 0;    } else {    /* Destructed object. Use as zero. */    mpq_set_si(tmp, 0, 1);    }    break;       default:    if (throw_error) -  SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpq|Gmp.mpz"); +  SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpq|Gmp.mpz|Gmp.mpf");    else    return 0;    } -  +     return 1;    }      /* Converts an svalue, located on the stack, to an mpq object */    static MP_RAT *debug_get_mpq(struct svalue *s,    int throw_error, const char *arg_func, int arg, int args)    {    struct object *o = fast_clone_object (mpq_program);    ONERROR uwp;    SET_ONERROR (uwp, do_free_object, o);
pike.git/src/modules/Gmp/mpq.cmod:264:    }      #ifdef DEBUG_MALLOC   #define get_mpq(S, THROW_ERROR, ARG_FUNC, ARG, ARGS) \    (REFCOUNTED_TYPE(TYPEOF(*(S))) ? debug_malloc_touch((S)->u.object) : 0, \    debug_get_mpq((S), (THROW_ERROR), (ARG_FUNC), (ARG), (ARGS)))   #else   #define get_mpq debug_get_mpq   #endif    -  /*! @decl static void create(void|string|int|float|Gmp.mpz|Gmp.mpq x) -  *! @decl static void create(int numerator, int denominator) -  *! @decl static void create(string x, int base) +  PIKEFUN float|mpq|int ``**(int|float exponent) +  { +  double x; +  /* does not support expoent being object, +  `** should have been used in that case. */ +  if( TYPEOF(*exponent) == PIKE_T_FLOAT ) +  { +  if( (double)(long)exponent->u.float_number == exponent->u.float_number ) +  { +  TYPEOF(*exponent)=PIKE_T_INT; +  exponent->u.integer = (long)exponent->u.float_number; +  } +  } +  +  if( TYPEOF(*exponent) == PIKE_T_INT ) +  { +  // int ** mpq counted as int ** float not int ** int. +  // promote to mpq or float. +  get_mpq( Pike_sp-1, 1, "``**", 1, 1 ); +  ref_push_object( Pike_fp->current_object ); +  apply_lfun( Pike_sp[-2].u.object, LFUN_POW, 1 ); +  return; +  } +  +  x = mpq_get_d(THISMPQ); +  Pike_sp[-1].u.float_number = pow( Pike_sp[-1].u.float_number, x); +  } +  +  +  PIKEFUN mpq `**(int exponent) +  { +  struct object *o = fast_clone_object( mpq_program ); +  push_object(o); +  if( exponent >= 0 ) +  { +  mpz_pow_ui( mpq_numref(OBTOMPQ(o)), mpq_numref(THISMPQ), exponent ); +  mpz_pow_ui( mpq_denref(OBTOMPQ(o)), mpq_denref(THISMPQ), exponent ); +  } +  else +  { +  mpz_pow_ui( mpq_numref(OBTOMPQ(o)), mpq_denref(THISMPQ), -exponent ); +  mpz_pow_ui( mpq_denref(OBTOMPQ(o)), mpq_numref(THISMPQ), -exponent ); +  } +  mpq_canonicalize(OBTOMPQ(o)); +  } +  +  PIKEFUN float|mpq `**(float exponent) +  { +  double x; +  if( (double)(int)exponent == exponent ) +  { +  Pike_sp[-1].u.integer = (INT_TYPE)Pike_sp[-1].u.float_number; +  TYPEOF(Pike_sp[-1]) = PIKE_T_INT; +  f_mpq_cq__backtick_2A_2A_1(1); +  return; +  } +  x = mpq_get_d(THISMPQ); +  x = pow(x, exponent); +  if( (double)(long)x == x ) +  { +  struct object *o = fast_clone_object( mpq_program ); +  push_object(o); +  mpq_set_si( OBTOMPQ(o), (long)x, 1 ); +  } +  else +  { +  push_float( x ); +  } +  } +  +  +  PIKEFUN mpq `**(object _exponent) +  { +  signed long tmpi; +  MP_INT tmp; +  struct object *o; +  MP_RAT *exponent; +  +  mpz_init( &tmp ); +  if(_exponent->prog != mpq_program) +  { +  _exponent = fast_clone_object(mpq_program); +  get_new_mpq(OBTOMPQ(_exponent), Pike_sp-1, 1, "`**", 1, 1); +  } +  exponent = OBTOMPQ(_exponent); +  +  +  // x ^ (exponent/divisor) +  tmpi = mpz_get_si(mpq_numref(exponent)); +  if( !mpz_fits_slong_p(mpq_numref(exponent)) || +  !mpz_fits_slong_p(mpq_denref(exponent)) || +  labs(tmpi)* +  MAXIMUM(mpz_size(mpq_numref(exponent)), +  mpz_size(mpq_denref(exponent))) > +  (0x40000000/sizeof(mp_limb_t))) +  { +  // Well, bother that (more than 1Gb temporary). +  // Fall back to float version. +  goto float_fallback; +  } +  +  push_int( tmpi ); +  f_mpq_cq__backtick_2A_2A_1(1); +  +  // now in o (and on stack): Exponented number. +  o = Pike_sp[-1].u.object; +  +  // now do x:th root part. +  tmpi = mpz_get_si(mpq_denref(exponent)); +  +  if( tmpi != 1 ) +  { +  mpz_rootrem(mpq_numref(OBTOMPQ(o)),&tmp,mpq_numref(OBTOMPQ(o)),tmpi); +  if( mpz_sgn( &tmp ) ) goto float_fallback; +  mpz_rootrem(mpq_denref(OBTOMPQ(o)),&tmp,mpq_denref(OBTOMPQ(o)),tmpi); +  if( mpz_sgn( &tmp ) ) goto float_fallback; +  /* o already on stack, all done. */ +  mpz_clear(&tmp); +  mpq_canonicalize(OBTOMPQ(o)); +  } +  return; + float_fallback: +  // the result can not be represented exactly, or is just too huge. +  push_float( pow(mpq_get_d(THISMPQ),mpq_get_d(exponent)) ); +  } +  +  /*! @decl protected void create(void|string|int|float|Gmp.mpz|Gmp.mpq x) +  *! @decl protected void create(int|Gmp.mpz numerator, @ +  *! int|Gmp.mpz denominator) +  *! @decl protected void create(string x, int base)    */ -  PIKEFUN void create(void|string|int|float|object x, void|int base) +  PIKEFUN void create(void|string|int|float|object x, void|int|object base)    type function(void|string|int|float|object:void)|function(string,int:void)|function(int,int:void);    flags ID_PROTECTED;    {    switch(args)    { -  case 1: -  if(TYPEOF(sp[-args]) == T_STRING) -  get_mpq_from_digits(THISMPQ, sp[-args].u.string, 0); -  else -  get_new_mpq(THISMPQ, sp-args, 1, "Gmp.mpq", 1, args); -  break; -  +     case 2:    /* Args are string of digits and integer base */    /* or int num / den */    -  if (TYPEOF(sp[1-args]) != T_INT) -  if(TYPEOF(sp[1-args]) != T_OBJECT || -  sp[1-args].u.object->prog != bignum_program || -  TYPEOF(sp[-args]) == T_STRING) -  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpq", 2, "int"); +  if (base && x) {    -  switch(TYPEOF(sp[-args])) +  switch(TYPEOF(*x))    {    case T_STRING: -  get_mpq_from_digits(THISMPQ, sp[-args].u.string, sp[1-args].u.integer); +  if (TYPEOF(*base) != T_INT) +  SIMPLE_ARG_TYPE_ERROR ("create", 2, "int"); +  get_mpq_from_digits(THISMPQ, x->u.string, base->u.integer);    break;    -  +  default: +  SIMPLE_ARG_TYPE_ERROR ("create", 1, "int|string"); +  break; +     case T_OBJECT: -  if(sp[-args].u.object->prog != bignum_program) +  if(x->u.object->prog != bignum_program && +  x->u.object->prog != mpzmod_program) +  SIMPLE_ARG_TYPE_ERROR ("create", 1, "int|string");    -  default: -  SIMPLE_ARG_TYPE_ERROR ("Gmp.mpq", 1, "int|string"); +  /* FALLTHRU */       case T_INT: -  mpq_set_num(THISMPQ,get_mpz(sp-args, 1, "Gmp.mpq", 1, args)); -  mpq_set_den(THISMPQ,get_mpz(sp-args+1, 1, "Gmp.mpq", 2, args)); +  if (TYPEOF(*base) != T_INT && +  !(TYPEOF(*base) == T_OBJECT && +  (base->u.object->prog == bignum_program || +  base->u.object->prog == mpzmod_program))) +  SIMPLE_ARG_TYPE_ERROR ("create", 2, "int"); +  mpq_set_num(THISMPQ,get_mpz(x, 1, "create", 1, args)); +  mpq_set_den(THISMPQ,get_mpz(base, 1, "create", 2, args));    mpq_canonicalize(THISMPQ);    break;    }    break; -  +  } +  /* FALLTHRU */    -  default: -  SIMPLE_WRONG_NUM_ARGS_ERROR ("Gmp.mpq", 2); +  case 1: +  if (x) { +  if(TYPEOF(*x) == T_STRING) +  get_mpq_from_digits(THISMPQ, x->u.string, 0); +  else +  get_new_mpq(THISMPQ, x, 1, "create", 1, args); +  break; +  } +  /* FALLTHRU */       case 0: -  break; /* Needed by AIX cc */ +  break; +  +  default: +  SIMPLE_WRONG_NUM_ARGS_ERROR ("create", 2);    } -  +  pop_n_elems(args);    }       /*! @decl int get_int()    */    PIKEFUN int get_int()    {    struct object *res = fast_clone_object(mpzmod_program);    mpz_tdiv_q(OBTOMPZ(res), mpq_numref(THISMPQ), mpq_denref(THISMPQ));    /* FIXME */    mpzmod_reduce(res);    }    -  /*! @decl static int __hash() +  /*! @decl protected int __hash()    */    PIKEFUN int __hash()    flags ID_PROTECTED;    {    RETURN    mpz_get_si(mpq_numref(THISMPQ)) * 1000003 +    mpz_get_si(mpq_denref(THISMPQ));    }       /*! @decl float get_float()
pike.git/src/modules/Gmp/mpq.cmod:358:    struct pike_string *s;    ptrdiff_t len = mpz_sizeinbase (num, 10);       assert (prec);       if (len > prec) {    /* one for the dot... */    prec++;    /* present 'num' and insert dot */    len += 3; -  s = begin_shared_string(len); +  s = begin_shared_string(len + 1); /* +1 to cater for a leading 0 */    if(len/2 > prec)    {    /* Shift the integer part forward to make room for the dot. */    mpz_get_str(s->str+1, 10, num);    /* Find NULL character */    len-=4;    if (len < 1) len = 1;    while(s->str[len]) len++; -  MEMMOVE(s->str, s->str+1, len-prec); +  memmove(s->str, s->str+1, len-prec);    }else{    /* Shift the fractional part backward to make room for the dot. */    mpz_get_str(s->str, 10, num);    /* Find NULL character */    len-=5;    if (len < 0) len = 0;    while(s->str[len]) len++; -  MEMMOVE(s->str+len-prec+1, +  memmove(s->str+len-prec+1,    s->str+len-prec,    prec+1);    len++;    } -  +  /* Make sure numbers start with a digit */ +  if ((len == prec) || ((unsigned)(s->str[len-prec-1] - '0') > 9)) { +  memmove(s->str+len-prec+1, s->str+len-prec, prec); +  s->str[len++ -prec] = '0'; +  }    s->str[len-prec]='.';    push_string (end_and_resize_shared_string (s, len));    }       else {    /* The precision is greater than the length, so start out    * with a string of zeroes. */    char *p;    s = begin_shared_string (prec + 4);    p = s->str;    if (mpz_sgn (num) < 0) {    *p++ = '-';    mpz_neg (num, num);    }    *p++ = '0';    *p++ = '.';    for (; prec > len; prec--) *p++ = '0';    mpz_get_str (p, 10, num);    if (!p[len - 1]) { -  MEMMOVE (p + 1, p, len - 1); +  memmove (p + 1, p, len - 1);    *p = '0';    }    push_string (end_and_resize_shared_string (s, p - s->str + len));    }    }       static void format_string (mpq_t mpq, int dec_fract)    {    if (dec_fract >= 1) {    mpz_t den, f;
pike.git/src/modules/Gmp/mpq.cmod:438:       if (prec) {    mpz_t num;    mpz_init (num);    mpz_ui_pow_ui (num, 10, prec);    mpz_mul (num, num, mpq_numref (mpq));    if (twos)    mpz_tdiv_q_2exp (num, num, twos);    if (fives) {    mpz_pow_ui (f, f, fives); - #ifdef HAVE_MPZ_DIVISIBLE_P + #ifdef PIKE_DEBUG    assert (mpz_divisible_p (num, f));   #endif    mpz_tdiv_q (num, num, f);    }    format_dec_frac (num, prec);    strings++;    mpz_clear (num);    }    else {    push_string (low_get_mpz_digits (mpq_numref (mpq), 10));    strings++;    if (dec_fract >= 2) {    push_constant_text (".0");    strings++;    }    }       /* If the denominator contains other factors we still need to    * display it. */    if (mpz_cmp_ui (den, 1u)) { -  push_constant_text ("/"); +  push_static_text ("/");    push_string (low_get_mpz_digits (den, 10));    strings += 2;    }       mpz_clear (den);    mpz_clear (f);    if (strings > 1) f_add (strings);    }       else {    push_string(low_get_mpz_digits(mpq_numref(mpq),10)); -  push_constant_text("/"); +  push_static_text("/");    push_string(low_get_mpz_digits(mpq_denref(mpq),10));    f_add(3);    }    }       /*! @decl string get_string (void|int decimal_fraction)    *!    *! If @[decimal_fraction] is zero or left out, the number is    *! returned as a string on the form @expr{"numerator/denominator"@},    *! where both parts are decimal integers. The numerator may be
pike.git/src/modules/Gmp/mpq.cmod:545:    int def,    int arg, int args)    {    struct svalue *sv;    if((sv=simple_mapping_string_lookup(m,ind)))    {    if(TYPEOF(*sv) == T_INT)    {    return sv->u.integer;    }else{ -  bad_arg_error (name, Pike_sp - args, args, arg, NULL, Pike_sp + arg - 1 - args, +  bad_arg_error (name, args, arg, NULL, Pike_sp + arg - 1 - args,    "Bad argument %d to %s(). "    "The field \"%s\" doesn't hold an integer.\n",    arg, name, ind);    }    }    return def;    }    -  /*! @decl static string _sprintf(int c, mapping flags) +  /*! @decl protected string _sprintf(int c, mapping flags)    */    PIKEFUN string _sprintf(int c, mapping flags)    flags ID_PROTECTED;    { -  INT_TYPE precision, width, base = 0, mask_shift = 0; -  struct pike_string *s = 0; -  INT_TYPE flag_left; +  INT_TYPE precision;       precision=lookup("Gmp.Mpq->_sprintf",flags,"precision",7, 2, args); -  width=lookup("Gmp.Mpq->_sprintf",flags,"width",-1, 2, args); -  flag_left=lookup("Gmp.Mpq->_sprintf",flags,"flag_left",0, 2, args); +     pop_n_elems(args);    if(precision<0) precision=0;       switch(c)    {    default:    push_undefined();    return;       case 'O': -  push_constant_text ("Gmp.mpq("); -  format_string (THISMPQ, 1); -  push_constant_text (")"); +  push_static_text ("Gmp.mpq("); +  format_string (THISMPQ, 0); +  push_static_text (")");    f_add (3);    return;       /* Fixme: Support g/e/E */    case 'g':    case 'e':    case 'E':    case 'f':    {    mpz_t tmp; -  ptrdiff_t len; +        mpz_init(tmp);    mpz_ui_pow_ui(tmp, 10, precision);    mpz_mul(tmp, tmp, mpq_numref(THISMPQ));    mpz_tdiv_q(tmp, tmp, mpq_denref(THISMPQ));       if (!precision)    /* No dot if the precision is zero. This is consistent    * with normal printf behavior. */    push_string (low_get_mpz_digits (tmp, 10));    else    format_dec_frac (tmp, precision);       mpz_clear(tmp);    }    }    }    -  /*! @decl static int(0..1) _is_type(string arg) +  /*! @decl protected int(0..1) _is_type(string arg)    */ -  PIKEFUN int(0..1) _is_type(string arg) +  PIKEFUN int(0..1) _is_type(string str)    flags ID_PROTECTED;    { -  push_constant_text("float"); -  f_eq(2); +  if( str == literal_float_string ) +  RETURN 1; +  RETURN 0;    }    -  /*! @decl static int|string|float|object cast(string s) +  /*! @decl protected int|string|float cast(string s)    *!    *! Casting to a string returns the number in the decimal fraction    *! format, where both decimal point and quotient is included only    *! if required. I.e. it is the same as calling @[get_string] with 1    *! as argument.    */ -  PIKEFUN int|string|float|object cast(string s) +  PIKEFUN int|string|float cast(string s)    flags ID_PROTECTED;    { -  add_ref(s); -  -  pop_n_elems(args); -  -  switch(s->str[0]) -  { -  case 'i': -  if(!strncmp(s->str, "int", 3)) -  { -  free_string(s); +  pop_stack(); /* s have at least one more reference. */ +  if( s == literal_int_string )    f_mpq_get_int(0); -  return; -  } -  break; -  -  case 's': -  if(!strcmp(s->str, "string")) -  { -  free_string(s); +  else if( s == literal_string_string )    format_string (THISMPQ, 1); -  return; -  } -  break; -  -  case 'f': -  if(!strcmp(s->str, "float")) -  { -  free_string(s); +  else if( s == literal_float_string )    f_mpq_get_float(0); -  return; +  else +  push_undefined();    } -  break; +     -  case 'o': -  if(!strcmp(s->str, "object")) -  { -  push_object(this_object()); -  } -  break; -  -  case 'm': -  if(!strcmp(s->str, "mixed")) -  { -  push_object(this_object()); -  } -  break; -  -  } -  -  free_string(s); -  -  SIMPLE_ARG_ERROR ("Gmp.mpq->cast", 1, -  "Cannot cast to other type than sitrng, int or float.\n"); -  } -  -  /*! @decl static Gmp.mpq `+(int|float|object ... a) +  /*! @decl protected Gmp.mpq `+(int|float|object ... a)    */ -  PIKEFUN object `+(int|float|object ... a) +  PIKEFUN mpq `+(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    INT32 e;    struct object *res;    for(e=0; e<args; e++) -  get_mpq(sp+e-args, 1, "Gmp.mpq->`+", e + 1, args); +  get_mpq(sp+e-args, 1, "`+", e + 1, args);    res = fast_clone_object(mpq_program);    mpq_set(OBTOMPQ(res), THISMPQ);    for(e=0;e<args;e++)    mpq_add(OBTOMPQ(res), OBTOMPQ(res), OBTOMPQ(sp[e-args].u.object));       RETURN res;    }    -  /*! @decl static Gmp.mpq ``+(int|float|object ... a) +  /*! @decl protected Gmp.mpq ``+(int|float|object ... a)    */ -  PIKEFUN object ``+(int|float|object ... a) +  PIKEFUN mpq ``+(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    INT32 e;    struct object *res;    for(e=0; e<args; e++) -  get_mpq(sp+e-args, 1, "Gmp.mpq->``+", e + 1, args); +  get_mpq(sp+e-args, 1, "``+", e + 1, args);    res = fast_clone_object(mpq_program);    mpq_set(OBTOMPQ(res), THISMPQ);    for(e=0;e<args;e++)    mpq_add(OBTOMPQ(res), OBTOMPQ(res), OBTOMPQ(sp[e-args].u.object));       RETURN res;    }    -  /*! @decl static Gmp.mpq `+=(int|float|object ... a) +  /*! @decl protected Gmp.mpq `+=(int|float|object ... a)    */ -  PIKEFUN object `+=(int|float|object ... a) +  PIKEFUN mpq `+=(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    INT32 e;    for(e=0; e<args; e++) -  get_mpq(sp+e-args, 1, "Gmp.mpq->`+=", e + 1, args); +  get_mpq(sp+e-args, 1, "`+=", e + 1, args);    for(e=0;e<args;e++)    mpq_add(THISMPQ, THISMPQ, OBTOMPQ(sp[e-args].u.object));       REF_RETURN fp->current_object;    }         #ifdef BIG_PIKE_INT   #define TOOBIGTEST || sp[e-args].u.integer>MAX_INT32   #else
pike.git/src/modules/Gmp/mpq.cmod:784:    norm++;    mpz_mul(mpq_numref(res),    mpq_numref(res),    OBTOMPZ(sp[e-args].u.object));    }    }       if(norm) mpq_canonicalize(res);    }    -  /*! @decl static Gmp.mpq `*(int|float|object ... a) +  /*! @decl protected Gmp.mpq `*(int|float|object ... a)    */ -  PIKEFUN object `*(int|float|object ... a) +  PIKEFUN mpq `*(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    struct object *res;    mult_convert_args(args, "Gmp.mpq->`*");       res = fast_clone_object(mpq_program);    mpq_set(OBTOMPQ(res), THISMPQ);    mult_args(OBTOMPQ(res), 0,args);       RETURN res;    }    -  /*! @decl static Gmp.mpq ``*(int|float|object ... a) +  /*! @decl protected Gmp.mpq ``*(int|float|object ... a)    */ -  PIKEFUN object ``*(int|float|object ... a) +  PIKEFUN mpq ``*(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    struct object *res;    mult_convert_args(args, "Gmp.mpq->``*");       res = fast_clone_object(mpq_program);    mpq_set(OBTOMPQ(res), THISMPQ);    mult_args(OBTOMPQ(res), 0,args);       RETURN res;    }    -  /*! @decl static Gmp.mpq `*=(int|float|object ... a) +  /*! @decl protected Gmp.mpq `-(int|float|object ... a)    */ -  PIKEFUN object `*=(int|float|object ... a) +  PIKEFUN mpq `-(int|float|object ... UNUSED)    flags ID_PROTECTED;    { -  mult_convert_args(args, "Gmp.mpq->`*="); -  mult_args(THISMPQ, 0,args); -  REF_RETURN fp->current_object; -  } -  -  /*! @decl static Gmp.mpq `-(int|float|object ... a) -  */ -  PIKEFUN object `-(int|float|object ... a) -  flags ID_PROTECTED; -  { +     INT32 e;    struct object *res;       if (args)    for (e = 0; e<args; e++) -  get_mpq(sp + e - args, 1, "Gmp.mpq->`-", e + 1, args); +  get_mpq(sp + e - args, 1, "`-", e + 1, args);       res = fast_clone_object(mpq_program);    mpq_set(OBTOMPQ(res), THISMPQ);       if(args)    {    for(e=0;e<args;e++)    mpq_sub(OBTOMPQ(res), OBTOMPQ(res), OBTOMPQ(sp[e-args].u.object));    }else{    mpq_neg(OBTOMPQ(res), OBTOMPQ(res));    }       RETURN res;    }    -  /*! @decl static Gmp.mpq ``-(int|float|object sv) +  /*! @decl protected Gmp.mpq ``-(int|float|object sv)    */ -  PIKEFUN object ``-(int|float|object sv) +  PIKEFUN mpq ``-(int|float|object sv)    flags ID_PROTECTED;    {    struct object *res; -  MP_RAT *a=get_mpq(sv, 1, "Gmp.mpq->``-", 1, args); +  MP_RAT *a=get_mpq(sv, 1, "``-", 1, args);    res = fast_clone_object(mpq_program);    mpq_sub(OBTOMPQ(res), a, THISMPQ);    RETURN res;    }    -  /*! @decl static Gmp.mpq `/(int|float|object ... a) +  /*! @decl protected Gmp.mpq `/(int|float|object ... a)    */ -  PIKEFUN object `/(int|float|object ... a) +  PIKEFUN mpq `/(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    INT32 e;    struct object *res;       for(e=0;e<args;e++) -  if (!mpq_sgn(get_mpq(sp+e-args, 1, "Gmp.mpq->`/", e + 1, args))) -  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpq->`/"); +  if (!mpq_sgn(get_mpq(sp+e-args, 1, "`/", e + 1, args))) +  SIMPLE_DIVISION_BY_ZERO_ERROR ("`/");       res = fast_clone_object(mpq_program);    mpq_set(OBTOMPQ(res), THISMPQ);    for(e=0;e<args;e++)    mpq_div(OBTOMPQ(res), OBTOMPQ(res), OBTOMPQ(sp[e-args].u.object));       RETURN res;    }    -  /*! @decl static Gmp.mpq ``/(int|float|object sv) +  /*! @decl protected Gmp.mpq ``/(int|float|object sv)    */ -  PIKEFUN object ``/(int|float|object sv) +  PIKEFUN mpq ``/(int|float|object sv)    flags ID_PROTECTED;    {    MP_RAT *a;    struct object *res = NULL;    if(!mpq_sgn(THISMPQ)) -  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpq->``/"); +  SIMPLE_DIVISION_BY_ZERO_ERROR ("``/");    -  a=get_mpq(sv, 1, "Gmp.mpq->``/", 1, args); +  a=get_mpq(sv, 1, "``/", 1, args);       res=fast_clone_object(mpq_program);    mpq_div(OBTOMPQ(res), a, THISMPQ);       RETURN res;    }    -  /*! @decl static Gmp.mpq `%(int|float|object ... a) +  /*! @decl protected Gmp.mpq `%(int|float|object ... a)    *! @expr{a%b = a - floor(a/b)*b @}    */ -  PIKEFUN object `%(int|float|object ... a) +  PIKEFUN mpq `%(int|float|object ... UNUSED)    flags ID_PROTECTED;    {    INT32 e; -  struct object *res; -  mpq_t tmp; -  +  struct object *_res; +  MP_INT tmp_int; +  MP_RAT *res;    for(e=0;e<args;e++) -  if (!mpq_sgn(get_mpq(sp+e-args, 1, "Gmp.mpq->`%", e, args))) -  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpq->`%"); +  if (!mpq_sgn(get_mpq(sp+e-args, 1, "`%", e, args))) +  SIMPLE_DIVISION_BY_ZERO_ERROR ("`%");    -  res = fast_clone_object(mpq_program); +  _res = fast_clone_object(mpq_program);    -  mpq_init(tmp); -  mpq_set(OBTOMPQ(res), THISMPQ); +  mpz_init(&tmp_int); +  mpq_set((res=OBTOMPQ(_res)), THISMPQ);       for(e=0;e<args;e++)    { -  mpz_mul(mpq_numref(tmp), -  mpq_numref(OBTOMPQ(res)), +  // save A denom +  mpz_set( &tmp_int, mpq_denref(res)); +  +  // mult A sides with B denom +  mpz_mul( mpq_denref(res),mpq_denref(res),    mpq_denref(OBTOMPQ(sp[e-args].u.object))); -  +  mpz_mul( mpq_numref(res),mpq_numref(res), +  mpq_denref(OBTOMPQ(sp[e-args].u.object))); +  // tmp_int = B num * old A denom +  // (B denom would be same as A:s after multiplication, but there +  // is no need to do the calculation..) +  mpz_mul( &tmp_int, mpq_numref(OBTOMPQ(sp[e-args].u.object)), +  &tmp_int );    -  mpz_tdiv_q(mpq_numref(tmp), -  mpq_numref(tmp), -  mpq_denref(tmp)); -  -  mpz_tdiv_q(mpq_numref(tmp), -  mpq_numref(tmp), -  mpq_numref(OBTOMPQ(sp[e-args].u.object))); -  -  mpz_set_si(mpq_denref(tmp),1); -  -  mpq_mul(tmp, tmp, OBTOMPQ(sp[e-args].u.object)); -  mpq_sub(OBTOMPQ(res), OBTOMPQ(res), tmp); +  // a.num = (A.num % B.num) (since denom is common) +  mpz_tdiv_r( mpq_numref(res), mpq_numref(res), &tmp_int); +  /* This could be done after the loop, but the +  denominators might get out of hand. */ +  mpq_canonicalize(res);    } -  mpq_clear(tmp); +  mpz_clear(&tmp_int);    -  RETURN res; +  RETURN _res;    }    -  /*! @decl static Gmp.mpq ``%(int|float|object a) +  /*! @decl protected Gmp.mpq ``%(int|float|object a)    */ -  PIKEFUN object ``%(int|float|object a) +  PIKEFUN mpq ``%(int|float|object UNUSED)    flags ID_PROTECTED;    { -  MP_RAT *a; -  -  struct object *res; -  if(!mpq_sgn(THISMPQ)) -  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpq->``%"); -  -  a=get_mpq(sp-1, 1, "Gmp.mpq->``%", 1, 1); -  -  res=fast_clone_object(mpq_program); -  -  mpz_mul(mpq_numref(OBTOMPQ(res)), mpq_numref(a), mpq_denref(THISMPQ)); -  -  mpz_tdiv_q(mpq_numref(OBTOMPQ(res)), -  mpq_numref(OBTOMPQ(res)), -  mpq_denref(OBTOMPQ(res))); -  -  mpz_tdiv_q(mpq_numref(OBTOMPQ(res)), -  mpq_numref(OBTOMPQ(res)), -  mpq_numref(a)); -  -  mpz_set_si(mpq_denref(OBTOMPQ(res)),1); -  -  mpq_mul(OBTOMPQ(res), OBTOMPQ(res), THISMPQ); -  mpq_sub(OBTOMPQ(res), a, OBTOMPQ(res)); -  -  RETURN res; +  get_mpq(sp-1, 1, "``%", 1, 1); +  ref_push_object(Pike_fp->current_object); +  apply_lfun( Pike_sp[-2].u.object, LFUN_MOD, 1 );    }       /*! @decl Gmp.mpq invert()    */ -  PIKEFUN object invert() +  PIKEFUN mpq invert()    {    struct object *res;    if (!mpq_sgn(THISMPQ)) -  SIMPLE_DIVISION_BY_ZERO_ERROR ("Gmp.mpq->invert"); +  SIMPLE_DIVISION_BY_ZERO_ERROR ("invert");    res = fast_clone_object(mpq_program);    mpq_inv(OBTOMPQ(res), THISMPQ);    RETURN res;    }    -  /*! @decl static Gmp.mpq `~() +  /*! @decl protected Gmp.mpq `~()    *! Defined as @expr{-1-x@}.    */ -  PIKEFUN object `~() +  PIKEFUN mpq `~()    flags ID_PROTECTED;    {    struct object *o;    o=fast_clone_object(mpq_program);    mpq_set_si(OBTOMPQ(o), -1, 1);    mpq_sub(OBTOMPQ(o),OBTOMPQ(o), THISMPQ);       RETURN o;    }    -  /*! @decl static int(0..1) `>(mixed q) +  /*! @decl protected int(0..1) `>(mixed q)    */    PIKEFUN int(0..1) `>(mixed q)    flags ID_PROTECTED;    { -  RETURN mpq_cmp(THISMPQ, get_mpq(q, 1, "Gmp.mpq->`>", 1, args)) > 0; +  RETURN mpq_cmp(THISMPQ, get_mpq(q, 1, "`>", 1, args)) > 0;    }    -  /*! @decl static int(0..1) `<(mixed q) +  /*! @decl protected int(0..1) `<(mixed q)    */    PIKEFUN int(0..1) `<(mixed q)    flags ID_PROTECTED;    { -  RETURN mpq_cmp(THISMPQ, get_mpq(q, 1, "Gmp.mpq->`<", 1, args)) < 0; +  RETURN mpq_cmp(THISMPQ, get_mpq(q, 1, "`<", 1, args)) < 0;    }    -  /*! @decl static int(0..1) `>=(mixed q) -  */ -  PIKEFUN int(0..1) `>=(mixed q) -  flags ID_PROTECTED; -  { -  RETURN mpq_cmp(THISMPQ, get_mpq(q, 1, "Gmp.mpq->`>=", 1, args)) >= 0; -  } +     -  /*! @decl static int(0..1) `<=(mixed q) +  /*! @decl protected int(0..1) `==(mixed q)    */ -  PIKEFUN int(0..1) `<=(mixed q) -  flags ID_PROTECTED; -  { -  RETURN mpq_cmp(THISMPQ, get_mpq(q, 1, "Gmp.mpq->`<=", 1, args)) <= 0; -  } -  -  -  /*! @decl static int(0..1) `==(mixed q) -  */ +     PIKEFUN int(0..1) `==(mixed q)    flags ID_PROTECTED;    {    MP_RAT *arg=get_mpq(q, 0, NULL, 0, 0);    RETURN arg && !mpq_cmp(THISMPQ, arg);    }    -  /*! @decl static int(0..1) `!=(mixed q) -  */ -  PIKEFUN int(0..1) `!=(mixed q) -  flags ID_PROTECTED; -  { -  MP_RAT *arg=get_mpq(q, 0, NULL, 0, 0); -  RETURN !(arg && !mpq_cmp(THISMPQ, arg)); -  } -  +     /*! @decl int(-1..1) sgn()    */    PIKEFUN int(-1..1) sgn()    {    RETURN mpq_sgn(THISMPQ);    }    -  /*! @decl static int(0..1) `!(mixed q) +  /*! @decl protected int(0..1) `!(mixed q)    */    PIKEFUN int(0..1) `!()    flags ID_PROTECTED;    {    RETURN !mpq_sgn(THISMPQ);    }       INIT    {   #ifdef PIKE_DEBUG
pike.git/src/modules/Gmp/mpq.cmod:1091:    if(!fp) Pike_fatal("ZERO FP\n");    if(!THISMPQ) Pike_fatal("ZERO THISMPQ\n");   #endif    mpq_clear(THISMPQ);    }       GC_RECURSE    {    if (mc_count_bytes (Pike_fp->current_object))    mc_counted_bytes += - #ifdef MPZ_T_HAS__MP_ALLOC +     mpq_numref (THISMPQ)[0]._mp_alloc * sizeof (mp_limb_t) +    mpq_denref (THISMPQ)[0]._mp_alloc * sizeof (mp_limb_t) + - #else -  mpz_size (mpq_numref (THISMPQ)) * sizeof (mp_limb_t) + -  mpz_size (mpq_denref (THISMPQ)) * sizeof (mp_limb_t) + - #endif +     sizeof (mpq_t);    }   }      /*! @endclass    */      /*! @endmodule    */    - #endif /* USE_GMP */ -  -  +    void pike_init_mpq_module(void)   {    INIT   }      void pike_exit_mpq_module(void)   {    EXIT   }