Logo Search packages:      
Sourcecode: xbase-clients version File versions  Download package

mathimp.c

/*
 * Copyright (c) 2002 by The XFree86 Project, Inc.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and associated documentation files (the "Software"),
 * to deal in the Software without restriction, including without limitation
 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 * and/or sell copies of the Software, and to permit persons to whom the
 * Software is furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in
 * all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 * SOFTWARE.
 *
 * Except as contained in this notice, the name of the XFree86 Project shall
 * not be used in advertising or otherwise to promote the sale, use or other
 * dealings in this Software without prior written authorization from the
 * XFree86 Project.
 *
 * Author: Paulo C├ęsar Pereira de Andrade
 */

/* $XFree86: xc/programs/xedit/lisp/mathimp.c,v 1.14tsi Exp $ */


/*
 * Defines
 */
#ifdef __GNUC__
#define CONST                 __attribute__ ((__const__))
#else
#define CONST                 /**/
#endif

/* mask for checking overflow on long operations */
#ifdef LONG64
#define FI_MASK               0x4000000000000000L
#define LONGSBITS       63
#else
#define FI_MASK               0x40000000L
#define LONGSBITS       31
#endif

#define N_FIXNUM        1
#define N_BIGNUM        2
#define N_FLONUM        3
#define N_FIXRATIO            4
#define N_BIGRATIO            5

#define NOP_ADD               1
#define NOP_SUB               2
#define NOP_MUL               3
#define NOP_DIV               4

#define NDIVIDE_CEIL          1
#define NDIVIDE_FLOOR         2
#define NDIVIDE_ROUND         3
#define NDIVIDE_TRUNC         4

/* real part from number */
#define NREAL(num)            &((num)->real)
#define NRTYPE(num)           (num)->real.type
#define NRFI(num)       (num)->real.data.fixnum
#define NRBI(num)       (num)->real.data.bignum
#define NRFF(num)       (num)->real.data.flonum
#define NRFRN(Num)            (Num)->real.data.fixratio.num
#define NRFRD(num)            (num)->real.data.fixratio.den
#define NRBR(num)       (num)->real.data.bigratio
#define NRBRN(num)            mpr_num(NRBR(num))
#define NRBRD(num)            mpr_den(NRBR(num))

#define NRCLEAR_BI(num)       mpi_clear(NRBI(num)); XFREE(NRBI(num))
#define NRCLEAR_BR(num)       mpr_clear(NRBR(num)); XFREE(NRBR(num))

/* imag part from number */
#define NIMAG(num)            &((num)->imag)
#define NITYPE(num)           (num)->imag.type
#define NIFI(num)       (num)->imag.data.fixnum
#define NIBI(num)       (num)->imag.data.bignum
#define NIFF(num)       (num)->imag.data.flonum
#define NIFRN(Num)            (Num)->imag.data.fixratio.num
#define NIFRD(num)            (num)->imag.data.fixratio.den
#define NIBR(num)       (num)->imag.data.bigratio
#define NIBRN(obj)            mpr_num(NIBR(obj))
#define NIBRD(obj)            mpr_den(NIBR(obj))

/* real number fields */
#define RTYPE(real)           (real)->type
#define RFI(real)       (real)->data.fixnum
#define RBI(real)       (real)->data.bignum
#define RFF(real)       (real)->data.flonum
#define RFRN(real)            (real)->data.fixratio.num
#define RFRD(real)            (real)->data.fixratio.den
#define RBR(real)       (real)->data.bigratio
#define RBRN(real)            mpr_num(RBR(real))
#define RBRD(real)            mpr_den(RBR(real))

#define RINTEGERP(real)                   \
    (RTYPE(real) == N_FIXNUM || RTYPE(real) == N_BIGNUM)

#define RCLEAR_BI(real)       mpi_clear(RBI(real)); XFREE(RBI(real))
#define RCLEAR_BR(real)       mpr_clear(RBR(real)); XFREE(RBR(real))

/* numeric value from lisp object */
#define OFI(object)           FIXNUM_VALUE(object)
#define OII(object)           INT_VALUE(object)
#define OBI(object)           (object)->data.mp.integer
#define ODF(object)           DFLOAT_VALUE(object)
#define OFRN(object)          (object)->data.ratio.numerator
#define OFRD(object)          (object)->data.ratio.denominator
#define OBR(object)           (object)->data.mp.ratio
#define OBRN(object)          mpr_num(OBR(object))
#define OBRD(object)          mpr_den(OBR(object))
#define OCXR(object)          (object)->data.complex.real
#define OCXI(object)          (object)->data.complex.imag

#define XALLOC(type)          LispMalloc(sizeof(type))
#define XFREE(ptr)            LispFree(ptr)


/*
 * Types
 */
typedef struct _n_real {
    char type;
    union {
      long fixnum;
      mpi *bignum;
      double flonum;
      struct {
          long num;
          long den;
      } fixratio;
      mpr *bigratio;
    } data;
} n_real;

typedef struct _n_number {
    char complex;
    n_real real;
    n_real imag;
} n_number;


/*
 * Prototypes
 */
static void number_init(void);
static LispObj *number_pi(void);

static void set_real_real(n_real*, n_real*);
static void set_real_object(n_real*, LispObj*);
static void set_number_object(n_number*, LispObj*);
static void clear_real(n_real*);
static void clear_number(n_number*);

static LispObj *make_real_object(n_real*);
static LispObj *make_number_object(n_number*);

static void fatal_error(int);
static void fatal_object_error(LispObj*, int);
static void fatal_builtin_object_error(LispBuiltin*, LispObj*, int);

static double bi_getd(mpi*);
static double br_getd(mpr*);

/* add */
static void add_real_object(n_real*, LispObj*);
static void add_number_object(n_number*, LispObj*);

/* sub */
static void sub_real_object(n_real*, LispObj*);
static void sub_number_object(n_number*, LispObj*);

/* mul */
static void mul_real_object(n_real*, LispObj*);
static void mul_number_object(n_number*, LispObj*);

/* div */
static void div_real_object(n_real*, LispObj*);
static void div_number_object(n_number*, LispObj*);

/* compare */
static int cmp_real_real(n_real*, n_real*);
static int cmp_real_object(n_real*, LispObj*);
#if 0 /* not used */
static int cmp_number_object(n_number*, LispObj*);
#endif
static int cmp_object_object(LispObj*, LispObj*, int);

/* fixnum */
static INLINE int fi_fi_add_overflow(long, long) CONST;
static INLINE int fi_fi_sub_overflow(long, long) CONST;
static INLINE int fi_fi_mul_overflow(long, long) CONST;

/* bignum */
static void rbi_canonicalize(n_real*);

/* ratio */
static void rfr_canonicalize(n_real*);
static void rbr_canonicalize(n_real*);

/* complex */
static void ncx_canonicalize(n_number*);

/* abs */
static void abs_real(n_real*);
static void abs_number(n_number*);
static void nabs_cx(n_number*);
static INLINE void rabs_fi(n_real*);
static INLINE void rabs_bi(n_real*);
static INLINE void rabs_ff(n_real*);
static INLINE void rabs_fr(n_real*);
static INLINE void rabs_br(n_real*);

/* neg */
static void neg_real(n_real*);
static void neg_number(n_number*);
static void rneg_fi(n_real*);
static INLINE void rneg_bi(n_real*);
static INLINE void rneg_ff(n_real*);
static INLINE void rneg_fr(n_real*);
static INLINE void rneg_br(n_real*);

/* sqrt */
static void sqrt_real(n_real*);
static void sqrt_number(n_number*);
static void rsqrt_xi(n_real*);
static void rsqrt_xr(n_real*);
static void rsqrt_ff(n_real*);
static void nsqrt_cx(n_number*);
static void nsqrt_xi(n_number*);
static void nsqrt_ff(n_number*);
static void nsqrt_xr(n_number*);

/* mod */
static void mod_real_real(n_real*, n_real*);
static void mod_real_object(n_real*, LispObj*);
static void rmod_fi_fi(n_real*, long);
static void rmod_fi_bi(n_real*, mpi*);
static void rmod_bi_fi(n_real*, long);
static void rmod_bi_bi(n_real*, mpi*);

/* rem */
static void rem_real_object(n_real*, LispObj*);
static void rrem_fi_fi(n_real*, long);
static void rrem_fi_bi(n_real*, mpi*);
static void rrem_bi_fi(n_real*, long);
static void rrem_bi_bi(n_real*, mpi*);

/* gcd */
static void gcd_real_object(n_real*, LispObj*);

/* and */
static void and_real_object(n_real*, LispObj*);

/* eqv */
static void eqv_real_object(n_real*, LispObj*);

/* ior */
static void ior_real_object(n_real*, LispObj*);

/* not */
static void not_real(n_real*);

/* xor */
static void xor_real_object(n_real*, LispObj*);

/* divide */
static void divide_number_object(n_number*, LispObj*, int, int);
static void ndivide_xi_xi(n_number*, LispObj*, int, int);
static void ndivide_flonum(n_number*, double, double, int, int);
static void ndivide_xi_xr(n_number*, LispObj*, int, int);
static void ndivide_xr_xi(n_number*, LispObj*, int, int);
static void ndivide_xr_xr(n_number*, LispObj*, int, int);

/* real complex */
static void nadd_re_cx(n_number*, LispObj*);
static void nsub_re_cx(n_number*, LispObj*);
static void nmul_re_cx(n_number*, LispObj*);
static void ndiv_re_cx(n_number*, LispObj*);

/* complex real */
static void nadd_cx_re(n_number*, LispObj*);
static void nsub_cx_re(n_number*, LispObj*);
static void nmul_cx_re(n_number*, LispObj*);
static void ndiv_cx_re(n_number*, LispObj*);

/* complex complex */
static void nadd_cx_cx(n_number*, LispObj*);
static void nsub_cx_cx(n_number*, LispObj*);
static void nmul_cx_cx(n_number*, LispObj*);
static void ndiv_cx_cx(n_number*, LispObj*);
static int cmp_cx_cx(LispObj*, LispObj*);

/* flonum flonum */
static void radd_flonum(n_real*, double, double);
static void rsub_flonum(n_real*, double, double);
static void rmul_flonum(n_real*, double, double);
static void rdiv_flonum(n_real*, double, double);
static int cmp_flonum(double, double);

/* fixnum fixnum */
static void rop_fi_fi_bi(n_real*, long, int);
static INLINE void radd_fi_fi(n_real*, long);
static INLINE void rsub_fi_fi(n_real*, long);
static INLINE void rmul_fi_fi(n_real*, long);
static INLINE void rdiv_fi_fi(n_real*, long);
static INLINE int cmp_fi_fi(long, long);
static void ndivide_fi_fi(n_number*, long, int, int);

/* fixnum bignum */
static void rop_fi_bi_xi(n_real*, mpi*, int);
static INLINE void radd_fi_bi(n_real*, mpi*);
static INLINE void rsub_fi_bi(n_real*, mpi*);
static INLINE void rmul_fi_bi(n_real*, mpi*);
static void rdiv_fi_bi(n_real*, mpi*);
static INLINE int cmp_fi_bi(long, mpi*);

/* fixnum fixratio */
static void rop_fi_fr_as_xr(n_real*, long, long, int);
static void rop_fi_fr_md_xr(n_real*, long, long, int);
static INLINE void radd_fi_fr(n_real*, long, long);
static INLINE void rsub_fi_fr(n_real*, long, long);
static INLINE void rmul_fi_fr(n_real*, long, long);
static INLINE void rdiv_fi_fr(n_real*, long, long);
static INLINE int cmp_fi_fr(long, long, long);

/* fixnum bigratio */
static void rop_fi_br_as_xr(n_real*, mpr*, int);
static void rop_fi_br_md_xr(n_real*, mpr*, int);
static INLINE void radd_fi_br(n_real*, mpr*);
static INLINE void rsub_fi_br(n_real*, mpr*);
static INLINE void rmul_fi_br(n_real*, mpr*);
static INLINE void rdiv_fi_br(n_real*, mpr*);
static INLINE int cmp_fi_br(long, mpr*);

/* bignum fixnum */
static INLINE void radd_bi_fi(n_real*, long);
static INLINE void rsub_bi_fi(n_real*, long);
static INLINE void rmul_bi_fi(n_real*, long);
static void rdiv_bi_fi(n_real*, long);
static INLINE int cmp_bi_fi(mpi*, long);

/* bignum bignum */
static INLINE void radd_bi_bi(n_real*, mpi*);
static INLINE void rsub_bi_bi(n_real*, mpi*);
static INLINE void rmul_bi_bi(n_real*, mpi*);
static void rdiv_bi_bi(n_real*, mpi*);
static INLINE int cmp_bi_bi(mpi*, mpi*);

/* bignum fixratio */
static void rop_bi_fr_as_xr(n_real*, long, long, int);
static void rop_bi_fr_md_xr(n_real*, long, long, int);
static INLINE void radd_bi_fr(n_real*, long, long);
static INLINE void rsub_bi_fr(n_real*, long, long);
static INLINE void rmul_bi_fr(n_real*, long, long);
static INLINE void rdiv_bi_fr(n_real*, long, long);
static int cmp_bi_fr(mpi*, long, long);

/* bignum bigratio */
static void rop_bi_br_as_xr(n_real*, mpr*, int);
static void rop_bi_br_md_xr(n_real*, mpr*, int);
static INLINE void radd_bi_br(n_real*, mpr*);
static INLINE void rsub_bi_br(n_real*, mpr*);
static INLINE void rmul_bi_br(n_real*, mpr*);
static INLINE void rdiv_bi_br(n_real*, mpr*);
static int cmp_bi_br(mpi*, mpr*);

/* fixratio fixnum */
static void rop_fr_fi_as_xr(n_real*, long, int);
static void rop_fr_fi_md_xr(n_real*, long, int);
static INLINE void radd_fr_fi(n_real*, long);
static INLINE void rsub_fr_fi(n_real*, long);
static INLINE void rmul_fr_fi(n_real*, long);
static INLINE void rdiv_fr_fi(n_real*, long);
static INLINE int cmp_fr_fi(long, long, long);

/* fixratio bignum */
static void rop_fr_bi_as_xr(n_real*, mpi*, int);
static void rop_fr_bi_md_xr(n_real*, mpi*, int);
static INLINE void radd_fr_bi(n_real*, mpi*);
static INLINE void rsub_fr_bi(n_real*, mpi*);
static INLINE void rmul_fr_bi(n_real*, mpi*);
static INLINE void rdiv_fr_bi(n_real*, mpi*);
static int cmp_fr_bi(long, long, mpi*);

/* fixratio fixratio */
static void rop_fr_fr_as_xr(n_real*, long, long, int);
static void rop_fr_fr_md_xr(n_real*, long, long, int);
static INLINE void radd_fr_fr(n_real*, long, long);
static INLINE void rsub_fr_fr(n_real*, long, long);
static INLINE void rmul_fr_fr(n_real*, long, long);
static INLINE void rdiv_fr_fr(n_real*, long, long);
static INLINE int cmp_fr_fr(long, long, long, long);

/* fixratio bigratio */
static void rop_fr_br_asmd_xr(n_real*, mpr*, int);
static INLINE void radd_fr_br(n_real*, mpr*);
static INLINE void rsub_fr_br(n_real*, mpr*);
static INLINE void rmul_fr_br(n_real*, mpr*);
static INLINE void rdiv_fr_br(n_real*, mpr*);
static int cmp_fr_br(long, long, mpr*);

/* bigratio fixnum */
static void rop_br_fi_asmd_xr(n_real*, long, int);
static INLINE void radd_br_fi(n_real*, long);
static INLINE void rsub_br_fi(n_real*, long);
static INLINE void rmul_br_fi(n_real*, long);
static INLINE void rdiv_br_fi(n_real*, long);
static int cmp_br_fi(mpr*, long);

/* bigratio bignum */
static void rop_br_bi_as_xr(n_real*, mpi*, int);
static INLINE void radd_br_bi(n_real*, mpi*);
static INLINE void rsub_br_bi(n_real*, mpi*);
static INLINE void rmul_br_bi(n_real*, mpi*);
static INLINE void rdiv_br_bi(n_real*, mpi*);
static int cmp_br_bi(mpr*, mpi*);

/* bigratio fixratio */
static void rop_br_fr_asmd_xr(n_real*, long, long, int);
static INLINE void radd_br_fr(n_real*, long, long);
static INLINE void rsub_br_fr(n_real*, long, long);
static INLINE void rmul_br_fr(n_real*, long, long);
static INLINE void rdiv_br_fr(n_real*, long, long);
static int cmp_br_fr(mpr*, long, long);

/* bigratio bigratio */
static INLINE void radd_br_br(n_real*, mpr*);
static INLINE void rsub_br_br(n_real*, mpr*);
static INLINE void rmul_br_br(n_real*, mpr*);
static INLINE void rdiv_br_br(n_real*, mpr*);
static INLINE int cmp_br_br(mpr*, mpr*);

/*
 * Initialization
 */
static n_real zero, one, two;

static char *fatal_error_strings[] = {
#define DIVIDE_BY_ZERO              0
    "divide by zero",
#define FLOATING_POINT_OVERFLOW           1
    "floating point overflow",
#define FLOATING_POINT_EXCEPTION    2
    "floating point exception"
};

static char *fatal_object_error_strings[] = {
#define NOT_A_NUMBER                0
    "is not a number",
#define NOT_A_REAL_NUMBER           1
    "is not a real number",
#define NOT_AN_INTEGER              2
    "is not an integer"
};

/*
 * Implementation
 */
static void
fatal_error(int num)
{
    LispDestroy(fatal_error_strings[num]);
}

static void
fatal_object_error(LispObj *obj, int num)
{
    LispDestroy("%s %s", STROBJ(obj), fatal_object_error_strings[num]);
}

static void
fatal_builtin_object_error(LispBuiltin *builtin, LispObj *obj, int num)
{
    LispDestroy("%s: %s %s", STRFUN(builtin), STROBJ(obj),
            fatal_object_error_strings[num]);
}

static void
number_init(void)
{
    zero.type = one.type = two.type = N_FIXNUM;
    zero.data.fixnum = 0;
    one.data.fixnum = 1;
    two.data.fixnum = 2;
}

static double
bi_getd(mpi *bignum)
{
    double value = mpi_getd(bignum);

    if (!finite(value))
      fatal_error(FLOATING_POINT_EXCEPTION);

    return (value);
}

static double
br_getd(mpr *bigratio)
{
    double value = mpr_getd(bigratio);

    if (!finite(value))
      fatal_error(FLOATING_POINT_EXCEPTION);

    return (value);
}

static LispObj *
number_pi(void)
{
    LispObj *result;
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif
    result = DFLOAT(M_PI);

    return (result);
}

static void
set_real_real(n_real *real, n_real *val)
{
    switch (RTYPE(real) = RTYPE(val)) {
      case N_FIXNUM:
          RFI(real) = RFI(val);
          break;
      case N_BIGNUM:
          RBI(real) = XALLOC(mpi);
          mpi_init(RBI(real));
          mpi_set(RBI(real), RBI(val));
          break;
      case N_FLONUM:
          RFF(real) = RFF(val);
          break;
      case N_FIXRATIO:
          RFRN(real) = RFRN(val);
          RFRD(real) = RFRD(val);
          break;
      case N_BIGRATIO:
          RBR(real) = XALLOC(mpr);
          mpr_init(RBR(real));
          mpr_set(RBR(real), RBR(val));
          break;
    }
}

static void
set_real_object(n_real *real, LispObj *obj)
{
    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          RTYPE(real) = N_FIXNUM;
          RFI(real) = OFI(obj);
          break;
      case LispInteger_t:
          RTYPE(real) = N_FIXNUM;
          RFI(real) = OII(obj);
          break;
      case LispBignum_t:
          RTYPE(real) = N_BIGNUM;
          RBI(real) = XALLOC(mpi);
          mpi_init(RBI(real));
          mpi_set(RBI(real), OBI(obj));
          break;
      case LispDFloat_t:
          RTYPE(real) = N_FLONUM;
          RFF(real) = ODF(obj);
          break;
      case LispRatio_t:
          RTYPE(real) = N_FIXRATIO;
          RFRN(real) = OFRN(obj);
          RFRD(real) = OFRD(obj);
          break;
      case LispBigratio_t:
          RTYPE(real) = N_BIGRATIO;
          RBR(real) = XALLOC(mpr);
          mpr_init(RBR(real));
          mpr_set(RBR(real), OBR(obj));
          break;
      default:
          fatal_object_error(obj, NOT_A_REAL_NUMBER);
          break;
    }
}

static void
set_number_object(n_number *num, LispObj *obj)
{
    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          num->complex = 0;
          NRTYPE(num) = N_FIXNUM;
          NRFI(num) = OFI(obj);
          break;
      case LispInteger_t:
          num->complex = 0;
          NRTYPE(num) = N_FIXNUM;
          NRFI(num) = OII(obj);
          break;
      case LispBignum_t:
          num->complex = 0;
          NRTYPE(num) = N_BIGNUM;
          NRBI(num) = XALLOC(mpi);
          mpi_init(NRBI(num));
          mpi_set(NRBI(num), OBI(obj));
          break;
      case LispDFloat_t:
          num->complex = 0;
          NRTYPE(num) = N_FLONUM;
          NRFF(num) = ODF(obj);
          break;
      case LispRatio_t:
          num->complex = 0;
          NRTYPE(num) = N_FIXRATIO;
          NRFRN(num) = OFRN(obj);
          NRFRD(num) = OFRD(obj);
          break;
      case LispBigratio_t:
          num->complex = 0;
          NRTYPE(num) = N_BIGRATIO;
          NRBR(num) = XALLOC(mpr);
          mpr_init(NRBR(num));
          mpr_set(NRBR(num), OBR(obj));
          break;
      case LispComplex_t:
          num->complex = 1;
          set_real_object(NREAL(num), OCXR(obj));
          set_real_object(NIMAG(num), OCXI(obj));
          break;
      default:
          fatal_object_error(obj, NOT_A_NUMBER);
          break;
    }
}

static void
clear_real(n_real *real)
{
    if (RTYPE(real) == N_BIGNUM) {
      mpi_clear(RBI(real));
      XFREE(RBI(real));
    }
    else if (RTYPE(real) == N_BIGRATIO) {
      mpr_clear(RBR(real));
      XFREE(RBR(real));
    }
}

static void
clear_number(n_number *num)
{
    clear_real(NREAL(num));
    if (num->complex)
      clear_real(NIMAG(num));
}

static LispObj *
make_real_object(n_real *real)
{
    LispObj *obj;

    switch (RTYPE(real)) {
      case N_FIXNUM:
          if (RFI(real) > MOST_POSITIVE_FIXNUM ||
            RFI(real) < MOST_NEGATIVE_FIXNUM) {
            obj = LispNew(NIL, NIL);
            obj->type = LispInteger_t;
            OII(obj) = RFI(real);
          }
          else
            obj = FIXNUM(RFI(real));
          break;
      case N_BIGNUM:
          obj = BIGNUM(RBI(real));
          break;
      case N_FLONUM:
          obj = DFLOAT(RFF(real));
          break;
      case N_FIXRATIO:
          obj = LispNew(NIL, NIL);
          obj->type = LispRatio_t;
          OFRN(obj) = RFRN(real);
          OFRD(obj) = RFRD(real);
          break;
      case N_BIGRATIO:
          obj = BIGRATIO(RBR(real));
          break;
      default:
          obj = NIL;
          break;
    }

    return (obj);
}

static LispObj *
make_number_object(n_number *num)
{
    LispObj *obj;

    if (num->complex) {
      GC_ENTER();

      obj = LispNew(NIL, NIL);
      GC_PROTECT(obj);
      OCXI(obj) = NIL;
      obj->type = LispComplex_t;
      OCXR(obj) = make_real_object(NREAL(num));
      OCXI(obj) = make_real_object(NIMAG(num));
      GC_LEAVE();
    }
    else {
      switch (NRTYPE(num)) {
          case N_FIXNUM:
            if (NRFI(num) > MOST_POSITIVE_FIXNUM ||
                NRFI(num) < MOST_NEGATIVE_FIXNUM) {
                obj = LispNew(NIL, NIL);
                obj->type = LispInteger_t;
                OII(obj) = NRFI(num);
            }
            else
                obj = FIXNUM(NRFI(num));
            break;
          case N_BIGNUM:
            obj = BIGNUM(NRBI(num));
            break;
          case N_FLONUM:
            obj = DFLOAT(NRFF(num));
            break;
          case N_FIXRATIO:
            obj = LispNew(NIL, NIL);
            obj->type = LispRatio_t;
            OFRN(obj) = NRFRN(num);
            OFRD(obj) = NRFRD(num);
            break;
          case N_BIGRATIO:
            obj = BIGRATIO(NRBR(num));
            break;
          default:
            obj = NIL;
            break;
      }
    }

    return (obj);
}

#define DEFOP_REAL_REAL(OP)                                 \
OP##_real_real(n_real *real, n_real *val)                   \
{                                                     \
    switch (RTYPE(real)) {                                  \
      case N_FIXNUM:                                        \
          switch (RTYPE(val)) {                             \
            case N_FIXNUM:                                  \
                r##OP##_fi_fi(real, RFI(val));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_fi_bi(real, RBI(val));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, (double)RFI(real), RFF(val));      \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fi_fr(real, RFRN(val), RFRD(val));        \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_fi_br(real, RBR(val));              \
                break;                                \
          }                                           \
          break;                                      \
      case N_BIGNUM:                                        \
          switch (RTYPE(val)) {                             \
            case N_FIXNUM:                                  \
                r##OP##_bi_fi(real, RFI(val));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_bi_bi(real, RBI(val));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, bi_getd(RBI(real)), RFF(val));     \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_bi_fr(real, RFRN(val), RFRD(val));        \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_bi_br(real, RBR(val));              \
                break;                                \
          }                                           \
          break;                                      \
      case N_FLONUM:                                        \
          switch (RTYPE(val)) {                             \
            case N_FIXNUM:                                  \
                r##OP##_flonum(real, RFF(real), (double)RFI(val));      \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_flonum(real, RFF(real), bi_getd(RBI(val)));     \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real), RFF(val));        \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_flonum(real, RFF(real),             \
                         (double)RFRN(val) / (double)RFRD(val));\
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_flonum(real, RFF(real), br_getd(RBR(val)));     \
                break;                                \
          }                                           \
          break;                                      \
      case N_FIXRATIO:                                \
          switch (RTYPE(val)) {                             \
            case N_FIXNUM:                                  \
                r##OP##_fr_fi(real, RFI(val));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_fr_bi(real, RBI(val));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real,                        \
                        (double)RFRN(real) / (double)RFRD(real),\
                        RFF(val));                    \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fr_fr(real, RFRN(val), RFRD(val));        \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_fr_br(real, RBR(val));              \
                break;                                \
          }                                           \
          break;                                      \
      case N_BIGRATIO:                                \
          switch (RTYPE(val)) {                             \
            case N_FIXNUM:                                  \
                r##OP##_br_fi(real, RFI(val));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_br_bi(real, RBI(val));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, br_getd(RBR(real)), RFF(val));     \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_br_fr(real, RFRN(val), RFRD(val));        \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_br_br(real, RBR(val));              \
                break;                                \
          }                                           \
          break;                                      \
    }                                                 \
}

static void
DEFOP_REAL_REAL(add)

static void
DEFOP_REAL_REAL(sub)

static void
DEFOP_REAL_REAL(div)

static void
DEFOP_REAL_REAL(mul)


#define DEFOP_REAL_OBJECT(OP)                               \
OP##_real_object(n_real *real, LispObj *obj)                      \
{                                                     \
    switch (OBJECT_TYPE(obj)) {                                   \
      case LispFixnum_t:                                    \
          switch (RTYPE(real)) {                            \
            case N_FIXNUM:                                  \
                r##OP##_fi_fi(real, OFI(obj));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_bi_fi(real, OFI(obj));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real), (double)OFI(obj));      \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fr_fi(real, OFI(obj));              \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_br_fi(real, OFI(obj));              \
                break;                                \
          }                                           \
          break;                                      \
      case LispInteger_t:                                   \
          switch (RTYPE(real)) {                            \
            case N_FIXNUM:                                  \
                r##OP##_fi_fi(real, OII(obj));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_bi_fi(real, OII(obj));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real), (double)OII(obj));      \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fr_fi(real, OII(obj));              \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_br_fi(real, OII(obj));              \
                break;                                \
          }                                           \
          break;                                      \
      case LispBignum_t:                                    \
          switch (RTYPE(real)) {                            \
            case N_FIXNUM:                                  \
                r##OP##_fi_bi(real, OBI(obj));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_bi_bi(real, OBI(obj));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real), bi_getd(OBI(obj)));     \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fr_bi(real, OBI(obj));              \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_br_bi(real, OBI(obj));              \
                break;                                \
          }                                           \
          break;                                      \
      case LispDFloat_t:                                    \
          switch (RTYPE(real)) {                            \
            case N_FIXNUM:                                  \
                r##OP##_flonum(real, (double)RFI(real), ODF(obj));      \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_flonum(real, bi_getd(RBI(real)), ODF(obj));     \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real), ODF(obj));        \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_flonum(real,                        \
                        (double)RFRN(real) / (double)RFRD(real),\
                        ODF(obj));                    \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_flonum(real, br_getd(RBR(real)), ODF(obj));     \
                break;                                \
          }                                           \
          break;                                      \
      case LispRatio_t:                               \
          switch (RTYPE(real)) {                            \
            case N_FIXNUM:                                  \
                r##OP##_fi_fr(real, OFRN(obj), OFRD(obj));        \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_bi_fr(real, OFRN(obj), OFRD(obj));        \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real),             \
                        (double)OFRN(obj) / (double)OFRD(obj));   \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fr_fr(real, OFRN(obj), OFRD(obj));        \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_br_fr(real, OFRN(obj), OFRD(obj));        \
                break;                                \
          }                                           \
          break;                                      \
      case LispBigratio_t:                                  \
          switch (RTYPE(real)) {                            \
            case N_FIXNUM:                                  \
                r##OP##_fi_br(real, OBR(obj));              \
                break;                                \
            case N_BIGNUM:                                  \
                r##OP##_bi_br(real, OBR(obj));              \
                break;                                \
            case N_FLONUM:                                  \
                r##OP##_flonum(real, RFF(real), br_getd(OBR(obj)));     \
                break;                                \
            case N_FIXRATIO:                          \
                r##OP##_fr_br(real, OBR(obj));              \
                break;                                \
            case N_BIGRATIO:                          \
                r##OP##_br_br(real, OBR(obj));              \
                break;                                \
          }                                           \
          break;                                      \
      default:                                        \
          fatal_object_error(obj, NOT_A_REAL_NUMBER);             \
          break;                                      \
    }                                                 \
}

static void
DEFOP_REAL_OBJECT(add)

static void
DEFOP_REAL_OBJECT(sub)

static void
DEFOP_REAL_OBJECT(div)

static void
DEFOP_REAL_OBJECT(mul)


#define DEFOP_NUMBER_OBJECT(OP)                                   \
OP##_number_object(n_number *num, LispObj *obj)                   \
{                                                     \
    if (num->complex) {                                     \
      switch (OBJECT_TYPE(obj)) {                           \
          case LispFixnum_t:                                \
          case LispInteger_t:                               \
          case LispBignum_t:                                \
          case LispDFloat_t:                                \
          case LispRatio_t:                                 \
          case LispBigratio_t:                              \
            n##OP##_cx_re(num, obj);                        \
            break;                                          \
          case LispComplex_t:                               \
            n##OP##_cx_cx(num, obj);                        \
            break;                                          \
          default:                                          \
            fatal_object_error(obj, NOT_A_NUMBER);                \
            break;                                          \
      }                                               \
    }                                                 \
    else {                                            \
      switch (OBJECT_TYPE(obj)) {                           \
          case LispFixnum_t:                                \
            switch (NRTYPE(num)) {                          \
                case N_FIXNUM:                              \
                  r##OP##_fi_fi(NREAL(num), OFI(obj));            \
                  break;                                    \
                case N_BIGNUM:                              \
                  r##OP##_bi_fi(NREAL(num), OFI(obj));            \
                  break;                                    \
                case N_FLONUM:                              \
                  r##OP##_flonum(NREAL(num), NRFF(num),           \
                            (double)OFI(obj));              \
                  break;                                    \
                case N_FIXRATIO:                            \
                  r##OP##_fr_fi(NREAL(num), OFI(obj));            \
                  break;                                    \
                case N_BIGRATIO:                            \
                  r##OP##_br_fi(NREAL(num), OFI(obj));            \
                  break;                                    \
            }                                         \
            break;                                          \
          case LispInteger_t:                               \
            switch (NRTYPE(num)) {                          \
                case N_FIXNUM:                              \
                  r##OP##_fi_fi(NREAL(num), OII(obj));            \
                  break;                                    \
                case N_BIGNUM:                              \
                  r##OP##_bi_fi(NREAL(num), OII(obj));            \
                  break;                                    \
                case N_FLONUM:                              \
                  r##OP##_flonum(NREAL(num), NRFF(num),           \
                            (double)OII(obj));              \
                  break;                                    \
                case N_FIXRATIO:                            \
                  r##OP##_fr_fi(NREAL(num), OII(obj));            \
                  break;                                    \
                case N_BIGRATIO:                            \
                  r##OP##_br_fi(NREAL(num), OII(obj));            \
                  break;                                    \
            }                                         \
            break;                                          \
          case LispBignum_t:                                \
            switch (NRTYPE(num)) {                          \
                case N_FIXNUM:                              \
                  r##OP##_fi_bi(NREAL(num), OBI(obj));            \
                  break;                                    \
                case N_BIGNUM:                              \
                  r##OP##_bi_bi(NREAL(num), OBI(obj));            \
                  break;                                    \
                case N_FLONUM:                              \
                  r##OP##_flonum(NREAL(num), NRFF(num),           \
                               bi_getd(OBI(obj)));          \
                  break;                                    \
                case N_FIXRATIO:                            \
                  r##OP##_fr_bi(NREAL(num), OBI(obj));            \
                  break;                                    \
                case N_BIGRATIO:                            \
                  r##OP##_br_bi(NREAL(num), OBI(obj));            \
                  break;                                    \
            }                                         \
            break;                                          \
          case LispDFloat_t:                                \
            switch (NRTYPE(num)) {                          \
                case N_FIXNUM:                              \
                  r##OP##_flonum(NREAL(num), (double)NRFI(num),   \
                            ODF(obj));                      \
                  break;                                    \
                case N_BIGNUM:                              \
                  r##OP##_flonum(NREAL(num), bi_getd(NRBI(num)),  \
                            ODF(obj));                      \
                  break;                                    \
                case N_FLONUM:                              \
                  r##OP##_flonum(NREAL(num), NRFF(num), ODF(obj));\
                  break;                                    \
                case N_FIXRATIO:                            \
                  r##OP##_flonum(NREAL(num),                \
                            (double)NRFRN(num) /            \
                            (double)NRFRD(num),             \
                            ODF(obj));                      \
                  break;                                    \
                case N_BIGRATIO:                            \
                  r##OP##_flonum(NREAL(num), br_getd(NRBR(num)),  \
                            ODF(obj));                      \
                  break;                                    \
            }                                         \
            break;                                          \
          case LispRatio_t:                                 \
            switch (NRTYPE(num)) {                          \
                case N_FIXNUM:                              \
                  r##OP##_fi_fr(NREAL(num), OFRN(obj), OFRD(obj));\
                  break;                                    \
                case N_BIGNUM:                              \
                  r##OP##_bi_fr(NREAL(num), OFRN(obj), OFRD(obj));\
                  break;                                    \
                case N_FLONUM:                              \
                  r##OP##_flonum(NREAL(num), NRFF(num),           \
                            (double)OFRN(obj) /             \
                            (double)OFRD(obj));             \
                  break;                                    \
                case N_FIXRATIO:                            \
                  r##OP##_fr_fr(NREAL(num), OFRN(obj), OFRD(obj));\
                  break;                                    \
                case N_BIGRATIO:                            \
                  r##OP##_br_fr(NREAL(num), OFRN(obj), OFRD(obj));\
                  break;                                    \
            }                                         \
            break;                                          \
          case LispBigratio_t:                              \
            switch (NRTYPE(num)) {                          \
                case N_FIXNUM:                              \
                  r##OP##_fi_br(NREAL(num), OBR(obj));            \
                  break;                                    \
                case N_BIGNUM:                              \
                  r##OP##_bi_br(NREAL(num), OBR(obj));            \
                  break;                                    \
                case N_FLONUM:                              \
                  r##OP##_flonum(NREAL(num), NRFF(num),           \
                            br_getd(OBR(obj)));       \
                  break;                                    \
                case N_FIXRATIO:                            \
                  r##OP##_fr_br(NREAL(num), OBR(obj));            \
                  break;                                    \
                case N_BIGRATIO:                            \
                  r##OP##_br_br(NREAL(num), OBR(obj));            \
                  break;                                    \
            }                                         \
            break;                                          \
          case LispComplex_t:                               \
            n##OP##_re_cx(num, obj);                        \
            break;                                          \
          default:                                          \
            fatal_object_error(obj, NOT_A_NUMBER);                \
            break;                                          \
      }                                               \
    }                                                 \
}

static void
DEFOP_NUMBER_OBJECT(add)

static void
DEFOP_NUMBER_OBJECT(sub)

static void
DEFOP_NUMBER_OBJECT(div)

static void
DEFOP_NUMBER_OBJECT(mul)


/************************************************************************
 * ABS
 ************************************************************************/
static void
abs_real(n_real *real)
{
    switch (RTYPE(real)) {
      case N_FIXNUM:          rabs_fi(real);    break;
      case N_BIGNUM:          rabs_bi(real);    break;
      case N_FLONUM:          rabs_ff(real);    break;
      case N_FIXRATIO:  rabs_fr(real);    break;
      case N_BIGRATIO:  rabs_br(real);    break;
    }
}

static void
abs_number(n_number *num)
{
    if (num->complex)
      nabs_cx(num);
    else {
      switch (NRTYPE(num)) {
          case N_FIXNUM:      rabs_fi(NREAL(num));    break;
          case N_BIGNUM:      rabs_bi(NREAL(num));    break;
          case N_FLONUM:      rabs_ff(NREAL(num));    break;
          case N_FIXRATIO:    rabs_fr(NREAL(num));    break;
          case N_BIGRATIO:    rabs_br(NREAL(num));    break;
      }
    }
}

static void
nabs_cx(n_number *num)
{
    n_real temp;

    abs_real(NREAL(num));
    abs_real(NIMAG(num));

    if (cmp_real_real(NREAL(num), NIMAG(num)) < 0) {
      memcpy(&temp, NIMAG(num), sizeof(n_real));
      memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
      memcpy(NREAL(num), &temp, sizeof(n_real));
    }

    if (cmp_real_real(NIMAG(num), &zero) == 0) {
      num->complex = 0;
      if (NITYPE(num) == N_FLONUM) {
          /* change number type */
          temp.type = N_FLONUM;
          temp.data.flonum = 1.0;
          mul_real_real(NREAL(num), &temp);
      }
      else
          clear_real(NIMAG(num));
    }
    else {
      div_real_real(NIMAG(num), NREAL(num));
      set_real_real(&temp, NIMAG(num));
      mul_real_real(NIMAG(num), &temp);
      clear_real(&temp);

      add_real_real(NIMAG(num), &one);
      sqrt_real(NIMAG(num));

      mul_real_real(NIMAG(num), NREAL(num));
      clear_real(NREAL(num));
      memcpy(NREAL(num), NIMAG(num), sizeof(n_real));
      num->complex = 0;
    }
}

static INLINE void
rabs_fi(n_real *real)
{
    if (RFI(real) < 0)
      rneg_fi(real);
}

static INLINE void
rabs_bi(n_real *real)
{
    if (mpi_cmpi(RBI(real), 0) < 0)
      mpi_neg(RBI(real), RBI(real));
}

static INLINE void
rabs_ff(n_real *real)
{
    if (RFF(real) < 0.0)
      RFF(real) = -RFF(real);
}

static INLINE void
rabs_fr(n_real *real)
{
    if (RFRN(real) < 0)
      rneg_fr(real);
}

static INLINE void
rabs_br(n_real *real)
{
    if (mpi_cmpi(RBRN(real), 0) < 0)
      mpi_neg(RBRN(real), RBRN(real));
}


/************************************************************************
 * NEG
 ************************************************************************/
static void
neg_real(n_real *real)
{
    switch (RTYPE(real)) {
      case N_FIXNUM:          rneg_fi(real);    break;
      case N_BIGNUM:          rneg_bi(real);    break;
      case N_FLONUM:          rneg_ff(real);    break;
      case N_FIXRATIO:  rneg_fr(real);    break;
      case N_BIGRATIO:  rneg_br(real);    break;
    }
}

static void
neg_number(n_number *num)
{
    if (num->complex) {
      neg_real(NREAL(num));
      neg_real(NIMAG(num));
    }
    else {
      switch (NRTYPE(num)) {
          case N_FIXNUM:      rneg_fi(NREAL(num));    break;
          case N_BIGNUM:      rneg_bi(NREAL(num));    break;
          case N_FLONUM:      rneg_ff(NREAL(num));    break;
          case N_FIXRATIO:    rneg_fr(NREAL(num));    break;
          case N_BIGRATIO:    rneg_br(NREAL(num));    break;
      }
    }
}

static void
rneg_fi(n_real *real)
{
    if (RFI(real) == MINSLONG) {
      mpi *bigi = XALLOC(mpi);

      mpi_init(bigi);
      mpi_seti(bigi, RFI(real));
      mpi_neg(bigi, bigi);
      RTYPE(real) = N_BIGNUM;
      RBI(real) = bigi;
    }
    else
      RFI(real) = -RFI(real);
}

static INLINE void
rneg_bi(n_real *real)
{
    mpi_neg(RBI(real), RBI(real));
}

static INLINE void
rneg_ff(n_real *real)
{
    RFF(real) = -RFF(real);
}

static void
rneg_fr(n_real *real)
{
    if (RFRN(real) == MINSLONG) {
      mpr *bigr = XALLOC(mpr);

      mpr_init(bigr);
      mpr_seti(bigr, RFRN(real), RFRD(real));
      mpi_neg(mpr_num(bigr), mpr_num(bigr));
      RTYPE(real) = N_BIGRATIO;
      RBR(real) = bigr;
    }
    else
      RFRN(real) = -RFRN(real);
}

static INLINE void
rneg_br(n_real *real)
{
    mpi_neg(RBRN(real), RBRN(real));
}


/************************************************************************
 * SQRT
 ************************************************************************/
static void
sqrt_real(n_real *real)
{
    switch (RTYPE(real)) {
      case N_FIXNUM:
      case N_BIGNUM:
          rsqrt_xi(real);
          break;
      case N_FLONUM:
          rsqrt_ff(real);
          break;
      case N_FIXRATIO:
      case N_BIGRATIO:
          rsqrt_xr(real);
          break;
    }
}

static void
sqrt_number(n_number *num)
{
    if (num->complex)
      nsqrt_cx(num);
    else {
      switch (NRTYPE(num)) {
          case N_FIXNUM:
          case N_BIGNUM:
            nsqrt_xi(num);
            break;
          case N_FLONUM:
            nsqrt_ff(num);
            break;
          case N_FIXRATIO:
          case N_BIGRATIO:
            nsqrt_xr(num);
            break;
      }
    }
}

static void
rsqrt_xi(n_real *real)
{
    int exact;
    mpi bignum;

    if (cmp_real_real(real, &zero) < 0)
      fatal_error(FLOATING_POINT_EXCEPTION);

    mpi_init(&bignum);
    if (RTYPE(real) == N_BIGNUM)
      exact = mpi_sqrt(&bignum, RBI(real));
    else {
      mpi tmp;

      mpi_init(&tmp);
      mpi_seti(&tmp, RFI(real));
      exact = mpi_sqrt(&bignum, &tmp);
      mpi_clear(&tmp);
    }
    if (exact) {
      if (RTYPE(real) == N_BIGNUM) {
          mpi_set(RBI(real), &bignum);
          rbi_canonicalize(real);
      }
      else
          RFI(real) = mpi_geti(&bignum);
    }
    else {
      double value;

      if (RTYPE(real) == N_BIGNUM) {
          value = bi_getd(RBI(real));
          RCLEAR_BI(real);
      }
      else
          value = (double)RFI(real);

      value = sqrt(value);
      RTYPE(real) = N_FLONUM;
      RFF(real) = value;
    }
    mpi_clear(&bignum);
}

static void
rsqrt_xr(n_real *real)
{
    n_real num, den;

    if (cmp_real_real(real, &zero) < 0)
      fatal_error(FLOATING_POINT_EXCEPTION);

    if (RTYPE(real) == N_FIXRATIO) {
      num.type = den.type = N_FIXNUM;
      num.data.fixnum = RFRN(real);
      den.data.fixnum = RFRD(real);
    }
    else {
      mpi *bignum;

      if (mpi_fiti(RBRN(real))) {
          num.type = N_FIXNUM;
          num.data.fixnum = mpi_geti(RBRN(real));
      }
      else {
          bignum = XALLOC(mpi);
          mpi_init(bignum);
          mpi_set(bignum, RBRN(real));
          num.type = N_BIGNUM;
          num.data.bignum = bignum;
      }

      if (mpi_fiti(RBRD(real))) {
          den.type = N_FIXNUM;
          den.data.fixnum = mpi_geti(RBRD(real));
      }
      else {
          bignum = XALLOC(mpi);
          mpi_init(bignum);
          mpi_set(bignum, RBRD(real));
          den.type = N_BIGNUM;
          den.data.bignum = bignum;
      }
    }

    rsqrt_xi(&num);
    rsqrt_xi(&den);

    clear_real(real);
    memcpy(real, &num, sizeof(n_real));
    div_real_real(real, &den);
    clear_real(&den);
}

static void
rsqrt_ff(n_real *real)
{
    if (RFF(real) < 0.0)
      fatal_error(FLOATING_POINT_EXCEPTION);
    RFF(real) = sqrt(RFF(real));
}


static void
nsqrt_cx(n_number *num)
{
    n_number mag;
    n_real *real, *imag;

    real = &(mag.real);
    imag = &(mag.imag);
    set_real_real(real, NREAL(num));
    set_real_real(imag, NIMAG(num));
    mag.complex = 1;

    nabs_cx(&mag);      /* this will free the imag part data */
    if (cmp_real_real(real, &zero) == 0) {
      clear_number(num);
      memcpy(NREAL(num), real, sizeof(n_real));
      clear_real(real);
      num->complex = 0;
      return;
    }
    else if (cmp_real_real(NREAL(num), &zero) > 0) {
      /* R = sqrt((mag + Ra) / 2) */
      add_real_real(NREAL(num), real);
      clear_real(real);
      div_real_real(NREAL(num), &two);
      sqrt_real(NREAL(num));

      /* I = Ia / R / 2 */
      div_real_real(NIMAG(num), NREAL(num));
      div_real_real(NIMAG(num), &two);
    }
    else {
      /* remember old imag part */
      memcpy(imag, NIMAG(num), sizeof(n_real));

      /* I = sqrt((mag - Ra) / 2) */
      memcpy(NIMAG(num), real, sizeof(n_real));
      sub_real_real(NIMAG(num), NREAL(num));
      div_real_real(NIMAG(num), &two);
      sqrt_real(NIMAG(num));
      if (cmp_real_real(imag, &zero) < 0)
          neg_real(NIMAG(num));

      /* R = Ia / I / 2 */
      clear_real(NREAL(num));
      /* start with old imag part */
      memcpy(NREAL(num), imag, sizeof(n_real));
      div_real_real(NREAL(num), NIMAG(num));
      div_real_real(NREAL(num), &two);
    }

    ncx_canonicalize(num);
}

static void
nsqrt_xi(n_number *num)
{
    if (cmp_real_real(NREAL(num), &zero) < 0) {
      memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
      neg_real(NIMAG(num));
      rsqrt_xi(NIMAG(num));
      NRTYPE(num) = N_FIXNUM;
      NRFI(num) = 0;
      num->complex = 1;
    }
    else
      rsqrt_xi(NREAL(num));
}

static void
nsqrt_ff(n_number *num)
{
    double value;

    if (NRFF(num) < 0.0) {
      value = sqrt(-NRFF(num));

      NITYPE(num) = N_FLONUM;
      NIFF(num) = value;
      NRTYPE(num) = N_FIXNUM;
      NRFI(num) = 0;
      num->complex = 1;
    }
    else {
      value = sqrt(NRFF(num));
      NRFF(num) = value;
    }
}

static void
nsqrt_xr(n_number *num)
{
    if (cmp_real_real(NREAL(num), &zero) < 0) {
      memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
      neg_real(NIMAG(num));
      rsqrt_xr(NIMAG(num));
      NRTYPE(num) = N_FIXNUM;
      NRFI(num) = 0;
      num->complex = 1;
    }
    else
      rsqrt_xr(NREAL(num));
}


/************************************************************************
 * MOD
 ************************************************************************/
static void
mod_real_real(n_real *real, n_real *val)
{
    /* Assume both operands are integers */
    switch (RTYPE(real)) {
      case N_FIXNUM:
          switch (RTYPE(val)) {
            case N_FIXNUM:
                rmod_fi_fi(real, RFI(val));
                break;
            case N_BIGNUM:
                rmod_fi_bi(real, RBI(val));
                break;
          }
          break;
      case N_BIGNUM:
          switch (RTYPE(val)) {
            case N_FIXNUM:
                rmod_bi_fi(real, RFI(val));
                break;
            case N_BIGNUM:
                rmod_bi_bi(real, RBI(val));
                break;
          }
          break;
    }
}

static void
mod_real_object(n_real *real, LispObj *obj)
{
    switch (RTYPE(real)) {
      case N_FIXNUM:
          switch (OBJECT_TYPE(obj)) {
            case LispFixnum_t:
                rmod_fi_fi(real, OFI(obj));
                return;
            case LispInteger_t:
                rmod_fi_fi(real, OII(obj));
                return;
            case LispBignum_t:
                rmod_fi_bi(real, OBI(obj));
                return;
            default:
                break;
          }
          break;
      case N_BIGNUM:
          switch (OBJECT_TYPE(obj)) {
            case LispFixnum_t:
                rmod_bi_fi(real, OFI(obj));
                return;
            case LispInteger_t:
                rmod_bi_fi(real, OII(obj));
                return;
            case LispBignum_t:
                rmod_bi_bi(real, OBI(obj));
                return;
            default:
                break;
          }
          break;
      /* Assume the n_real object is an integer */
    }
    fatal_object_error(obj, NOT_AN_INTEGER);
}

static void
rmod_fi_fi(n_real *real, long fi)
{
    if (fi == 0)
      fatal_error(DIVIDE_BY_ZERO);

    if ((RFI(real) < 0) ^ (fi < 0))
      RFI(real) = (RFI(real) % fi) + fi;
    else if (RFI(real) == MINSLONG || fi == MINSLONG) {
      mpi bignum;

      mpi_init(&bignum);
      mpi_seti(&bignum, RFI(real));
      RFI(real) = mpi_modi(&bignum, fi);
      mpi_clear(&bignum);
    }
    else
      RFI(real) = RFI(real) % fi;
}

static void
rmod_fi_bi(n_real *real, mpi *bignum)
{
    mpi *bigi;

    if (mpi_cmpi(bignum, 0) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    bigi = XALLOC(mpi);
    mpi_init(bigi);
    mpi_seti(bigi, RFI(real));
    mpi_mod(bigi, bigi, bignum);
    RTYPE(real) = N_BIGNUM;
    RBI(real) = bigi;
    rbi_canonicalize(real);
}

static void
rmod_bi_fi(n_real *real, long fi)
{
    mpi iop;

    if (fi == 0)
      fatal_error(DIVIDE_BY_ZERO);

    mpi_init(&iop);
    mpi_seti(&iop, fi);
    mpi_mod(RBI(real), RBI(real), &iop);
    mpi_clear(&iop);
    rbi_canonicalize(real);
}

static void
rmod_bi_bi(n_real *real, mpi *bignum)
{
    if (mpi_cmpi(bignum, 0) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    mpi_mod(RBI(real), RBI(real), bignum);
    rbi_canonicalize(real);
}

/************************************************************************
 * REM
 ************************************************************************/
static void
rem_real_object(n_real *real, LispObj *obj)
{
    switch (RTYPE(real)) {
      case N_FIXNUM:
          switch (OBJECT_TYPE(obj)) {
            case LispFixnum_t:
                rrem_fi_fi(real, OFI(obj));
                return;
            case LispInteger_t:
                rrem_fi_fi(real, OII(obj));
                return;
            case LispBignum_t:
                rrem_fi_bi(real, OBI(obj));
                return;
            default:
                break;
          }
          break;
      case N_BIGNUM:
          switch (OBJECT_TYPE(obj)) {
            case LispFixnum_t:
                rrem_bi_fi(real, OFI(obj));
                return;
            case LispInteger_t:
                rrem_bi_fi(real, OII(obj));
                return;
            case LispBignum_t:
                rrem_bi_bi(real, OBI(obj));
                return;
            default:
                break;
          }
          break;
      /* Assume the n_real object is an integer */
    }
    fatal_object_error(obj, NOT_AN_INTEGER);
}

static void
rrem_fi_fi(n_real *real, long fi)
{
    if (fi == 0)
      fatal_error(DIVIDE_BY_ZERO);

    if (RFI(real) == MINSLONG || fi == MINSLONG) {
      mpi bignum;

      mpi_init(&bignum);
      mpi_seti(&bignum, RFI(real));
      RFI(real) = mpi_remi(&bignum, fi);
      mpi_clear(&bignum);
    }
    else
      RFI(real) = RFI(real) % fi;
}

static void
rrem_fi_bi(n_real *real, mpi *bignum)
{
    mpi *bigi;

    if (mpi_cmpi(bignum, 0) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    bigi = XALLOC(mpi);
    mpi_init(bigi);
    mpi_seti(bigi, RFI(real));
    mpi_rem(bigi, bigi, bignum);
    RTYPE(real) = N_BIGNUM;
    RBI(real) = bigi;
    rbi_canonicalize(real);
}

static void
rrem_bi_fi(n_real *real, long fi)
{
    mpi iop;

    if (fi == 0)
      fatal_error(DIVIDE_BY_ZERO);

    mpi_init(&iop);
    mpi_seti(&iop, fi);
    mpi_rem(RBI(real), RBI(real), &iop);
    mpi_clear(&iop);
    rbi_canonicalize(real);
}

static void
rrem_bi_bi(n_real *real, mpi *bignum)
{
    if (mpi_cmpi(bignum, 0) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    mpi_rem(RBI(real), RBI(real), bignum);
    rbi_canonicalize(real);
}


/************************************************************************
 * GCD
 ************************************************************************/
static void
gcd_real_object(n_real *real, LispObj *obj)
{
    if (!INTEGERP(obj))
      fatal_object_error(obj, NOT_AN_INTEGER);

    /* check for zero operand */
    if (cmp_real_real(real, &zero) == 0)
      set_real_object(real, obj);
    else if (cmp_real_object(&zero, obj) != 0) {
      n_real rest, temp;

      set_real_object(&rest, obj);
      for (;;) {
          mod_real_real(&rest, real);
          if (cmp_real_real(&rest, &zero) == 0)
            break;
          memcpy(&temp, real, sizeof(n_real));
          memcpy(real, &rest, sizeof(n_real));
          memcpy(&rest, &temp, sizeof(n_real));
      }
      clear_real(&rest);
    }
}

/************************************************************************
 * AND
 ************************************************************************/
static void
and_real_object(n_real *real, LispObj *obj)
{
    mpi *bigi, iop;

    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) &= OFI(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OFI(obj));
                mpi_and(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispInteger_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) &= OII(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OII(obj));
                mpi_and(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispBignum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                bigi = XALLOC(mpi);
                mpi_init(bigi);
                mpi_seti(bigi, RFI(real));
                mpi_and(bigi, bigi, OBI(obj));
                RTYPE(real) = N_BIGNUM;
                RBI(real) = bigi;
                rbi_canonicalize(real);
                break;
            case N_BIGNUM:
                mpi_and(RBI(real), RBI(real), OBI(obj));
                rbi_canonicalize(real);
                break;
          }
          break;
      default:
          fatal_object_error(obj, NOT_AN_INTEGER);
          break;
    }
}


/************************************************************************
 * EQV
 ************************************************************************/
static void
eqv_real_object(n_real *real, LispObj *obj)
{
    mpi *bigi, iop;

    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) ^= ~OFI(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OFI(obj));
                mpi_com(&iop, &iop);
                mpi_xor(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispInteger_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) ^= ~OII(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OII(obj));
                mpi_com(&iop, &iop);
                mpi_xor(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispBignum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                bigi = XALLOC(mpi);
                mpi_init(bigi);
                mpi_seti(bigi, RFI(real));
                mpi_com(bigi, bigi);
                mpi_xor(bigi, bigi, OBI(obj));
                RTYPE(real) = N_BIGNUM;
                RBI(real) = bigi;
                rbi_canonicalize(real);
                break;
            case N_BIGNUM:
                mpi_com(RBI(real), RBI(real));
                mpi_xor(RBI(real), RBI(real), OBI(obj));
                rbi_canonicalize(real);
                break;
          }
          break;
      default:
          fatal_object_error(obj, NOT_AN_INTEGER);
          break;
    }
}


/************************************************************************
 * IOR
 ************************************************************************/
static void
ior_real_object(n_real *real, LispObj *obj)
{
    mpi *bigi, iop;

    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) |= OFI(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OFI(obj));
                mpi_ior(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispInteger_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) |= OII(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OII(obj));
                mpi_ior(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispBignum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                bigi = XALLOC(mpi);
                mpi_init(bigi);
                mpi_seti(bigi, RFI(real));
                mpi_ior(bigi, bigi, OBI(obj));
                RTYPE(real) = N_BIGNUM;
                RBI(real) = bigi;
                rbi_canonicalize(real);
                break;
            case N_BIGNUM:
                mpi_ior(RBI(real), RBI(real), OBI(obj));
                rbi_canonicalize(real);
                break;
          }
          break;
      default:
          fatal_object_error(obj, NOT_AN_INTEGER);
          break;
    }
}


/************************************************************************
 * NOT
 ************************************************************************/
static void
not_real(n_real *real)
{
    if (RTYPE(real) == N_FIXNUM)
      RFI(real) = ~RFI(real);
    else {
      mpi_com(RBI(real), RBI(real));
      rbi_canonicalize(real);
    }
}

/************************************************************************
 * XOR
 ************************************************************************/
static void
xor_real_object(n_real *real, LispObj *obj)
{
    mpi *bigi, iop;

    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) ^= OFI(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OFI(obj));
                mpi_xor(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispInteger_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                RFI(real) ^= OII(obj);
                break;
            case N_BIGNUM:
                mpi_init(&iop);
                mpi_seti(&iop, OII(obj));
                mpi_xor(RBI(real), RBI(real), &iop);
                mpi_clear(&iop);
                rbi_canonicalize(real);
                break;
          }
          break;
      case LispBignum_t:
          switch (RTYPE(real)) {
            case N_FIXNUM:
                bigi = XALLOC(mpi);
                mpi_init(bigi);
                mpi_seti(bigi, RFI(real));
                mpi_xor(bigi, bigi, OBI(obj));
                RTYPE(real) = N_BIGNUM;
                RBI(real) = bigi;
                rbi_canonicalize(real);
                break;
            case N_BIGNUM:
                mpi_xor(RBI(real), RBI(real), OBI(obj));
                rbi_canonicalize(real);
                break;
          }
          break;
      default:
          fatal_object_error(obj, NOT_AN_INTEGER);
          break;
    }
}


/************************************************************************
 * DIVIDE
 ************************************************************************/
static void
divide_number_object(n_number *num, LispObj *obj, int fun, int flo)
{
    switch (OBJECT_TYPE(obj)) {
      case LispFixnum_t:
          switch (NRTYPE(num)) {
            case N_FIXNUM:
                ndivide_fi_fi(num, OFI(obj), fun, flo);
                break;
            case N_BIGNUM:
                ndivide_xi_xi(num, obj, fun, flo);
                break;
            case N_FLONUM:
                ndivide_flonum(num, NRFF(num), (double)OFI(obj), fun, flo);
                break;
            case N_FIXRATIO:
            case N_BIGRATIO:
                ndivide_xr_xi(num, obj, fun, flo);
                break;
          }
          break;
      case LispInteger_t:
          switch (NRTYPE(num)) {
            case N_FIXNUM:
                ndivide_fi_fi(num, OII(obj), fun, flo);
                break;
            case N_BIGNUM:
                ndivide_xi_xi(num, obj, fun, flo);
                break;
            case N_FLONUM:
                ndivide_flonum(num, NRFF(num), (double)OII(obj), fun, flo);
                break;
            case N_FIXRATIO:
            case N_BIGRATIO:
                ndivide_xr_xi(num, obj, fun, flo);
                break;
          }
          break;
      case LispBignum_t:
          switch (NRTYPE(num)) {
            case N_FIXNUM:
            case N_BIGNUM:
                ndivide_xi_xi(num, obj, fun, flo);
                break;
            case N_FLONUM:
                ndivide_flonum(num, NRFF(num), bi_getd(OBI(obj)),
                           fun, flo);
                break;
            case N_FIXRATIO:
            case N_BIGRATIO:
                ndivide_xr_xi(num, obj, fun, flo);
                break;
          }
          break;
      case LispDFloat_t:
          switch (NRTYPE(num)) {
            case N_FIXNUM:
                ndivide_flonum(num, (double)NRFI(num), ODF(obj),
                           fun, flo);
                break;
            case N_BIGNUM:
                ndivide_flonum(num, bi_getd(NRBI(num)), ODF(obj),
                           fun, flo);
                break;
            case N_FLONUM:
                ndivide_flonum(num, NRFF(num), ODF(obj), fun, flo);
                break;
            case N_FIXRATIO:
                ndivide_flonum(num,
                           (double)NRFRN(num) / (double)NRFRD(num),
                           ODF(obj), fun, flo);
                break;
            case N_BIGRATIO:
                ndivide_flonum(num, br_getd(NRBR(num)), ODF(obj),
                           fun, flo);
                break;
          }
          break;
      case LispRatio_t:
          switch (NRTYPE(num)) {
            case N_FIXNUM:
            case N_BIGNUM:
                ndivide_xi_xr(num, obj, fun, flo);
                break;
            case N_FLONUM:
                ndivide_flonum(num, NRFF(num),
                           (double)OFRN(obj) / (double)OFRD(obj),
                           fun, flo);
                break;
            case N_FIXRATIO:
            case N_BIGRATIO:
                ndivide_xr_xr(num, obj, fun, flo);
                break;
          }
          break;
      case LispBigratio_t:
          switch (NRTYPE(num)) {
            case N_FIXNUM:
            case N_BIGNUM:
                ndivide_xi_xr(num, obj, fun, flo);
                break;
            case N_FLONUM:
                ndivide_flonum(num, NRFF(num), br_getd(OBR(obj)),
                           fun, flo);
                break;
            case N_FIXRATIO:
            case N_BIGRATIO:
                ndivide_xr_xr(num, obj, fun, flo);
                break;
          }
          break;
      default:
          fatal_object_error(obj, NOT_A_REAL_NUMBER);
          break;
    }
}


/************************************************************************
 * COMPARE
 ************************************************************************/
static int
cmp_real_real(n_real *op1, n_real *op2)
{
    switch (RTYPE(op1)) {
      case N_FIXNUM:
          switch (RTYPE(op2)) {
            case N_FIXNUM:
                return (cmp_fi_fi(RFI(op1), RFI(op2)));
            case N_BIGNUM:
                return (cmp_fi_bi(RFI(op1), RBI(op2)));
            case N_FLONUM:
                return (cmp_flonum((double)RFI(op1), RFF(op2)));
            case N_FIXRATIO:
                return (cmp_fi_fr(RFI(op1), RFRN(op2), RFRD(op2)));
            case N_BIGRATIO:
                return (cmp_fi_br(RFI(op1), RBR(op2)));
          }
          break;
      case N_BIGNUM:
          switch (RTYPE(op2)) {
            case N_FIXNUM:
                return (cmp_bi_fi(RBI(op1), RFI(op2)));
            case N_BIGNUM:
                return (cmp_bi_bi(RBI(op1), RBI(op2)));
            case N_FLONUM:
                return (cmp_flonum(bi_getd(RBI(op1)), RFF(op2)));
            case N_FIXRATIO:
                return (cmp_bi_fr(RBI(op1), RFRN(op2), RFRD(op2)));
            case N_BIGRATIO:
                return (cmp_bi_br(RBI(op1), RBR(op2)));
          }
          break;
      case N_FLONUM:
          switch (RTYPE(op2)) {
            case N_FIXNUM:
                return (cmp_flonum(RFF(op1), (double)RFI(op2)));
            case N_BIGNUM:
                return (cmp_flonum(RFF(op1), bi_getd(RBI(op2))));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1), RFF(op2)));
            case N_FIXRATIO:
                return (cmp_flonum(RFF(op1),
                               (double)RFRN(op2) / (double)RFRD(op2)));
            case N_BIGRATIO:
                return (cmp_flonum(RFF(op1), br_getd(RBR(op2))));
          }
          break;
      case N_FIXRATIO:
          switch (RTYPE(op2)) {
            case N_FIXNUM:
                return (cmp_fr_fi(RFRN(op1), RFRD(op1), RFI(op2)));
            case N_BIGNUM:
                return (cmp_fr_bi(RFRN(op1), RFRD(op1), RBI(op2)));
            case N_FLONUM:
                return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1),
                               RFF(op2)));
            case N_FIXRATIO:
                return (cmp_fr_fr(RFRN(op1), RFRD(op1),
                              RFRN(op2), RFRD(op2)));
            case N_BIGRATIO:
                return (cmp_fr_br(RFRN(op1), RFRD(op1), RBR(op2)));
          }
          break;
      case N_BIGRATIO:
          switch (RTYPE(op2)) {
            case N_FIXNUM:
                return (cmp_br_fi(RBR(op1), RFI(op2)));
            case N_BIGNUM:
                return (cmp_br_bi(RBR(op1), RBI(op2)));
            case N_FLONUM:
                return (cmp_flonum(br_getd(RBR(op1)), RFF(op2)));
            case N_FIXRATIO:
                return (cmp_br_fr(RBR(op1), RFRN(op2), RFRD(op2)));
            case N_BIGRATIO:
                return (cmp_br_br(RBR(op1), RBR(op2)));
          }
    }

    return (0);
}

static int
cmp_real_object(n_real *op1, LispObj *op2)
{
    switch (OBJECT_TYPE(op2)) {
      case LispFixnum_t:
          switch (RTYPE(op1)) {
            case N_FIXNUM:
                return (cmp_fi_fi(RFI(op1), OFI(op2)));
            case N_BIGNUM:
                return (cmp_bi_fi(RBI(op1), OFI(op2)));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1), (double)OFI(op2)));
            case N_FIXRATIO:
                return (cmp_fr_fi(RFRD(op1), RFRN(op1), OFI(op2)));
            case N_BIGRATIO:
                return (cmp_br_fi(RBR(op1), OFI(op2)));
          }
          break;
      case LispInteger_t:
          switch (RTYPE(op1)) {
            case N_FIXNUM:
                return (cmp_fi_fi(RFI(op1), OII(op2)));
            case N_BIGNUM:
                return (cmp_bi_fi(RBI(op1), OII(op2)));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1), (double)OII(op2)));
            case N_FIXRATIO:
                return (cmp_fr_fi(RFRD(op1), RFRN(op1), OII(op2)));
            case N_BIGRATIO:
                return (cmp_br_fi(RBR(op1), OII(op2)));
          }
          break;
      case LispBignum_t:
          switch (RTYPE(op1)) {
            case N_FIXNUM:
                return (cmp_fi_bi(RFI(op1), OBI(op2)));
            case N_BIGNUM:
                return (cmp_bi_bi(RBI(op1), OBI(op2)));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1), bi_getd(OBI(op2))));
            case N_FIXRATIO:
                return (cmp_fr_bi(RFRD(op1), RFRN(op1), OBI(op2)));
            case N_BIGRATIO:
                return (cmp_br_bi(RBR(op1), OBI(op2)));
          }
          break;
      case LispDFloat_t:
          switch (RTYPE(op1)) {
            case N_FIXNUM:
                return (cmp_flonum((double)RFI(op1), ODF(op2)));
            case N_BIGNUM:
                return (cmp_flonum(bi_getd(RBI(op1)), ODF(op2)));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1), ODF(op2)));
            case N_FIXRATIO:
                return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1),
                               ODF(op2)));
            case N_BIGRATIO:
                return (cmp_flonum(br_getd(RBR(op1)), ODF(op2)));
          }
          break;
      case LispRatio_t:
          switch (RTYPE(op1)) {
            case N_FIXNUM:
                return (cmp_fi_fr(RFI(op1), OFRN(op2), OFRD(op2)));
            case N_BIGNUM:
                return (cmp_bi_fr(RBI(op1), OFRN(op2), OFRD(op2)));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1),
                               (double)OFRN(op2) / (double)OFRD(op2)));
            case N_FIXRATIO:
                return (cmp_fr_fr(RFRN(op1), RFRD(op1),
                              OFRN(op2), OFRD(op2)));
            case N_BIGRATIO:
                return (cmp_br_fr(RBR(op1), OFRN(op2), OFRD(op2)));
          }
          break;
      case LispBigratio_t:
          switch (RTYPE(op1)) {
            case N_FIXNUM:
                return (cmp_fi_br(RFI(op1), OBR(op2)));
            case N_BIGNUM:
                return (cmp_bi_br(RBI(op1), OBR(op2)));
            case N_FLONUM:
                return (cmp_flonum(RFF(op1), br_getd(OBR(op2))));
            case N_FIXRATIO:
                return (cmp_fr_br(RFRN(op1), RFRD(op1), OBR(op2)));
            case N_BIGRATIO:
                return (cmp_br_br(RBR(op1), OBR(op2)));
          }
          break;
      default:
          fatal_object_error(op2, NOT_A_REAL_NUMBER);
          break;
    }

    return (0);
}

#if 0       /* not used */
static int
cmp_number_object(n_number *op1, LispObj *op2)
{
    if (op1->complex) {
      if (OBJECT_TYPE(op2) == LispComplex_t) {
          if (cmp_real_object(NREAL(op1), OCXR(op2)) == 0)
            return (cmp_real_object(NIMAG(op1), OCXI(op2)));
          return (1);
      }
      else if (cmp_real_real(NIMAG(op1), &zero) == 0)
          return (cmp_real_object(NREAL(op1), op2));
      else
          return (1);
    }
    else {
      switch (OBJECT_TYPE(op2)) {
          case LispFixnum_t:
            switch (NRTYPE(op1)) {
                case N_FIXNUM:
                  return (cmp_fi_fi(NRFI(op1), OFI(op2)));
                case N_BIGNUM:
                  return (cmp_bi_fi(NRBI(op1), OFI(op2)));
                case N_FLONUM:
                  return (cmp_flonum(NRFF(op1), (double)OFI(op2)));
                case N_FIXRATIO:
                  return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OFI(op2)));
                case N_BIGRATIO:
                  return (cmp_br_fi(NRBR(op1), OFI(op2)));
            }
            break;
          case LispInteger_t:
            switch (NRTYPE(op1)) {
                case N_FIXNUM:
                  return (cmp_fi_fi(NRFI(op1), OII(op2)));
                case N_BIGNUM:
                  return (cmp_bi_fi(NRBI(op1), OII(op2)));
                case N_FLONUM:
                  return (cmp_flonum(NRFF(op1), (double)OII(op2)));
                case N_FIXRATIO:
                  return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OII(op2)));
                case N_BIGRATIO:
                  return (cmp_br_fi(NRBR(op1), OII(op2)));
            }
            break;
          case LispBignum_t:
            switch (NRTYPE(op1)) {
                case N_FIXNUM:
                  return (cmp_fi_bi(NRFI(op1), OBI(op2)));
                case N_BIGNUM:
                  return (cmp_bi_bi(NRBI(op1), OBI(op2)));
                case N_FLONUM:
                  return (cmp_flonum(NRFF(op1), bi_getd(OBI(op2))));
                case N_FIXRATIO:
                  return (cmp_fr_bi(NRFRD(op1), NRFRN(op1), OBI(op2)));
                case N_BIGRATIO:
                  return (cmp_br_bi(NRBR(op1), OBI(op2)));
            }
            break;
          case LispDFloat_t:
            switch (NRTYPE(op1)) {
                case N_FIXNUM:
                  return (cmp_flonum((double)NRFI(op1), ODF(op2)));
                case N_BIGNUM:
                  return (cmp_flonum(bi_getd(NRBI(op1)), ODF(op2)));
                case N_FLONUM:
                  return (cmp_flonum(NRFF(op1), ODF(op2)));
                case N_FIXRATIO:
                  return (cmp_flonum((double)NRFRN(op1) /
                                 (double)NRFRD(op1),
                                 ODF(op2)));
                case N_BIGRATIO:
                  return (cmp_flonum(br_getd(NRBR(op1)), ODF(op2)));
            }
            break;
          case LispRatio_t:
            switch (NRTYPE(op1)) {
                case N_FIXNUM:
                  return (cmp_fi_fr(NRFI(op1), OFRN(op2), OFRD(op2)));
                case N_BIGNUM:
                  return (cmp_bi_fr(NRBI(op1), OFRN(op2), OFRD(op2)));
                case N_FLONUM:
                  return (cmp_flonum(NRFF(op1),
                                 (double)OFRN(op2) / (double)OFRD(op2)));
                case N_FIXRATIO:
                  return (cmp_fr_fr(NRFRN(op1), NRFRD(op1),
                                OFRN(op2), OFRD(op2)));
                case N_BIGRATIO:
                  return (cmp_br_fr(NRBR(op1), OFRN(op2), OFRD(op2)));
            }
            break;
          case LispBigratio_t:
            switch (NRTYPE(op1)) {
                case N_FIXNUM:
                  return (cmp_fi_br(NRFI(op1), OBR(op2)));
                case N_BIGNUM:
                  return (cmp_bi_br(NRBI(op1), OBR(op2)));
                case N_FLONUM:
                  return (cmp_flonum(NRFF(op1), br_getd(OBR(op2))));
                case N_FIXRATIO:
                  return (cmp_fr_br(NRFRN(op1), NRFRD(op1), OBR(op2)));
                case N_BIGRATIO:
                  return (cmp_br_br(NRBR(op1), OBR(op2)));
            }
            break;
          case LispComplex_t:
            if (cmp_real_object(&zero, OCXI(op2)) == 0)
                return (cmp_real_object(NREAL(op1), OCXR(op2)));
            return (1);
          default:
            fatal_object_error(op2, NOT_A_NUMBER);
            break;
      }
    }

    return (0);
}
#endif

static int
cmp_object_object(LispObj *op1, LispObj *op2, int real)
{
    if (OBJECT_TYPE(op1) == LispComplex_t) {
      if (real)
          fatal_object_error(op1, NOT_A_REAL_NUMBER);
      if (OBJECT_TYPE(op2) == LispComplex_t)
          return (cmp_cx_cx(op1, op2));
      else if (cmp_real_object(&zero, OCXI(op1)) == 0)
          return (cmp_object_object(OCXR(op1), op2, real));
      return (1);
    }
    else if (OBJECT_TYPE(op2) == LispComplex_t) {
      if (real)
          fatal_object_error(op1, NOT_A_REAL_NUMBER);
      if (cmp_real_object(&zero, OCXI(op2)) == 0)
          return (cmp_object_object(op1, OCXR(op2), real));
      return (1);
    }
    else {
      switch (OBJECT_TYPE(op1)) {
          case LispFixnum_t:
            switch (OBJECT_TYPE(op2)) {
                case LispFixnum_t:
                  return (cmp_fi_fi(OFI(op1), OFI(op2)));
                case LispInteger_t:
                  return (cmp_fi_fi(OFI(op1), OII(op2)));
                case LispBignum_t:
                  return (cmp_fi_bi(OFI(op1), OBI(op2)));
                case LispDFloat_t:
                  return (cmp_flonum((double)OFI(op1), ODF(op2)));
                case LispRatio_t:
                  return (cmp_fi_fr(OFI(op1),
                                OFRN(op2), OFRD(op2)));
                case LispBigratio_t:
                  return (cmp_fi_br(OFI(op1), OBR(op2)));
                default:
                  break;
            }
            break;
          case LispInteger_t:
            switch (OBJECT_TYPE(op2)) {
                case LispFixnum_t:
                  return (cmp_fi_fi(OII(op1), OFI(op2)));
                case LispInteger_t:
                  return (cmp_fi_fi(OII(op1), OII(op2)));
                case LispBignum_t:
                  return (cmp_fi_bi(OII(op1), OBI(op2)));
                case LispDFloat_t:
                  return (cmp_flonum((double)OII(op1), ODF(op2)));
                case LispRatio_t:
                  return (cmp_fi_fr(OII(op1),
                                OFRN(op2), OFRD(op2)));
                case LispBigratio_t:
                  return (cmp_fi_br(OII(op1), OBR(op2)));
                default:
                  break;
            }
            break;
          case LispBignum_t:
            switch (OBJECT_TYPE(op2)) {
                case LispFixnum_t:
                  return (cmp_bi_fi(OBI(op1), OFI(op2)));
                case LispInteger_t:
                  return (cmp_bi_fi(OBI(op1), OII(op2)));
                case LispBignum_t:
                  return (cmp_bi_bi(OBI(op1), OBI(op2)));
                case LispDFloat_t:
                  return (cmp_flonum(bi_getd(OBI(op1)), ODF(op2)));
                case LispRatio_t:
                  return (cmp_bi_fr(OBI(op1),
                                OFRN(op2), OFRD(op2)));
                case LispBigratio_t:
                  return (cmp_bi_br(OBI(op1), OBR(op2)));
                default:
                  break;
            }
            break;
          case LispDFloat_t:
            switch (OBJECT_TYPE(op2)) {
                case LispFixnum_t:
                  return (cmp_flonum(ODF(op1), (double)OFI(op2)));
                case LispInteger_t:
                  return (cmp_flonum(ODF(op1), (double)OII(op2)));
                case LispBignum_t:
                  return (cmp_flonum(ODF(op1), bi_getd(OBI(op2))));
                case LispDFloat_t:
                  return (cmp_flonum(ODF(op1), ODF(op2)));
                  break;
                case LispRatio_t:
                  return (cmp_flonum(ODF(op1),
                                 (double)OFRN(op2) /
                                 (double)OFRD(op2)));
                case LispBigratio_t:
                  return (cmp_flonum(ODF(op1), br_getd(OBR(op2))));
                default:
                  break;
            }
            break;
          case LispRatio_t:
            switch (OBJECT_TYPE(op2)) {
                case LispFixnum_t:
                  return (cmp_fr_fi(OFRN(op1), OFRD(op1), OFI(op2)));
                case LispInteger_t:
                  return (cmp_fr_fi(OFRN(op1), OFRD(op1), OII(op2)));
                case LispBignum_t:
                  return (cmp_fr_bi(OFRN(op1), OFRD(op1), OBI(op2)));
                case LispDFloat_t:
                  return (cmp_flonum((double)OFRN(op1) /
                                 (double)OFRD(op1),
                                 ODF(op2)));
                case LispRatio_t:
                  return (cmp_fr_fr(OFRN(op1), OFRD(op1),
                                OFRN(op2), OFRD(op2)));
                case LispBigratio_t:
                  return (cmp_fr_br(OFRN(op1), OFRD(op1), OBR(op2)));
                default:
                  break;
            }
            break;
          case LispBigratio_t:
            switch (OBJECT_TYPE(op2)) {
                case LispFixnum_t:
                  return (cmp_br_fi(OBR(op1), OFI(op2)));
                case LispInteger_t:
                  return (cmp_br_fi(OBR(op1), OII(op2)));
                case LispBignum_t:
                  return (cmp_br_bi(OBR(op1), OBI(op2)));
                case LispDFloat_t:
                  return (cmp_flonum(br_getd(OBR(op1)), ODF(op2)));
                case LispRatio_t:
                  return (cmp_br_fr(OBR(op1), OFRN(op2), OFRD(op2)));
                case LispBigratio_t:
                  return (cmp_br_br(OBR(op1), OBR(op2)));
                default:
                  break;
            }
            break;
          default:
            fatal_object_error(op1, NOT_A_NUMBER);
            break;
      }
    }

    fatal_object_error(op2, NOT_A_NUMBER);
    return (0);
}


/************************************************************************
 * FIXNUM
 ************************************************************************/
/*
 * check if op1 + op2 will overflow
 */
static INLINE int
fi_fi_add_overflow(long op1, long op2)
{
    long op = op1 + op2;

    return (op1 > 0 ? op2 > op : op2 < op);
}

/*
 * check if op1 - op2 will overflow
 */
static INLINE int
fi_fi_sub_overflow(long op1, long op2)
{
    long op = op1 - op2;

    return (((op1 < 0) ^ (op2 < 0)) && ((op < 0) ^ (op1 < 0)));
}

/*
 * check if op1 * op2 will overflow
 */
static INLINE int
fi_fi_mul_overflow(long op1, long op2)
{
#ifndef LONG64
    double op = (double)op1 * (double)op2;

    return (op > 2147483647.0 || op < -2147483648.0);
#else
    int shift;
    long mask;

    if (op1 == 0 || op1 == 1 || op2 == 0 || op2 == 1)
      return (0);

    if (op1 == MINSLONG || op2 == MINSLONG)
      return (1);

    if (op1 < 0)
      op1 = -op1;
    if (op2 < 0)
      op2 = -op2;

    for (shift = 0, mask = FI_MASK; shift < LONGSBITS; shift++, mask >>= 1)
      if (op1 & mask)
          break;
    ++shift;
    for (mask = FI_MASK; shift < LONGSBITS; shift++, mask >>= 1)
      if (op2 & mask)
          break;

    return (shift < LONGSBITS);
#endif
}


/************************************************************************
 * BIGNUM
 ************************************************************************/
static void
rbi_canonicalize(n_real *real)
{
    if (mpi_fiti(RBI(real))) {
      long fi = mpi_geti(RBI(real));

      RTYPE(real) = N_FIXNUM;
      mpi_clear(RBI(real));
      XFREE(RBI(real));
      RFI(real) = fi;
    }
}


/************************************************************************
 * RATIO
 ************************************************************************/
static void
rfr_canonicalize(n_real *real)
{
    long num, numerator, den, denominator, rest;

    num = numerator = RFRN(real);
    den = denominator = RFRD(real);
    if (denominator == 0)
      fatal_error(DIVIDE_BY_ZERO);

    if (num == MINSLONG || den == MINSLONG) {
      mpr *bigratio = XALLOC(mpr);

      mpr_init(bigratio);
      mpr_seti(bigratio, num, den);
      RTYPE(real) = N_BIGRATIO;
      RBR(real) = bigratio;
      rbr_canonicalize(real);
      return;
    }

    if (num < 0)
      num = -num;
    else if (num == 0) {
      RFI(real) = 0;
      RTYPE(real) = N_FIXNUM;
      return;
    }
    for (;;) {
      if ((rest = den % num) == 0)
          break;
      den = num;
      num = rest;
    }
    if (den != 1) {
      denominator /= num;
      numerator /= num;
    }
    if (denominator < 0) {
      numerator = -numerator;
      denominator = -denominator;
    }
    if (denominator == 1) {
      RTYPE(real) = N_FIXNUM;
      RFI(real) = numerator;
    }
    else {
      RFRN(real) = numerator;
      RFRD(real) = denominator;
    }
}

static void
rbr_canonicalize(n_real *real)
{
    int fitnum, fitden;
    long numerator, denominator;

    mpr_canonicalize(RBR(real));
    fitnum = mpi_fiti(RBRN(real));
    fitden = mpi_fiti(RBRD(real));
    if (fitnum && fitden) {
      numerator = mpi_geti(RBRN(real));
      denominator = mpi_geti(RBRD(real));
      mpr_clear(RBR(real));
      XFREE(RBR(real));
      if (numerator == 0) {
          RFI(real) = 0;
          RTYPE(real) = N_FIXNUM;
      }
      else if (denominator == 1) {
          RTYPE(real) = N_FIXNUM;
          RFI(real) = numerator;
      }
      else {
          RTYPE(real) = N_FIXRATIO;
          RFRN(real) = numerator;
          RFRD(real) = denominator;
      }
    }
    else if (fitden) {
      denominator = mpi_geti(RBRD(real));
      if (denominator == 1) {
          mpi *bigi = XALLOC(mpi);

          mpi_init(bigi);
          mpi_set(bigi, RBRN(real));
          mpr_clear(RBR(real));
          XFREE(RBR(real));
          RTYPE(real) = N_BIGNUM;
          RBI(real) = bigi;
      }
      else if (denominator == 0)
          fatal_error(DIVIDE_BY_ZERO);
    }
}


/************************************************************************
 * COMPLEX
 ************************************************************************/
static void
ncx_canonicalize(n_number *num)
{
    if (NITYPE(num) == N_FIXNUM && NIFI(num) == 0)
      num->complex = 0;
}


/************************************************************************
 * DIVIDE
 ************************************************************************/
#define NDIVIDE_NOP     0
#define NDIVIDE_ADD     1
#define NDIVIDE_SUB     2
static void
ndivide_fi_fi(n_number *num, long div, int fun, int flo)
{
    long quo, rem;

    if (NRFI(num) == MINSLONG || div == MINSLONG) {
      LispObj integer;
      mpi *bignum = XALLOC(mpi);

      mpi_init(bignum);
      mpi_seti(bignum, NRFI(num));
      NRBI(num) = bignum;
      NRTYPE(num) = N_BIGNUM;
      integer.type = LispInteger_t;
      integer.data.integer = div;
      ndivide_xi_xi(num, &integer, fun, flo);
      return;
    }
    else {
      quo = NRFI(num) / div;
      rem = NRFI(num) % div;
    }

    switch (fun) {
      case NDIVIDE_CEIL:
          if ((rem < 0 && div < 0) || (rem > 0 && div > 0)) {
            ++quo;
            rem -= div;
          }
          break;
      case NDIVIDE_FLOOR:
          if ((rem < 0 && div > 0) || (rem > 0 && div < 0)) {
            --quo;
            rem += div;
          }
          break;
      case NDIVIDE_ROUND:
          if (div > 0) {
            if (rem > 0) {
                if (rem >= (div + 1) / 2) {
                  ++quo;
                  rem -= div;
                }
            }
            else {
                if (rem <= (-div - 1) / 2) {
                  --quo;
                  rem += div;
                }
            }
          }
          else {
            if (rem > 0) {
                if (rem >= (-div + 1) / 2) {
                  --quo;
                  rem += div;
                }
            }
            else {
                if (rem <= (div - 1) / 2) {
                  ++quo;
                  rem -= div;
                }
            }
          }
          break;
    }

    NITYPE(num) = N_FIXNUM;
    NIFI(num) = rem;
    if (flo) {
      NRTYPE(num) = N_FLONUM;
      NRFF(num) = (double)quo;
    }
    else
      NRFI(num) = quo;
}

static void
ndivide_xi_xi(n_number *num, LispObj *div, int fun, int flo)
{
    LispType type = OBJECT_TYPE(div);
    int state = NDIVIDE_NOP, dsign, rsign;
    mpi *quo, *rem;

    quo = XALLOC(mpi);
    mpi_init(quo);
    if (NRTYPE(num) == N_FIXNUM)
      mpi_seti(quo, NRFI(num));
    else
      mpi_set(quo, NRBI(num));

    rem = XALLOC(mpi);
    mpi_init(rem);

    switch (type) {
      case LispFixnum_t:
          mpi_seti(rem, OFI(div));
          break;
      case LispInteger_t:
          mpi_seti(rem, OII(div));
          break;
      default:
          mpi_set(rem, OBI(div));
    }

    dsign = mpi_sgn(rem);

    mpi_divqr(quo, rem, quo, rem);
    rsign = mpi_sgn(rem);

    switch (fun) {
      case NDIVIDE_CEIL:
          if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
            state = NDIVIDE_ADD;
          break;
      case NDIVIDE_FLOOR:
          if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
            state = NDIVIDE_SUB;
          break;
      case NDIVIDE_ROUND: {
          mpi test;

          mpi_init(&test);
          switch (type) {
            case LispFixnum_t:
                mpi_seti(&test, OFI(div));
                break;
            case LispInteger_t:
                mpi_seti(&test, OII(div));
                break;
            default:
                mpi_set(&test, OBI(div));
          }
          if (dsign > 0) {
            if (rsign > 0) {
                mpi_addi(&test, &test, 1);
                mpi_divi(&test, &test, 2);
                if (mpi_cmp(rem, &test) >= 0)
                  state = NDIVIDE_ADD;
            }
            else {
                mpi_neg(&test, &test);
                mpi_subi(&test, &test, 1);
                mpi_divi(&test, &test, 2);
                if (mpi_cmp(rem, &test) <= 0)
                  state = NDIVIDE_SUB;
            }
          }
          else {
            if (rsign > 0) {
                mpi_neg(&test, &test);
                mpi_addi(&test, &test, 1);
                mpi_divi(&test, &test, 2);
                if (mpi_cmp(rem, &test) >= 0)
                  state = NDIVIDE_SUB;
            }
            else {
                mpi_subi(&test, &test, 1);
                mpi_divi(&test, &test, 2);
                if (mpi_cmp(rem, &test) <= 0)
                  state = NDIVIDE_ADD;
            }
          }
          mpi_clear(&test);
      }   break;
    }

    if (state == NDIVIDE_ADD) {
      mpi_addi(quo, quo, 1);
      switch (type) {
          case LispFixnum_t:
            mpi_subi(rem, rem, OFI(div));
            break;
          case LispInteger_t:
            mpi_subi(rem, rem, OII(div));
            break;
          default:
            mpi_sub(rem, rem, OBI(div));
      }
    }
    else if (state == NDIVIDE_SUB) {
      mpi_subi(quo, quo, 1);
      switch (type) {
          case LispFixnum_t:
            mpi_addi(rem, rem, OFI(div));
            break;
          case LispInteger_t:
            mpi_addi(rem, rem, OII(div));
            break;
          default:
            mpi_add(rem, rem, OBI(div));
      }
    }

    if (mpi_fiti(rem)) {
      NITYPE(num) = N_FIXNUM;
      NIFI(num) = mpi_geti(rem);
      mpi_clear(rem);
      XFREE(rem);
    }
    else {
      NITYPE(num) = N_BIGNUM;
      NIBI(num) = rem;
    }

    clear_real(NREAL(num));

    if (flo) {
      double dval = bi_getd(quo);

      mpi_clear(quo);
      XFREE(quo);
      NRTYPE(num) = N_FLONUM;
      NRFF(num) = dval;
    }
    else {
      NRTYPE(num) = N_BIGNUM;
      NRBI(num) = quo;
      rbi_canonicalize(NREAL(num));
    }
}

static void
ndivide_flonum(n_number *number, double num, double div, int fun, int flo)
{
    double quo, rem, modp, tmp;

    modp = modf(num / div, &quo);
    rem = num - quo * div;

    switch (fun) {
      case NDIVIDE_CEIL:
          if ((rem < 0.0 && div < 0.0) || (rem > 0.0 && div > 0.0)) {
            quo += 1.0;
            rem -= div;
          }
          break;
      case NDIVIDE_FLOOR:
          if ((rem < 0.0 && div > 0.0) || (rem > 0.0 && div < 0.0)) {
            quo -= 1.0;
            rem += div;
          }
          break;
      case NDIVIDE_ROUND:
          if (fabs(modp) != 0.5 || modf(quo * 0.5, &tmp) != 0.0) {
            if (div > 0.0) {
                if (rem > 0.0) {
                  if (rem >= div * 0.5) {
                      quo += 1.0;
                      rem -= div;
                  }
                }
                else {
                  if (rem <= div * -0.5) {
                      quo -= 1.0;
                      rem += div;
                  }
                }
            }
            else {
                if (rem > 0.0) {
                  if (rem >= div * -0.5) {
                      quo -= 1.0;
                      rem += div;
                  }
                }
                else {
                  if (rem <= div * 0.5) {
                      quo += 1.0;
                      rem -= div;
                  }
                }
            }
          }
          break;
    }
    if (!finite(quo) || !finite(rem))
      fatal_error(FLOATING_POINT_OVERFLOW);

    NITYPE(number) = N_FLONUM;
    NIFF(number) = rem;

    clear_real(NREAL(number));

    if (flo) {
      NRTYPE(number) = N_FLONUM;
      NRFF(number) = quo;
    }
    else {
      if ((long)quo == quo) {
          NRTYPE(number) = N_FIXNUM;
          NRFI(number) = (long)quo;
      }
      else {
          mpi *bigi = XALLOC(mpi);

          mpi_init(bigi);
          mpi_setd(bigi, quo);
          NRBI(number) = bigi;
          NRTYPE(number) = N_BIGNUM;
      }
    }
}

static void
ndivide_xi_xr(n_number *num, LispObj *div, int fun, int flo)
{
    int state = NDIVIDE_NOP, dsign, rsign;
    mpi *quo;
    mpr *rem;

    quo = XALLOC(mpi);
    mpi_init(quo);
    if (NRTYPE(num) == N_FIXNUM)
      mpi_seti(quo, NRFI(num));
    else    
      mpi_set(quo, NRBI(num));

    rem = XALLOC(mpr);
    mpr_init(rem);

    if (XOBJECT_TYPE(div) == LispRatio_t)
      mpr_seti(rem, OFRN(div), OFRD(div));
    else
      mpr_set(rem, OBR(div));
    dsign = mpi_sgn(mpr_num(rem));
    mpi_mul(quo, quo, mpr_den(rem));

    mpi_divqr(quo, mpr_num(rem), quo, mpr_num(rem));
    mpr_canonicalize(rem);

    rsign = mpi_sgn(mpr_num(rem));
    if (mpr_fiti(rem)) {
      if (mpi_geti(mpr_den(rem)) == 1) {
          NITYPE(num) = N_FIXNUM;
          NIFI(num) = mpi_geti(mpr_num(rem));
      }
      else {
          NITYPE(num) = N_FIXRATIO;
          NIFRN(num) = mpi_geti(mpr_num(rem));
          NIFRD(num) = mpi_geti(mpr_den(rem));
      }
      mpr_clear(rem);
      XFREE(rem); 
    }
    else {
      if (mpi_fiti(mpr_den(rem)) && mpi_geti(mpr_den(rem)) == 1) {
          NITYPE(num) = N_BIGNUM;
          NIBI(num) = mpr_num(rem);
          mpi_clear(mpr_den(rem));
          XFREE(rem);
      }
      else {
          NITYPE(num) = N_BIGRATIO;
          NIBR(num) = rem;
      }
    }

    switch (fun) {
      case NDIVIDE_CEIL:
          if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
            state = NDIVIDE_ADD;
          break;
      case NDIVIDE_FLOOR:
          if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
            state = NDIVIDE_SUB;
          break;
      case NDIVIDE_ROUND: {
          n_real cmp;

          set_real_object(&cmp, div);
          div_real_real(&cmp, &two);
          if (dsign > 0) {
            if (rsign > 0) {
                if (cmp_real_real(NIMAG(num), &cmp) >= 0)
                  state = NDIVIDE_ADD;
            }
            else {
                neg_real(&cmp);
                if (cmp_real_real(NIMAG(num), &cmp) <= 0)
                  state = NDIVIDE_SUB;
            }
          }
          else {
            if (rsign > 0) {
                neg_real(&cmp);
                if (cmp_real_real(NIMAG(num), &cmp) >= 0)
                  state = NDIVIDE_SUB;
            }
            else {
                if (cmp_real_real(NIMAG(num), &cmp) <= 0)
                  state = NDIVIDE_ADD;
            }
          }
          clear_real(&cmp);
      }   break;
    }

    if (state == NDIVIDE_ADD) {
      mpi_addi(quo, quo, 1);
      sub_real_object(NIMAG(num), div);
    }
    else if (state == NDIVIDE_SUB) {
      mpi_subi(quo, quo, 1);
      add_real_object(NIMAG(num), div);
    }

    clear_real(NREAL(num));

    if (flo) {
      double dval = bi_getd(quo);

      mpi_clear(quo);
      XFREE(quo);
      NRTYPE(num) = N_FLONUM;
      NRFF(num) = dval;
    }
    else {
      NRBI(num)  = quo;
      NRTYPE(num) = N_BIGNUM;
      rbi_canonicalize(NREAL(num));
    }
}

static void
ndivide_xr_xi(n_number *num, LispObj *div, int fun, int flo)
{
    LispType type = OBJECT_TYPE(div);
    int state = NDIVIDE_NOP, dsign, rsign;
    mpi *quo;
    mpr *rem;

    quo = XALLOC(mpi);
    mpi_init(quo);
    switch (type) {
      case LispFixnum_t:
          dsign = OFI(div) < 0 ? -1 : OFI(div) > 0 ? 1 : 0;
          mpi_seti(quo, OFI(div));
          break;
      case LispInteger_t:
          dsign = OII(div) < 0 ? -1 : OII(div) > 0 ? 1 : 0;
          mpi_seti(quo, OII(div));
          break;
      default:
          dsign = mpi_sgn(OBI(div));
          mpi_set(quo, OBI(div));
          break;
    }

    rem = XALLOC(mpr);
    mpr_init(rem);
    if (NRTYPE(num) == N_FIXRATIO) {
      mpr_seti(rem, NRFRN(num), NRFRD(num));
      mpi_muli(quo, quo, NRFRD(num));
    }
    else {
      mpr_set(rem, NRBR(num));
      mpi_mul(quo, quo, NRBRD(num));
    }
    mpi_divqr(quo, mpr_num(rem), mpr_num(rem), quo);
    mpr_canonicalize(rem);

    rsign = mpi_sgn(mpr_num(rem));
    if (mpr_fiti(rem)) {
      NITYPE(num) = N_FIXRATIO;
      NIFRN(num) = mpi_geti(mpr_num(rem));
      NIFRD(num) = mpi_geti(mpr_den(rem));
      mpr_clear(rem);
      XFREE(rem);
    }
    else {
      NITYPE(num) = N_BIGRATIO;
      NIBR(num) = rem;
    }

    switch (fun) {
      case NDIVIDE_CEIL:
          if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
            state = NDIVIDE_ADD;
          break;
      case NDIVIDE_FLOOR:
          if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
            state = NDIVIDE_SUB;
          break;
      case NDIVIDE_ROUND: {
          n_real cmp;

          set_real_object(&cmp, div);
          div_real_real(&cmp, &two);
          if (dsign > 0) {
            if (rsign > 0) {
                if (cmp_real_real(NIMAG(num), &cmp) >= 0)
                  state = NDIVIDE_ADD;
            }
            else {
                neg_real(&cmp);
                if (cmp_real_real(NIMAG(num), &cmp) <= 0)
                  state = NDIVIDE_SUB;
            }
          }
          else {
            if (rsign > 0) {
                neg_real(&cmp);
                if (cmp_real_real(NIMAG(num), &cmp) >= 0)
                  state = NDIVIDE_SUB;
            }
            else {
                if (cmp_real_real(NIMAG(num), &cmp) <= 0)
                  state = NDIVIDE_ADD;
            }
          }
          clear_real(&cmp);
      }   break;
    }

    if (state == NDIVIDE_ADD) {
      mpi_addi(quo, quo, 1);
      sub_real_object(NIMAG(num), div);
    }
    else if (state == NDIVIDE_SUB) {
      mpi_subi(quo, quo, 1);
      add_real_object(NIMAG(num), div);
    }

    clear_real(NREAL(num));

    if (flo) {
      double dval = bi_getd(quo);

      mpi_clear(quo);
      XFREE(quo);
      NRTYPE(num) = N_FLONUM;
      NRFF(num) = dval;
    }
    else {
      NRBI(num) = quo;
      NRTYPE(num) = N_BIGNUM;
      rbi_canonicalize(NREAL(num));
    }
}

static void
ndivide_xr_xr(n_number *num, LispObj *div, int fun, int flo)
{
    int state = NDIVIDE_NOP, dsign, rsign, modp;
    mpr *bigr;
    mpi *bigi;

    bigr = XALLOC(mpr);
    mpr_init(bigr);
    if (NRTYPE(num) == N_FIXRATIO)
      mpr_seti(bigr, NRFRN(num), NRFRD(num));
    else
      mpr_set(bigr, NRBR(num));

    NITYPE(num) = N_BIGRATIO;
    NIBR(num) = bigr;

    if (OBJECT_TYPE(div) == LispRatio_t) {
      dsign = OFRN(div) < 0 ? -1 : OFRN(div) > 0 ? 1 : 0;
      mpi_muli(mpr_num(bigr), mpr_num(bigr), OFRD(div));
      mpi_muli(mpr_den(bigr), mpr_den(bigr), OFRN(div));
    }
    else {
      dsign = mpi_sgn(OBRN(div));
      mpr_div(bigr, bigr, OBR(div));
    }
    modp = mpi_fiti(mpr_den(bigr)) && mpi_geti(mpr_den(bigr)) == 2;

    bigi = XALLOC(mpi);
    mpi_init(bigi);
    mpi_divqr(bigi, mpr_num(bigr), mpr_num(bigr), mpr_den(bigr));

    if (OBJECT_TYPE(div) == LispRatio_t)
      mpi_seti(mpr_den(bigr), OFRD(div));
    else
      mpi_set(mpr_den(bigr), OBRD(div));
    if (NRTYPE(num) == N_FIXRATIO)
      mpi_muli(mpr_den(bigr), mpr_den(bigr), NRFRD(num));
    else
      mpi_mul(mpr_den(bigr), mpr_den(bigr), NRBRD(num));

    clear_real(NREAL(num));
    NRTYPE(num) = N_BIGNUM;
    NRBI(num) = bigi;

    rbr_canonicalize(NIMAG(num));
    rsign = cmp_real_real(NIMAG(num), &zero);

    switch (fun) {
      case NDIVIDE_CEIL:
          if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
            state = NDIVIDE_ADD;
          break;
      case NDIVIDE_FLOOR:
          if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
            state = NDIVIDE_SUB;
          break;
      case NDIVIDE_ROUND:
          if (!modp || (bigi->digs[0] & 1) == 1) {
            n_real cmp;

            set_real_object(&cmp, div);
            div_real_real(&cmp, &two);
            if (dsign > 0) {
                if (rsign > 0) {
                  if (cmp_real_real(NIMAG(num), &cmp) >= 0)
                      state = NDIVIDE_ADD;
                }
                else {
                  neg_real(&cmp);
                  if (cmp_real_real(NIMAG(num), &cmp) <= 0)
                      state = NDIVIDE_SUB;
                }
            }
            else {
                if (rsign > 0) {
                  neg_real(&cmp);
                  if (cmp_real_real(NIMAG(num), &cmp) >= 0)
                      state = NDIVIDE_SUB;
                }
                else {
                  if (cmp_real_real(NIMAG(num), &cmp) <= 0)
                      state = NDIVIDE_ADD;
                }
            }
            clear_real(&cmp);
          }
          break;
    }

    if (state == NDIVIDE_ADD) {
      add_real_real(NREAL(num), &one);
      sub_real_object(NIMAG(num), div);
    }
    else if (state == NDIVIDE_SUB) {
      sub_real_real(NREAL(num), &one);
      add_real_object(NIMAG(num), div);
    }

    if (NRTYPE(num) == N_BIGNUM) {
      if (flo) {
          double dval = bi_getd(bigi);

          mpi_clear(bigi);
          XFREE(bigi);
          NRTYPE(num) = N_FLONUM;
          NRFF(num) = dval;
      }
      else
          rbi_canonicalize(NREAL(num));
    }
    else if (flo) {
      NRTYPE(num) = N_FLONUM;
      NRFF(num) = (double)NRFI(num);
    }
}


/************************************************************************
 * REAL COMPLEX
 ************************************************************************/
static void
nadd_re_cx(n_number *num, LispObj *comp)
{
/*
      Ra+Rb Ib
 */
    /* Ra+Rb */
    add_real_object(NREAL(num), OCXR(comp));

    /* Ib */
    set_real_object(NIMAG(num), OCXI(comp));

    num->complex = 1;

    ncx_canonicalize(num);
}

static void
nsub_re_cx(n_number *num, LispObj *comp)
{
/*
      Ra-Rb -Ib
 */
    /* Ra-Rb */
    sub_real_object(NREAL(num), OCXR(comp));

    /* -Ib */
    NITYPE(num) = N_FIXNUM;
    NIFI(num) = -1;
    mul_real_object(NIMAG(num), OCXI(comp));

    num->complex = 1;

    ncx_canonicalize(num);
}

static void
nmul_re_cx(n_number *num, LispObj *comp)
{
/*
      Ra*Rb Ra*Ib
 */
    /* copy before change */
    set_real_real(NIMAG(num), NREAL(num));

    /* Ra*Rb */
    mul_real_object(NREAL(num), OCXR(comp));

    /* Ra*Ib */
    mul_real_object(NIMAG(num), OCXI(comp));

    num->complex = 1;

    ncx_canonicalize(num);
}

static void
ndiv_re_cx(n_number *num, LispObj *comp)
{
/*
      Ra*Rb        -Ib*Ra
      -----------  -----------
      Rb*Rb+Ib*Ib  Rb*Rb+Ib*Ib
 */
    n_real div, temp;

    /* Rb*Rb */
    set_real_object(&div, OCXR(comp));
    mul_real_object(&div, OCXR(comp));

    /* Ib*Ib */
    set_real_object(&temp, OCXI(comp));
    mul_real_object(&temp, OCXI(comp));

    /* Rb*Rb+Ib*Ib */
    add_real_real(&div, &temp);
    clear_real(&temp);

    /* -Ib*Ra */
    NITYPE(num) = N_FIXNUM;
    NIFI(num) = -1;
    mul_real_object(NIMAG(num), OCXI(comp));
    mul_real_real(NIMAG(num), NREAL(num));

    /* Ra*Rb */
    mul_real_object(NREAL(num), OCXR(comp));

    div_real_real(NREAL(num), &div);
    div_real_real(NIMAG(num), &div);
    clear_real(&div);

    num->complex = 1;

    ncx_canonicalize(num);
}


/************************************************************************
 * COMPLEX REAL
 ************************************************************************/
static void
nadd_cx_re(n_number *num, LispObj *re)
{
/*
      Ra+Rb Ia
 */
    add_real_object(NREAL(num), re);

    ncx_canonicalize(num);
}

static void
nsub_cx_re(n_number *num, LispObj *re)
{
/*
      Ra-Rb Ia
 */
    sub_real_object(NREAL(num), re);

    ncx_canonicalize(num);
}

static void
nmul_cx_re(n_number *num, LispObj *re)
{
/*
      Ra*Rb Ia*Rb
 */
    mul_real_object(NREAL(num), re);
    mul_real_object(NIMAG(num), re);

    ncx_canonicalize(num);
}

static void
ndiv_cx_re(n_number *num, LispObj *re)
{
/*
      Ra/Rb Ia/Rb
 */
    div_real_object(NREAL(num), re);
    div_real_object(NIMAG(num), re);

    ncx_canonicalize(num);
}


/************************************************************************
 * COMPLEX COMPLEX
 ************************************************************************/
static void
nadd_cx_cx(n_number *num, LispObj *comp)
{
/*
      Ra+Rb Ia+Ib
 */
    add_real_object(NREAL(num), OCXR(comp));
    add_real_object(NIMAG(num), OCXI(comp));

    ncx_canonicalize(num);
}

static void
nsub_cx_cx(n_number *num, LispObj *comp)
{
/*
      Ra-Rb Ia-Ib
 */
    sub_real_object(NREAL(num), OCXR(comp));
    sub_real_object(NIMAG(num), OCXI(comp));

    ncx_canonicalize(num);
}

static void
nmul_cx_cx(n_number *num, LispObj *comp)
{
/*
      Ra*Rb-Ia*Ib Ra*Ib+Ia*Rb
 */
    n_real IaIb, RaIb;

    set_real_real(&IaIb, NIMAG(num));
    mul_real_object(&IaIb, OCXI(comp));

    set_real_real(&RaIb, NREAL(num));
    mul_real_object(&RaIb, OCXI(comp));

    /* Ra*Rb-Ia*Ib */
    mul_real_object(NREAL(num), OCXR(comp));
    sub_real_real(NREAL(num), &IaIb);
    clear_real(&IaIb);

    /* Ra*Ib+Ia*Rb */
    mul_real_object(NIMAG(num), OCXR(comp));
    add_real_real(NIMAG(num), &RaIb);
    clear_real(&RaIb);

    ncx_canonicalize(num);
}

static void
ndiv_cx_cx(n_number *num, LispObj *comp)
{
/*
      Ra*Rb+Ia*Ib  Ia*Rb-Ib*Ra
      -----------  -----------
      Rb*Rb+Ib*Ib  Rb*Rb+Ib*Ib
 */
    n_real temp1, temp2;

    /* IaIb */
    set_real_real(&temp1, NIMAG(num));
    mul_real_object(&temp1, OCXI(comp));

    /* IbRa */
    set_real_real(&temp2, NREAL(num));
    mul_real_object(&temp2, OCXI(comp));

    /* Ra*Rb+Ia*Ib */
    mul_real_object(NREAL(num), OCXR(comp));
    add_real_real(NREAL(num), &temp1);
    clear_real(&temp1);

    /* Ia*Rb-Ib*Ra */
    mul_real_object(NIMAG(num), OCXR(comp));
    sub_real_real(NIMAG(num), &temp2);
    clear_real(&temp2);


    /* Rb*Rb */
    set_real_object(&temp1, OCXR(comp));
    mul_real_object(&temp1, OCXR(comp));

    /* Ib*Ib */
    set_real_object(&temp2, OCXI(comp));
    mul_real_object(&temp2, OCXI(comp));

    /* Rb*Rb+Ib*Ib */
    add_real_real(&temp1, &temp2);
    clear_real(&temp2);

    div_real_real(NREAL(num), &temp1);
    div_real_real(NIMAG(num), &temp1);
    clear_real(&temp1);

    ncx_canonicalize(num);
}

static int
cmp_cx_cx(LispObj *op1, LispObj *op2)
{
    int cmp;

    cmp = cmp_object_object(OCXR(op1), OCXR(op2), 1);
    if (cmp == 0)
      cmp = cmp_object_object(OCXI(op1), OCXI(op2), 1);

    return (cmp);
}


/************************************************************************
 * FLONUM FLONUM
 ************************************************************************/
static void
radd_flonum(n_real *real, double op1, double op2)
{
    double value = op1 + op2;

    if (!finite(value))
      fatal_error(FLOATING_POINT_OVERFLOW);
    switch (RTYPE(real)) {
      case N_FIXNUM:
      case N_FIXRATIO:
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGNUM:
          RCLEAR_BI(real);
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGRATIO:
          RCLEAR_BR(real);
          RTYPE(real) = N_FLONUM;
          break;
    }
    RFF(real) = value;
}

static void
rsub_flonum(n_real *real, double op1, double op2)
{
    double value = op1 - op2;

    if (!finite(value))
      fatal_error(FLOATING_POINT_OVERFLOW);
    switch (RTYPE(real)) {
      case N_FIXNUM:
      case N_FIXRATIO:
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGNUM:
          RCLEAR_BI(real);
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGRATIO:
          RCLEAR_BR(real);
          RTYPE(real) = N_FLONUM;
          break;
    }
    RFF(real) = value;
}

static void
rmul_flonum(n_real *real, double op1, double op2)
{
    double value = op1 * op2;

    if (!finite(value))
      fatal_error(FLOATING_POINT_OVERFLOW);
    switch (RTYPE(real)) {
      case N_FIXNUM:
      case N_FIXRATIO:
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGNUM:
          RCLEAR_BI(real);
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGRATIO:
          RCLEAR_BR(real);
          RTYPE(real) = N_FLONUM;
          break;
    }
    RFF(real) = value;
}

static void
rdiv_flonum(n_real *real, double op1, double op2)
{
    double value;

    if (op2 == 0.0)
      fatal_error(DIVIDE_BY_ZERO);
    value = op1 / op2;
    if (!finite(value))
      fatal_error(FLOATING_POINT_OVERFLOW);
    switch (RTYPE(real)) {
      case N_FIXNUM:
      case N_FIXRATIO:
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGNUM:
          RCLEAR_BI(real);
          RTYPE(real) = N_FLONUM;
          break;
      case N_BIGRATIO:
          RCLEAR_BR(real);
          RTYPE(real) = N_FLONUM;
          break;
    }
    RFF(real) = value;
}

static int
cmp_flonum(double op1, double op2)
{
    double value = op1 - op2;

    if (!finite(value))
      fatal_error(FLOATING_POINT_OVERFLOW);

    return (value > 0.0 ? 1 : value < 0.0 ? -1 : 0);
}


/************************************************************************
 * FIXNUM FIXNUM
 ************************************************************************/
static void
rop_fi_fi_bi(n_real *real, long fi, int op)
{
    mpi *bigi = XALLOC(mpi);

    mpi_init(bigi);
    mpi_seti(bigi, RFI(real));
    if (op == NOP_ADD)
      mpi_addi(bigi, bigi, fi);
    else if (op == NOP_SUB)
      mpi_subi(bigi, bigi, fi);
    else
      mpi_muli(bigi, bigi, fi);
    RBI(real) = bigi;
    RTYPE(real) = N_BIGNUM;
}

static INLINE void
radd_fi_fi(n_real *real, long fi)
{
    if (!fi_fi_add_overflow(RFI(real), fi))
      RFI(real) += fi;
    else
      rop_fi_fi_bi(real, fi, NOP_ADD);
}

static INLINE void
rsub_fi_fi(n_real *real, long fi)
{
    if (!fi_fi_sub_overflow(RFI(real), fi))
      RFI(real) -= fi;
    else
      rop_fi_fi_bi(real, fi, NOP_SUB);
}

static INLINE void
rmul_fi_fi(n_real *real, long fi)
{
    if (!fi_fi_mul_overflow(RFI(real), fi))
      RFI(real) *= fi;
    else
      rop_fi_fi_bi(real, fi, NOP_MUL);
}

static INLINE void
rdiv_fi_fi(n_real *real, long fi)
{
    RTYPE(real) = N_FIXRATIO;
    RFRN(real) = RFI(real);
    RFRD(real) = fi;
    rfr_canonicalize(real);
}

static INLINE int
cmp_fi_fi(long op1, long op2)
{
    if (op1 > op2)
      return (1);
    else if (op1 < op2)
      return (-1);

    return (0);
}


/************************************************************************
 * FIXNUM BIGNUM
 ************************************************************************/
static void
rop_fi_bi_xi(n_real *real, mpi *bi, int nop)
{
    mpi *bigi = XALLOC(mpi);

    mpi_init(bigi);
    mpi_seti(bigi, RFI(real));
    if (nop == NOP_ADD)
      mpi_add(bigi, bigi, bi);
    else if (nop == NOP_SUB)
      mpi_sub(bigi, bigi, bi);
    else
      mpi_mul(bigi, bigi, bi);

    if (mpi_fiti(bigi)) {
      RFI(real) = mpi_geti(bigi);
      mpi_clear(bigi);
      XFREE(bigi);
    }
    else {
      RBI(real) = bigi;
      RTYPE(real) = N_BIGNUM;
    }
}

static INLINE void
radd_fi_bi(n_real *real, mpi *bi)
{
    rop_fi_bi_xi(real, bi, NOP_ADD);
}

static INLINE void
rsub_fi_bi(n_real *real, mpi *bi)
{
    rop_fi_bi_xi(real, bi, NOP_SUB);
}

static INLINE void
rmul_fi_bi(n_real *real, mpi *bi)
{
    rop_fi_bi_xi(real, bi, NOP_MUL);
}

static void
rdiv_fi_bi(n_real *real, mpi *bi)
{
    mpr *bigr;

    if (mpi_cmpi(bi, 0) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    bigr = XALLOC(mpr);
    mpr_init(bigr);
    mpi_seti(mpr_num(bigr), RFI(real));
    mpi_set(mpr_den(bigr), bi);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real);
}

static INLINE int
cmp_fi_bi(long fixnum, mpi *bignum)
{
    return (-mpi_cmpi(bignum, fixnum));
}


/************************************************************************
 * FIXNUM FIXRATIO
 ************************************************************************/
static void
rop_fi_fr_as_xr(n_real *real, long num, long den, int nop)
{
    int fit;
    long value = 0, op = RFI(real);

    fit = !fi_fi_mul_overflow(op, den);
    if (fit) {
      value = op * den;
      if (nop == NOP_ADD)
          fit = !fi_fi_add_overflow(value, num);
      else
          fit = !fi_fi_sub_overflow(value, num);
    }
    if (fit) {
      if (nop == NOP_ADD)
          RFRN(real) = value + num;
      else
          RFRN(real) = value - num;
      RFRD(real) = den;
      RTYPE(real) = N_FIXRATIO;
      rfr_canonicalize(real);
    }
    else {
      mpi iop;
      mpr *bigr = XALLOC(mpr);

      mpi_init(&iop);
      mpi_seti(&iop, op);
      mpi_muli(&iop, &iop, den);

      mpr_init(bigr);
      mpr_seti(bigr, num, den);
      if (nop == NOP_ADD)
          mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
      else
          mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
      mpi_clear(&iop);
      RBR(real) = bigr;
      RTYPE(real) = N_BIGRATIO;
      rbr_canonicalize(real);
    }
}

static void
rop_fi_fr_md_xr(n_real *real, long num, long den, int nop)
{
    int fit;
    long op = RFI(real);

    if (nop == NOP_MUL)
      fit = !fi_fi_mul_overflow(op, num);
    else
      fit = !fi_fi_mul_overflow(op, den);
    if (fit) {
      if (nop == NOP_MUL) {
          RFRN(real) = op * num;
          RFRD(real) = den;
      }
      else {
          RFRN(real) = op * den;
          RFRD(real) = num;
      }
      RTYPE(real) = N_FIXRATIO;
      rfr_canonicalize(real);
    }
    else {
      mpi iop;
      mpr *bigr = XALLOC(mpr);

      mpi_init(&iop);
      mpi_seti(&iop, op);

      mpr_init(bigr);
      if (nop == NOP_MUL)
          mpr_seti(bigr, num, den);
      else
          mpr_seti(bigr, den, num);
      mpi_mul(mpr_num(bigr), mpr_num(bigr), &iop);
      mpi_clear(&iop);
      RBR(real) = bigr;
      RTYPE(real) = N_BIGRATIO;
      rbr_canonicalize(real);
    }
}

static INLINE void
radd_fi_fr(n_real *real, long num, long den)
{
    rop_fi_fr_as_xr(real, num, den, NOP_ADD);
}

static INLINE void
rsub_fi_fr(n_real *real, long num, long den)
{
    rop_fi_fr_as_xr(real, num, den, NOP_SUB);
}

static INLINE void
rmul_fi_fr(n_real *real, long num, long den)
{
    rop_fi_fr_md_xr(real, num, den, NOP_MUL);
}

static INLINE void
rdiv_fi_fr(n_real *real, long num, long den)
{
    rop_fi_fr_md_xr(real, num, den, NOP_DIV);
}

static INLINE int
cmp_fi_fr(long fi, long num, long den)
{
    return (cmp_flonum((double)fi, (double)num / (double)den));
}


/************************************************************************
 * FIXNUM BIGRATIO
 ************************************************************************/
static void
rop_fi_br_as_xr(n_real *real, mpr *ratio, int nop)
{
    mpi iop;
    mpr *bigr = XALLOC(mpr);

    mpi_init(&iop);
    mpi_seti(&iop, RFI(real));

    mpr_init(bigr);
    mpr_set(bigr, ratio);

    mpi_mul(&iop, &iop, mpr_den(ratio));
    if (nop == NOP_ADD)
      mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
    else
      mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));

    mpi_clear(&iop);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real); 
}

static void
rop_fi_br_md_xr(n_real *real, mpr *ratio, int nop)
{
    mpi iop;
    mpr *bigr = XALLOC(mpr);

    mpi_init(&iop);
    mpi_seti(&iop, RFI(real));

    mpr_init(bigr);
    if (nop == NOP_MUL)
      mpr_set(bigr, ratio);
    else
      mpr_inv(bigr, ratio);

    mpi_mul(mpr_num(bigr), &iop, mpr_num(bigr));

    mpi_clear(&iop);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real);
}

static INLINE void
radd_fi_br(n_real *real, mpr *ratio)
{
    rop_fi_br_as_xr(real, ratio, NOP_ADD);
}

static INLINE void
rsub_fi_br(n_real *real, mpr *ratio)
{
    rop_fi_br_as_xr(real, ratio, NOP_SUB);
}

static INLINE void
rmul_fi_br(n_real *real, mpr *ratio)
{
    rop_fi_br_md_xr(real, ratio, NOP_MUL);
}

static INLINE void
rdiv_fi_br(n_real *real, mpr *ratio)
{
    rop_fi_br_md_xr(real, ratio, NOP_DIV);
}

static INLINE int
cmp_fi_br(long op1, mpr *op2)
{
    return (-mpr_cmpi(op2, op1));
}


/************************************************************************
 * BIGNUM FIXNUM
 ************************************************************************/
static INLINE void
radd_bi_fi(n_real *real, long fi)
{
    mpi_addi(RBI(real), RBI(real), fi);
    rbi_canonicalize(real);
}

static INLINE void
rsub_bi_fi(n_real *real, long fi)
{
    mpi_subi(RBI(real), RBI(real), fi);
    rbi_canonicalize(real);
}

static INLINE void
rmul_bi_fi(n_real *real, long fi)
{
    mpi_muli(RBI(real), RBI(real), fi);
    rbi_canonicalize(real);
}

static void
rdiv_bi_fi(n_real *real, long fi)
{
    mpr *bigr;

    if (RFI(real) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    bigr = XALLOC(mpr);
    mpr_init(bigr);
    mpi_set(mpr_num(bigr), RBI(real));
    mpi_seti(mpr_den(bigr), fi);
    RCLEAR_BI(real);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real);
}

static INLINE int
cmp_bi_fi(mpi *bignum, long fi)
{
    return (mpi_cmpi(bignum, fi));
}


/************************************************************************
 * BIGNUM BIGNUM
 ************************************************************************/
static INLINE void
radd_bi_bi(n_real *real, mpi *bignum)
{
    mpi_add(RBI(real), RBI(real), bignum);
    rbi_canonicalize(real);
}

static INLINE void
rsub_bi_bi(n_real *real, mpi *bignum)
{
    mpi_sub(RBI(real), RBI(real), bignum);
    rbi_canonicalize(real);
}

static INLINE void
rmul_bi_bi(n_real *real, mpi *bignum)
{
    mpi_mul(RBI(real), RBI(real), bignum);
    rbi_canonicalize(real);
}

static void
rdiv_bi_bi(n_real *real, mpi *bignum)
{
    mpr *bigr;

    if (mpi_cmpi(bignum, 0) == 0)
      fatal_error(DIVIDE_BY_ZERO);

    bigr = XALLOC(mpr);
    mpr_init(bigr);
    mpi_set(mpr_num(bigr), RBI(real));
    mpi_set(mpr_den(bigr), bignum);
    RCLEAR_BI(real);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real); 
}

static INLINE int
cmp_bi_bi(mpi *op1, mpi *op2)
{
    return (mpi_cmp(op1, op2));
}


/************************************************************************
 * BIGNUM FIXRATIO
 ************************************************************************/
static void
rop_bi_fr_as_xr(n_real *real, long num, long den, int nop)
{
    mpi iop;
    mpr *bigr = XALLOC(mpr);

    mpi_init(&iop);
    mpi_set(&iop, RBI(real));
    mpi_muli(&iop, &iop, den);

    mpr_init(bigr);
    mpr_seti(bigr, num, den);

    if (nop == NOP_ADD)
      mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
    else
      mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
    mpi_clear(&iop);

    RCLEAR_BI(real);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real);
}

static INLINE void
rop_bi_fr_md_xr(n_real *real, long num, long den, int nop)
{
    mpr *bigr = XALLOC(mpr);

    mpr_init(bigr);

    mpr_seti(bigr, num, den);

    if (nop == NOP_MUL)
      mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr));
    else {
      mpi_mul(mpr_den(bigr), RBI(real), mpr_den(bigr));
      mpr_inv(bigr, bigr);
    }

    RCLEAR_BI(real);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real);
}

static INLINE void
radd_bi_fr(n_real *real, long num, long den)
{
    rop_bi_fr_as_xr(real, num, den, NOP_ADD);
}

static INLINE void
rsub_bi_fr(n_real *real, long num, long den)
{
    rop_bi_fr_as_xr(real, num, den, NOP_SUB);
}

static INLINE void
rmul_bi_fr(n_real *real, long num, long den)
{
    rop_bi_fr_md_xr(real, num, den, NOP_MUL);
}

static INLINE void
rdiv_bi_fr(n_real *real, long num, long den)
{
    rop_bi_fr_md_xr(real, num, den, NOP_DIV);
}

static int
cmp_bi_fr(mpi *bignum, long num, long den)
{
    int cmp;
    mpr cmp1, cmp2;

    mpr_init(&cmp1);
    mpi_set(mpr_num(&cmp1), bignum);
    mpi_seti(mpr_den(&cmp1), 1);

    mpr_init(&cmp2);
    mpr_seti(&cmp2, num, den);

    cmp = mpr_cmp(&cmp1, &cmp2);
    mpr_clear(&cmp1);
    mpr_clear(&cmp2);

    return (cmp);
}


/************************************************************************
 * BIGNUM BIGRATIO
 ************************************************************************/
static void
rop_bi_br_as_xr(n_real *real, mpr *bigratio, int nop)
{
    mpi iop;
    mpr *bigr = XALLOC(mpr);

    mpi_init(&iop);
    mpi_set(&iop, RBI(real));
    mpr_init(bigr);
    mpr_set(bigr, bigratio);

    mpi_mul(&iop, &iop, mpr_den(bigratio));

    if (nop == NOP_ADD)
      mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
    else
      mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
    mpi_clear(&iop);

    RCLEAR_BI(real);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real);
}

static void
rop_bi_br_md_xr(n_real *real, mpr *bigratio, int nop)
{
    mpr *bigr = XALLOC(mpr);

    mpr_init(bigr);
    if (nop == NOP_MUL)
      mpr_set(bigr, bigratio);
    else
      mpr_inv(bigr, bigratio);

    mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr));

    RCLEAR_BI(real);
    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real); 
}

static INLINE void
radd_bi_br(n_real *real, mpr *bigratio)
{
    rop_bi_br_as_xr(real, bigratio, NOP_ADD);
}

static INLINE void
rsub_bi_br(n_real *real, mpr *bigratio)
{
    rop_bi_br_as_xr(real, bigratio, NOP_SUB);
}

static INLINE void
rmul_bi_br(n_real *real, mpr *bigratio)
{
    rop_bi_br_md_xr(real, bigratio, NOP_MUL);
}

static INLINE void
rdiv_bi_br(n_real *real, mpr *bigratio)
{
    rop_bi_br_md_xr(real, bigratio, NOP_DIV);
}

static int
cmp_bi_br(mpi *bignum, mpr *bigratio)
{
    int cmp;
    mpr cmp1;

    mpr_init(&cmp1);
    mpi_set(mpr_num(&cmp1), bignum);
    mpi_seti(mpr_den(&cmp1), 1);

    cmp = mpr_cmp(&cmp1, bigratio);
    mpr_clear(&cmp1);

    return (cmp);
}


/************************************************************************
 * FIXRATIO FIXNUM
 ************************************************************************/
static void
rop_fr_fi_as_xr(n_real *real, long op, int nop)
{
    int fit;
    long value = 0, num = RFRN(real), den = RFRD(real);

    fit = !fi_fi_mul_overflow(op, den);

    if (fit) {
      value = op * den;
      if (nop == NOP_ADD)
          fit = !fi_fi_add_overflow(value, num);
      else
          fit = !fi_fi_sub_overflow(value, num);
    }
    if (fit) {
      if (nop == NOP_ADD)
          RFRN(real) = num + value;
      else
          RFRN(real) = num - value;
      rfr_canonicalize(real);
    }
    else {
      mpi iop;
      mpr *bigr = XALLOC(mpr);

      mpr_init(bigr);
      mpr_seti(bigr, num, den);
      mpi_init(&iop);
      mpi_seti(&iop, op);
      mpi_muli(&iop, &iop, den);
      if (nop == NOP_ADD)
          mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
      else
          mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
      mpi_clear(&iop);
      RBR(real) = bigr;
      RTYPE(real) = N_BIGRATIO;
      rbr_canonicalize(real);
    }
}

static void
rop_fr_fi_md_xr(n_real *real, long op, int nop)
{
    long num = RFRN(real), den = RFRD(real);

    if (nop == NOP_MUL) {
      if (!fi_fi_mul_overflow(op, num)) {
          RFRN(real) = op * num;
          rfr_canonicalize(real);
          return;
      }
    }
    else if (!fi_fi_mul_overflow(op, den)) {
      RFRD(real) = op * den;
      rfr_canonicalize(real);
      return;
    }

    {
      mpr *bigr = XALLOC(mpr);

      mpr_init(bigr);
      mpr_seti(bigr, num, den);
      if (nop == NOP_MUL)
          mpr_muli(bigr, bigr, op);
      else
          mpr_divi(bigr, bigr, op);
      RBR(real) = bigr;
      RTYPE(real) = N_BIGRATIO;
      rbr_canonicalize(real);
    }
}

static INLINE void
radd_fr_fi(n_real *real, long op)
{
    rop_fr_fi_as_xr(real, op, NOP_ADD);
}

static INLINE void
rsub_fr_fi(n_real *real, long op)
{
    rop_fr_fi_as_xr(real, op, NOP_SUB);
}

static INLINE void
rmul_fr_fi(n_real *real, long op)
{
    rop_fr_fi_md_xr(real, op, NOP_MUL);
}

static INLINE void
rdiv_fr_fi(n_real *real, long op)
{
    rop_fr_fi_md_xr(real, op, NOP_DIV);
}

static INLINE int
cmp_fr_fi(long num, long den, long fixnum)
{
    return (cmp_flonum((double)num / (double)den, (double)fixnum));
}


/************************************************************************
 * FIXRATIO BIGNUM
 ************************************************************************/
static void
rop_fr_bi_as_xr(n_real *real, mpi *bignum, int nop)
{
    mpi iop;
    mpr *bigr = XALLOC(mpr);

    mpr_init(bigr);
    mpr_seti(bigr, RFRN(real), RFRD(real));

    mpi_init(&iop);
    mpi_set(&iop, bignum);
    mpi_muli(&iop, &iop, RFRD(real));

    if (nop == NOP_ADD)
      mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
    else
      mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
    mpi_clear(&iop);

    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real); 
}

static void
rop_fr_bi_md_xr(n_real *real, mpi *bignum, int nop)
{
    mpr *bigr = XALLOC(mpr);

    mpr_init(bigr);
    mpr_seti(bigr, RFRN(real), RFRD(real));

    if (nop == NOP_MUL)
      mpi_mul(mpr_num(bigr), mpr_num(bigr), bignum);
    else
      mpi_mul(mpr_den(bigr), mpr_den(bigr), bignum);

    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real); 
}

static INLINE void
radd_fr_bi(n_real *real, mpi *bignum)
{
    rop_fr_bi_as_xr(real, bignum, NOP_ADD);
}

static INLINE void
rsub_fr_bi(n_real *real, mpi *bignum)
{
    rop_fr_bi_as_xr(real, bignum, NOP_SUB);
}

static INLINE void
rmul_fr_bi(n_real *real, mpi *bignum)
{
    rop_fr_bi_md_xr(real, bignum, NOP_MUL);
}

static INLINE void
rdiv_fr_bi(n_real *real, mpi *bignum)
{
    rop_fr_bi_md_xr(real, bignum, NOP_DIV);
}

static int
cmp_fr_bi(long num, long den, mpi *bignum)
{
    int cmp;
    mpr cmp1, cmp2;

    mpr_init(&cmp1);
    mpr_seti(&cmp1, num, den);

    mpr_init(&cmp2);
    mpi_set(mpr_num(&cmp2), bignum);
    mpi_seti(mpr_den(&cmp2), 1);

    cmp = mpr_cmp(&cmp1, &cmp2);
    mpr_clear(&cmp1);
    mpr_clear(&cmp2);

    return (cmp);
}


/************************************************************************
 * FIXRATIO FIXRATIO
 ************************************************************************/
static void
rop_fr_fr_as_xr(n_real *real, long num2, long den2, int nop)
{
    int fit;
    long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0;

    fit = !fi_fi_mul_overflow(num1, den2);
    if (fit) {
      num = num1 * den2;
      fit = !fi_fi_mul_overflow(num2, den1);
      if (fit) {
          den = num2 * den1;
          if (nop == NOP_ADD) {
            if ((fit = !fi_fi_add_overflow(num, den)) != 0)
                num += den;
          }
          else if ((fit = !fi_fi_sub_overflow(num, den)) != 0)
            num -= den;
          if (fit) {
            fit = !fi_fi_mul_overflow(den1, den2);
            if (fit)
                den = den1 * den2;
          }
      }
    }
    if (fit) {
      RFRN(real) = num;
      RFRD(real) = den;
      rfr_canonicalize(real);
    }
    else {
      mpi iop;
      mpr *bigr = XALLOC(mpr);

      mpr_init(bigr);
      mpr_seti(bigr, num1, den1);
      mpi_muli(mpr_den(bigr), mpr_den(bigr), den2);
      mpi_init(&iop);
      mpi_seti(&iop, num2);
      mpi_muli(&iop, &iop, den1);
      mpi_muli(mpr_num(bigr), mpr_num(bigr), den2);
      if (nop == NOP_ADD)
          mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
      else
          mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
      mpi_clear(&iop);
      RBR(real) = bigr;
      RTYPE(real) = N_BIGRATIO;
      rbr_canonicalize(real);
    }
}

static void
rop_fr_fr_md_xr(n_real *real, long num2, long den2, int nop)
{
    int fit;
    long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0;

    if (nop == NOP_MUL) {
      fit = !fi_fi_mul_overflow(num1, num2) && !fi_fi_mul_overflow(den1, den2);
      if (fit) {
          num = num1 * num2;
          den = den1 * den2;
      }
    }
    else {
      fit = !fi_fi_mul_overflow(num1, den2) && !fi_fi_mul_overflow(den1, num2);
      if (fit) {
          num = num1 * den2;
          den = den1 * num2;
      }
    }

    if (fit) {
      RFRN(real) = num;
      RFRD(real) = den;
      rfr_canonicalize(real);
    }
    else {
      mpr *bigr = XALLOC(mpr);

      mpr_init(bigr);

      if (nop == NOP_MUL) {
          mpr_seti(bigr, num1, den1);
          mpi_muli(mpr_num(bigr), mpr_num(bigr), num2);
          mpi_muli(mpr_den(bigr), mpr_den(bigr), den2);
      }
      else {
          mpr_seti(bigr, num1, num2);
          mpi_muli(mpr_num(bigr), mpr_num(bigr), den2);
          mpi_muli(mpr_den(bigr), mpr_den(bigr), den1);
      }

      RBR(real) = bigr;
      RTYPE(real) = N_BIGRATIO;
      rbr_canonicalize(real);
    }
}

static INLINE void
radd_fr_fr(n_real *real, long num, long den)
{
    rop_fr_fr_as_xr(real, num, den, NOP_ADD);
}

static INLINE void
rsub_fr_fr(n_real *real, long num, long den)
{
    rop_fr_fr_as_xr(real, num, den, NOP_SUB);
}

static INLINE void
rmul_fr_fr(n_real *real, long num, long den)
{
    rop_fr_fr_md_xr(real, num, den, NOP_MUL);
}

static INLINE void
rdiv_fr_fr(n_real *real, long num, long den)
{
    rop_fr_fr_md_xr(real, num, den, NOP_DIV);
}

static INLINE int
cmp_fr_fr(long num1, long den1, long num2, long den2)
{
    return (cmp_flonum((double)num1 / (double)den1,
                   (double)num2 / (double)den2));
}


/************************************************************************
 * FIXRATIO BIGRATIO
 ************************************************************************/
static void
rop_fr_br_asmd_xr(n_real *real, mpr *bigratio, int nop)
{
    mpr *bigr = XALLOC(mpr);

    mpr_init(bigr);
    mpr_seti(bigr, RFRN(real), RFRD(real));

    switch (nop) {
      case NOP_ADD:
          mpr_add(bigr, bigr, bigratio);
          break;
      case NOP_SUB:
          mpr_sub(bigr, bigr, bigratio);
          break;
      case NOP_MUL:
          mpr_mul(bigr, bigr, bigratio);
          break;
      default:
          mpr_div(bigr, bigr, bigratio);
          break;
    }

    RBR(real) = bigr;
    RTYPE(real) = N_BIGRATIO;
    rbr_canonicalize(real); 
}

static INLINE void
radd_fr_br(n_real *real, mpr *bigratio)
{
    rop_fr_br_asmd_xr(real, bigratio, NOP_ADD);
}

static INLINE void
rsub_fr_br(n_real *real, mpr *bigratio)
{
    rop_fr_br_asmd_xr(real, bigratio, NOP_SUB);
}

static INLINE void
rmul_fr_br(n_real *real, mpr *bigratio)
{
    rop_fr_br_asmd_xr(real, bigratio, NOP_MUL);
}

static INLINE void
rdiv_fr_br(n_real *real, mpr *bigratio)
{
    rop_fr_br_asmd_xr(real, bigratio, NOP_DIV);
}

static int
cmp_fr_br(long num, long den, mpr *bigratio)
{
    int cmp;
    mpr cmp1;

    mpr_init(&cmp1);
    mpr_seti(&cmp1, num, den);

    cmp = mpr_cmp(&cmp1, bigratio);
    mpr_clear(&cmp1);

    return (cmp);
}


/************************************************************************
 * BIGRATIO FIXNUM
 ************************************************************************/
static void
rop_br_fi_asmd_xr(n_real *real, long fixnum, int nop)
{
    mpr *bigratio = RBR(real);

    switch (nop) {
      case NOP_ADD:
          mpr_addi(bigratio, bigratio, fixnum);
          break;
      case NOP_SUB:
          mpr_subi(bigratio, bigratio, fixnum);
          break;
      case NOP_MUL:
          mpr_muli(bigratio, bigratio, fixnum);
          break;
      default:
          if (fixnum == 0)
            fatal_error(DIVIDE_BY_ZERO);
          mpr_divi(bigratio, bigratio, fixnum);
          break;
    }
    rbr_canonicalize(real); 
}

static INLINE void
radd_br_fi(n_real *real, long fixnum)
{
    rop_br_fi_asmd_xr(real, fixnum, NOP_ADD);
}

static INLINE void
rsub_br_fi(n_real *real, long fixnum)
{
    rop_br_fi_asmd_xr(real, fixnum, NOP_SUB);
}

static INLINE void
rmul_br_fi(n_real *real, long fixnum)
{
    rop_br_fi_asmd_xr(real, fixnum, NOP_MUL);
}

static INLINE void
rdiv_br_fi(n_real *real, long fixnum)
{
    rop_br_fi_asmd_xr(real, fixnum, NOP_DIV);
}

static int
cmp_br_fi(mpr *bigratio, long fixnum)
{
    int cmp;
    mpr cmp2;

    mpr_init(&cmp2);
    mpr_seti(&cmp2, fixnum, 1);
    cmp = mpr_cmp(bigratio, &cmp2);
    mpr_clear(&cmp2);

    return (cmp);
}


/************************************************************************
 * BIGRATIO BIGNUM
 ************************************************************************/
static void
rop_br_bi_as_xr(n_real *real, mpi *bignum, int nop)
{
    mpi iop;

    mpi_init(&iop);
    mpi_set(&iop, bignum);

    mpi_mul(&iop, &iop, RBRD(real));
    if (nop == NOP_ADD)
      mpi_add(RBRN(real), RBRN(real), &iop);
    else
      mpi_sub(RBRN(real), RBRN(real), &iop);
    mpi_clear(&iop);
    rbr_canonicalize(real); 
}

static INLINE void
radd_br_bi(n_real *real, mpi *bignum)
{
    rop_br_bi_as_xr(real, bignum, NOP_ADD);
}

static INLINE void
rsub_br_bi(n_real *real, mpi *bignum)
{
    rop_br_bi_as_xr(real, bignum, NOP_SUB);
}

static INLINE void
rmul_br_bi(n_real *real, mpi *bignum)
{
    mpi_mul(RBRN(real), RBRN(real), bignum);
    rbr_canonicalize(real);
}

static INLINE void
rdiv_br_bi(n_real *real, mpi *bignum)
{
    mpi_mul(RBRD(real), RBRD(real), bignum);
    rbr_canonicalize(real);
}

static int
cmp_br_bi(mpr *bigratio, mpi *bignum)
{
    int cmp;
    mpr cmp1;

    mpr_init(&cmp1);
    mpi_set(mpr_num(&cmp1), bignum);
    mpi_seti(mpr_den(&cmp1), 1);

    cmp = mpr_cmp(bigratio, &cmp1);
    mpr_clear(&cmp1);

    return (cmp);
}


/************************************************************************
 * BIGRATIO FIXRATIO
 ************************************************************************/
static void
rop_br_fr_asmd_xr(n_real *real, long num, long den, int nop)
{
    mpr *bigratio = RBR(real), rop;

    mpr_init(&rop);
    mpr_seti(&rop, num, den);
    switch (nop) {
      case NOP_ADD:
          mpr_add(bigratio, bigratio, &rop);
          break;
      case NOP_SUB:
          mpr_sub(bigratio, bigratio, &rop);
          break;
      case NOP_MUL:
          mpr_mul(bigratio, bigratio, &rop);
          break;
      default:
          mpr_div(bigratio, bigratio, &rop);
          break;
    }
    mpr_clear(&rop);
    rbr_canonicalize(real); 
}

static INLINE void
radd_br_fr(n_real *real, long num, long den)
{
    rop_br_fr_asmd_xr(real, num, den, NOP_ADD);
}

static INLINE void
rsub_br_fr(n_real *real, long num, long den)
{
    rop_br_fr_asmd_xr(real, num, den, NOP_SUB);
}

static INLINE void
rmul_br_fr(n_real *real, long num, long den)
{
    rop_br_fr_asmd_xr(real, num, den, NOP_MUL);
}

static INLINE void
rdiv_br_fr(n_real *real, long num, long den)
{
    rop_br_fr_asmd_xr(real, num, den, NOP_DIV);
}

static int
cmp_br_fr(mpr *bigratio, long num, long den)
{
    int cmp;
    mpr cmp2;

    mpr_init(&cmp2);
    mpr_seti(&cmp2, num, den);
    cmp = mpr_cmp(bigratio, &cmp2);
    mpr_clear(&cmp2);

    return (cmp);
}


/************************************************************************
 * BIGRATIO BIGRATIO
 ************************************************************************/
static INLINE void
radd_br_br(n_real *real, mpr *bigratio)
{
    mpr_add(RBR(real), RBR(real), bigratio);
    rbr_canonicalize(real); 
}

static INLINE void
rsub_br_br(n_real *real, mpr *bigratio)
{
    mpr_sub(RBR(real), RBR(real), bigratio);
    rbr_canonicalize(real); 
}

static INLINE void
rmul_br_br(n_real *real, mpr *bigratio)
{
    mpr_mul(RBR(real), RBR(real), bigratio);
    rbr_canonicalize(real); 
}

static INLINE void
rdiv_br_br(n_real *real, mpr *bigratio)
{
    mpr_div(RBR(real), RBR(real), bigratio);
    rbr_canonicalize(real); 
}

static INLINE int
cmp_br_br(mpr *op1, mpr *op2)
{
    return (mpr_cmp(op1, op2));
}

Generated by  Doxygen 1.6.0   Back to index