mathimp.c revision 31de2854
15dfecf96Smrg/* 25dfecf96Smrg * Copyright (c) 2002 by The XFree86 Project, Inc. 35dfecf96Smrg * 45dfecf96Smrg * Permission is hereby granted, free of charge, to any person obtaining a 55dfecf96Smrg * copy of this software and associated documentation files (the "Software"), 65dfecf96Smrg * to deal in the Software without restriction, including without limitation 75dfecf96Smrg * the rights to use, copy, modify, merge, publish, distribute, sublicense, 85dfecf96Smrg * and/or sell copies of the Software, and to permit persons to whom the 95dfecf96Smrg * Software is furnished to do so, subject to the following conditions: 105dfecf96Smrg * 115dfecf96Smrg * The above copyright notice and this permission notice shall be included in 125dfecf96Smrg * all copies or substantial portions of the Software. 135dfecf96Smrg * 145dfecf96Smrg * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 155dfecf96Smrg * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 165dfecf96Smrg * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 175dfecf96Smrg * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 185dfecf96Smrg * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF 195dfecf96Smrg * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 205dfecf96Smrg * SOFTWARE. 215dfecf96Smrg * 225dfecf96Smrg * Except as contained in this notice, the name of the XFree86 Project shall 235dfecf96Smrg * not be used in advertising or otherwise to promote the sale, use or other 245dfecf96Smrg * dealings in this Software without prior written authorization from the 255dfecf96Smrg * XFree86 Project. 265dfecf96Smrg * 275dfecf96Smrg * Author: Paulo César Pereira de Andrade 285dfecf96Smrg */ 295dfecf96Smrg 305dfecf96Smrg/* $XFree86: xc/programs/xedit/lisp/mathimp.c,v 1.14tsi Exp $ */ 315dfecf96Smrg 325dfecf96Smrg 335dfecf96Smrg/* 345dfecf96Smrg * Defines 355dfecf96Smrg */ 365dfecf96Smrg#ifdef __GNUC__ 375dfecf96Smrg#define CONST __attribute__ ((__const__)) 385dfecf96Smrg#else 395dfecf96Smrg#define CONST /**/ 405dfecf96Smrg#endif 415dfecf96Smrg 425dfecf96Smrg#define N_FIXNUM 1 435dfecf96Smrg#define N_BIGNUM 2 445dfecf96Smrg#define N_FLONUM 3 455dfecf96Smrg#define N_FIXRATIO 4 465dfecf96Smrg#define N_BIGRATIO 5 475dfecf96Smrg 485dfecf96Smrg#define NOP_ADD 1 495dfecf96Smrg#define NOP_SUB 2 505dfecf96Smrg#define NOP_MUL 3 515dfecf96Smrg#define NOP_DIV 4 525dfecf96Smrg 535dfecf96Smrg#define NDIVIDE_CEIL 1 545dfecf96Smrg#define NDIVIDE_FLOOR 2 555dfecf96Smrg#define NDIVIDE_ROUND 3 565dfecf96Smrg#define NDIVIDE_TRUNC 4 575dfecf96Smrg 585dfecf96Smrg/* real part from number */ 595dfecf96Smrg#define NREAL(num) &((num)->real) 605dfecf96Smrg#define NRTYPE(num) (num)->real.type 615dfecf96Smrg#define NRFI(num) (num)->real.data.fixnum 625dfecf96Smrg#define NRBI(num) (num)->real.data.bignum 635dfecf96Smrg#define NRFF(num) (num)->real.data.flonum 645dfecf96Smrg#define NRFRN(Num) (Num)->real.data.fixratio.num 655dfecf96Smrg#define NRFRD(num) (num)->real.data.fixratio.den 665dfecf96Smrg#define NRBR(num) (num)->real.data.bigratio 675dfecf96Smrg#define NRBRN(num) mpr_num(NRBR(num)) 685dfecf96Smrg#define NRBRD(num) mpr_den(NRBR(num)) 695dfecf96Smrg 705dfecf96Smrg#define NRCLEAR_BI(num) mpi_clear(NRBI(num)); XFREE(NRBI(num)) 715dfecf96Smrg#define NRCLEAR_BR(num) mpr_clear(NRBR(num)); XFREE(NRBR(num)) 725dfecf96Smrg 735dfecf96Smrg/* imag part from number */ 745dfecf96Smrg#define NIMAG(num) &((num)->imag) 755dfecf96Smrg#define NITYPE(num) (num)->imag.type 765dfecf96Smrg#define NIFI(num) (num)->imag.data.fixnum 775dfecf96Smrg#define NIBI(num) (num)->imag.data.bignum 785dfecf96Smrg#define NIFF(num) (num)->imag.data.flonum 795dfecf96Smrg#define NIFRN(Num) (Num)->imag.data.fixratio.num 805dfecf96Smrg#define NIFRD(num) (num)->imag.data.fixratio.den 815dfecf96Smrg#define NIBR(num) (num)->imag.data.bigratio 825dfecf96Smrg#define NIBRN(obj) mpr_num(NIBR(obj)) 835dfecf96Smrg#define NIBRD(obj) mpr_den(NIBR(obj)) 845dfecf96Smrg 855dfecf96Smrg/* real number fields */ 865dfecf96Smrg#define RTYPE(real) (real)->type 875dfecf96Smrg#define RFI(real) (real)->data.fixnum 885dfecf96Smrg#define RBI(real) (real)->data.bignum 895dfecf96Smrg#define RFF(real) (real)->data.flonum 905dfecf96Smrg#define RFRN(real) (real)->data.fixratio.num 915dfecf96Smrg#define RFRD(real) (real)->data.fixratio.den 925dfecf96Smrg#define RBR(real) (real)->data.bigratio 935dfecf96Smrg#define RBRN(real) mpr_num(RBR(real)) 945dfecf96Smrg#define RBRD(real) mpr_den(RBR(real)) 955dfecf96Smrg 965dfecf96Smrg#define RINTEGERP(real) \ 975dfecf96Smrg (RTYPE(real) == N_FIXNUM || RTYPE(real) == N_BIGNUM) 985dfecf96Smrg 995dfecf96Smrg#define RCLEAR_BI(real) mpi_clear(RBI(real)); XFREE(RBI(real)) 1005dfecf96Smrg#define RCLEAR_BR(real) mpr_clear(RBR(real)); XFREE(RBR(real)) 1015dfecf96Smrg 1025dfecf96Smrg/* numeric value from lisp object */ 1035dfecf96Smrg#define OFI(object) FIXNUM_VALUE(object) 1045dfecf96Smrg#define OII(object) INT_VALUE(object) 1055dfecf96Smrg#define OBI(object) (object)->data.mp.integer 1065dfecf96Smrg#define ODF(object) DFLOAT_VALUE(object) 1075dfecf96Smrg#define OFRN(object) (object)->data.ratio.numerator 1085dfecf96Smrg#define OFRD(object) (object)->data.ratio.denominator 1095dfecf96Smrg#define OBR(object) (object)->data.mp.ratio 1105dfecf96Smrg#define OBRN(object) mpr_num(OBR(object)) 1115dfecf96Smrg#define OBRD(object) mpr_den(OBR(object)) 1125dfecf96Smrg#define OCXR(object) (object)->data.complex.real 1135dfecf96Smrg#define OCXI(object) (object)->data.complex.imag 1145dfecf96Smrg 1155dfecf96Smrg#define XALLOC(type) LispMalloc(sizeof(type)) 1165dfecf96Smrg#define XFREE(ptr) LispFree(ptr) 1175dfecf96Smrg 1185dfecf96Smrg 1195dfecf96Smrg/* 1205dfecf96Smrg * Types 1215dfecf96Smrg */ 1225dfecf96Smrgtypedef struct _n_real { 1235dfecf96Smrg char type; 1245dfecf96Smrg union { 1255dfecf96Smrg long fixnum; 1265dfecf96Smrg mpi *bignum; 1275dfecf96Smrg double flonum; 1285dfecf96Smrg struct { 1295dfecf96Smrg long num; 1305dfecf96Smrg long den; 1315dfecf96Smrg } fixratio; 1325dfecf96Smrg mpr *bigratio; 1335dfecf96Smrg } data; 1345dfecf96Smrg} n_real; 1355dfecf96Smrg 1365dfecf96Smrgtypedef struct _n_number { 1375dfecf96Smrg char complex; 1385dfecf96Smrg n_real real; 1395dfecf96Smrg n_real imag; 1405dfecf96Smrg} n_number; 1415dfecf96Smrg 1425dfecf96Smrg 1435dfecf96Smrg/* 1445dfecf96Smrg * Prototypes 1455dfecf96Smrg */ 1465dfecf96Smrgstatic void number_init(void); 1475dfecf96Smrgstatic LispObj *number_pi(void); 1485dfecf96Smrg 1495dfecf96Smrgstatic void set_real_real(n_real*, n_real*); 1505dfecf96Smrgstatic void set_real_object(n_real*, LispObj*); 1515dfecf96Smrgstatic void set_number_object(n_number*, LispObj*); 1525dfecf96Smrgstatic void clear_real(n_real*); 1535dfecf96Smrgstatic void clear_number(n_number*); 1545dfecf96Smrg 1555dfecf96Smrgstatic LispObj *make_real_object(n_real*); 1565dfecf96Smrgstatic LispObj *make_number_object(n_number*); 1575dfecf96Smrg 1585dfecf96Smrgstatic void fatal_error(int); 1595dfecf96Smrgstatic void fatal_object_error(LispObj*, int); 1605dfecf96Smrgstatic void fatal_builtin_object_error(LispBuiltin*, LispObj*, int); 1615dfecf96Smrg 1625dfecf96Smrgstatic double bi_getd(mpi*); 1635dfecf96Smrgstatic double br_getd(mpr*); 1645dfecf96Smrg 1655dfecf96Smrg/* add */ 1665dfecf96Smrgstatic void add_real_object(n_real*, LispObj*); 1675dfecf96Smrgstatic void add_number_object(n_number*, LispObj*); 1685dfecf96Smrg 1695dfecf96Smrg/* sub */ 1705dfecf96Smrgstatic void sub_real_object(n_real*, LispObj*); 1715dfecf96Smrgstatic void sub_number_object(n_number*, LispObj*); 1725dfecf96Smrg 1735dfecf96Smrg/* mul */ 1745dfecf96Smrgstatic void mul_real_object(n_real*, LispObj*); 1755dfecf96Smrgstatic void mul_number_object(n_number*, LispObj*); 1765dfecf96Smrg 1775dfecf96Smrg/* div */ 1785dfecf96Smrgstatic void div_real_object(n_real*, LispObj*); 1795dfecf96Smrgstatic void div_number_object(n_number*, LispObj*); 1805dfecf96Smrg 1815dfecf96Smrg/* compare */ 1825dfecf96Smrgstatic int cmp_real_real(n_real*, n_real*); 1835dfecf96Smrgstatic int cmp_real_object(n_real*, LispObj*); 1845dfecf96Smrg#if 0 /* not used */ 1855dfecf96Smrgstatic int cmp_number_object(n_number*, LispObj*); 1865dfecf96Smrg#endif 1875dfecf96Smrgstatic int cmp_object_object(LispObj*, LispObj*, int); 1885dfecf96Smrg 1895dfecf96Smrg/* fixnum */ 1905dfecf96Smrgstatic INLINE int fi_fi_add_overflow(long, long) CONST; 1915dfecf96Smrgstatic INLINE int fi_fi_sub_overflow(long, long) CONST; 1925dfecf96Smrgstatic INLINE int fi_fi_mul_overflow(long, long) CONST; 1935dfecf96Smrg 1945dfecf96Smrg/* bignum */ 1955dfecf96Smrgstatic void rbi_canonicalize(n_real*); 1965dfecf96Smrg 1975dfecf96Smrg/* ratio */ 1985dfecf96Smrgstatic void rfr_canonicalize(n_real*); 1995dfecf96Smrgstatic void rbr_canonicalize(n_real*); 2005dfecf96Smrg 2015dfecf96Smrg/* complex */ 2025dfecf96Smrgstatic void ncx_canonicalize(n_number*); 2035dfecf96Smrg 2045dfecf96Smrg/* abs */ 2055dfecf96Smrgstatic void abs_real(n_real*); 2065dfecf96Smrgstatic void abs_number(n_number*); 2075dfecf96Smrgstatic void nabs_cx(n_number*); 2085dfecf96Smrgstatic INLINE void rabs_fi(n_real*); 2095dfecf96Smrgstatic INLINE void rabs_bi(n_real*); 2105dfecf96Smrgstatic INLINE void rabs_ff(n_real*); 2115dfecf96Smrgstatic INLINE void rabs_fr(n_real*); 2125dfecf96Smrgstatic INLINE void rabs_br(n_real*); 2135dfecf96Smrg 2145dfecf96Smrg/* neg */ 2155dfecf96Smrgstatic void neg_real(n_real*); 2165dfecf96Smrgstatic void neg_number(n_number*); 2175dfecf96Smrgstatic void rneg_fi(n_real*); 2185dfecf96Smrgstatic INLINE void rneg_bi(n_real*); 2195dfecf96Smrgstatic INLINE void rneg_ff(n_real*); 2205dfecf96Smrgstatic INLINE void rneg_fr(n_real*); 2215dfecf96Smrgstatic INLINE void rneg_br(n_real*); 2225dfecf96Smrg 2235dfecf96Smrg/* sqrt */ 2245dfecf96Smrgstatic void sqrt_real(n_real*); 2255dfecf96Smrgstatic void sqrt_number(n_number*); 2265dfecf96Smrgstatic void rsqrt_xi(n_real*); 2275dfecf96Smrgstatic void rsqrt_xr(n_real*); 2285dfecf96Smrgstatic void rsqrt_ff(n_real*); 2295dfecf96Smrgstatic void nsqrt_cx(n_number*); 2305dfecf96Smrgstatic void nsqrt_xi(n_number*); 2315dfecf96Smrgstatic void nsqrt_ff(n_number*); 2325dfecf96Smrgstatic void nsqrt_xr(n_number*); 2335dfecf96Smrg 2345dfecf96Smrg/* mod */ 2355dfecf96Smrgstatic void mod_real_real(n_real*, n_real*); 2365dfecf96Smrgstatic void mod_real_object(n_real*, LispObj*); 2375dfecf96Smrgstatic void rmod_fi_fi(n_real*, long); 2385dfecf96Smrgstatic void rmod_fi_bi(n_real*, mpi*); 2395dfecf96Smrgstatic void rmod_bi_fi(n_real*, long); 2405dfecf96Smrgstatic void rmod_bi_bi(n_real*, mpi*); 2415dfecf96Smrg 2425dfecf96Smrg/* rem */ 2435dfecf96Smrgstatic void rem_real_object(n_real*, LispObj*); 2445dfecf96Smrgstatic void rrem_fi_fi(n_real*, long); 2455dfecf96Smrgstatic void rrem_fi_bi(n_real*, mpi*); 2465dfecf96Smrgstatic void rrem_bi_fi(n_real*, long); 2475dfecf96Smrgstatic void rrem_bi_bi(n_real*, mpi*); 2485dfecf96Smrg 2495dfecf96Smrg/* gcd */ 2505dfecf96Smrgstatic void gcd_real_object(n_real*, LispObj*); 2515dfecf96Smrg 2525dfecf96Smrg/* and */ 2535dfecf96Smrgstatic void and_real_object(n_real*, LispObj*); 2545dfecf96Smrg 2555dfecf96Smrg/* eqv */ 2565dfecf96Smrgstatic void eqv_real_object(n_real*, LispObj*); 2575dfecf96Smrg 2585dfecf96Smrg/* ior */ 2595dfecf96Smrgstatic void ior_real_object(n_real*, LispObj*); 2605dfecf96Smrg 2615dfecf96Smrg/* not */ 2625dfecf96Smrgstatic void not_real(n_real*); 2635dfecf96Smrg 2645dfecf96Smrg/* xor */ 2655dfecf96Smrgstatic void xor_real_object(n_real*, LispObj*); 2665dfecf96Smrg 2675dfecf96Smrg/* divide */ 2685dfecf96Smrgstatic void divide_number_object(n_number*, LispObj*, int, int); 2695dfecf96Smrgstatic void ndivide_xi_xi(n_number*, LispObj*, int, int); 2705dfecf96Smrgstatic void ndivide_flonum(n_number*, double, double, int, int); 2715dfecf96Smrgstatic void ndivide_xi_xr(n_number*, LispObj*, int, int); 2725dfecf96Smrgstatic void ndivide_xr_xi(n_number*, LispObj*, int, int); 2735dfecf96Smrgstatic void ndivide_xr_xr(n_number*, LispObj*, int, int); 2745dfecf96Smrg 2755dfecf96Smrg/* real complex */ 2765dfecf96Smrgstatic void nadd_re_cx(n_number*, LispObj*); 2775dfecf96Smrgstatic void nsub_re_cx(n_number*, LispObj*); 2785dfecf96Smrgstatic void nmul_re_cx(n_number*, LispObj*); 2795dfecf96Smrgstatic void ndiv_re_cx(n_number*, LispObj*); 2805dfecf96Smrg 2815dfecf96Smrg/* complex real */ 2825dfecf96Smrgstatic void nadd_cx_re(n_number*, LispObj*); 2835dfecf96Smrgstatic void nsub_cx_re(n_number*, LispObj*); 2845dfecf96Smrgstatic void nmul_cx_re(n_number*, LispObj*); 2855dfecf96Smrgstatic void ndiv_cx_re(n_number*, LispObj*); 2865dfecf96Smrg 2875dfecf96Smrg/* complex complex */ 2885dfecf96Smrgstatic void nadd_cx_cx(n_number*, LispObj*); 2895dfecf96Smrgstatic void nsub_cx_cx(n_number*, LispObj*); 2905dfecf96Smrgstatic void nmul_cx_cx(n_number*, LispObj*); 2915dfecf96Smrgstatic void ndiv_cx_cx(n_number*, LispObj*); 2925dfecf96Smrgstatic int cmp_cx_cx(LispObj*, LispObj*); 2935dfecf96Smrg 2945dfecf96Smrg/* flonum flonum */ 2955dfecf96Smrgstatic void radd_flonum(n_real*, double, double); 2965dfecf96Smrgstatic void rsub_flonum(n_real*, double, double); 2975dfecf96Smrgstatic void rmul_flonum(n_real*, double, double); 2985dfecf96Smrgstatic void rdiv_flonum(n_real*, double, double); 2995dfecf96Smrgstatic int cmp_flonum(double, double); 3005dfecf96Smrg 3015dfecf96Smrg/* fixnum fixnum */ 3025dfecf96Smrgstatic void rop_fi_fi_bi(n_real*, long, int); 3035dfecf96Smrgstatic INLINE void radd_fi_fi(n_real*, long); 3045dfecf96Smrgstatic INLINE void rsub_fi_fi(n_real*, long); 3055dfecf96Smrgstatic INLINE void rmul_fi_fi(n_real*, long); 3065dfecf96Smrgstatic INLINE void rdiv_fi_fi(n_real*, long); 3075dfecf96Smrgstatic INLINE int cmp_fi_fi(long, long); 3085dfecf96Smrgstatic void ndivide_fi_fi(n_number*, long, int, int); 3095dfecf96Smrg 3105dfecf96Smrg/* fixnum bignum */ 3115dfecf96Smrgstatic void rop_fi_bi_xi(n_real*, mpi*, int); 3125dfecf96Smrgstatic INLINE void radd_fi_bi(n_real*, mpi*); 3135dfecf96Smrgstatic INLINE void rsub_fi_bi(n_real*, mpi*); 3145dfecf96Smrgstatic INLINE void rmul_fi_bi(n_real*, mpi*); 3155dfecf96Smrgstatic void rdiv_fi_bi(n_real*, mpi*); 3165dfecf96Smrgstatic INLINE int cmp_fi_bi(long, mpi*); 3175dfecf96Smrg 3185dfecf96Smrg/* fixnum fixratio */ 3195dfecf96Smrgstatic void rop_fi_fr_as_xr(n_real*, long, long, int); 3205dfecf96Smrgstatic void rop_fi_fr_md_xr(n_real*, long, long, int); 3215dfecf96Smrgstatic INLINE void radd_fi_fr(n_real*, long, long); 3225dfecf96Smrgstatic INLINE void rsub_fi_fr(n_real*, long, long); 3235dfecf96Smrgstatic INLINE void rmul_fi_fr(n_real*, long, long); 3245dfecf96Smrgstatic INLINE void rdiv_fi_fr(n_real*, long, long); 3255dfecf96Smrgstatic INLINE int cmp_fi_fr(long, long, long); 3265dfecf96Smrg 3275dfecf96Smrg/* fixnum bigratio */ 3285dfecf96Smrgstatic void rop_fi_br_as_xr(n_real*, mpr*, int); 3295dfecf96Smrgstatic void rop_fi_br_md_xr(n_real*, mpr*, int); 3305dfecf96Smrgstatic INLINE void radd_fi_br(n_real*, mpr*); 3315dfecf96Smrgstatic INLINE void rsub_fi_br(n_real*, mpr*); 3325dfecf96Smrgstatic INLINE void rmul_fi_br(n_real*, mpr*); 3335dfecf96Smrgstatic INLINE void rdiv_fi_br(n_real*, mpr*); 3345dfecf96Smrgstatic INLINE int cmp_fi_br(long, mpr*); 3355dfecf96Smrg 3365dfecf96Smrg/* bignum fixnum */ 3375dfecf96Smrgstatic INLINE void radd_bi_fi(n_real*, long); 3385dfecf96Smrgstatic INLINE void rsub_bi_fi(n_real*, long); 3395dfecf96Smrgstatic INLINE void rmul_bi_fi(n_real*, long); 3405dfecf96Smrgstatic void rdiv_bi_fi(n_real*, long); 3415dfecf96Smrgstatic INLINE int cmp_bi_fi(mpi*, long); 3425dfecf96Smrg 3435dfecf96Smrg/* bignum bignum */ 3445dfecf96Smrgstatic INLINE void radd_bi_bi(n_real*, mpi*); 3455dfecf96Smrgstatic INLINE void rsub_bi_bi(n_real*, mpi*); 3465dfecf96Smrgstatic INLINE void rmul_bi_bi(n_real*, mpi*); 3475dfecf96Smrgstatic void rdiv_bi_bi(n_real*, mpi*); 3485dfecf96Smrgstatic INLINE int cmp_bi_bi(mpi*, mpi*); 3495dfecf96Smrg 3505dfecf96Smrg/* bignum fixratio */ 3515dfecf96Smrgstatic void rop_bi_fr_as_xr(n_real*, long, long, int); 3525dfecf96Smrgstatic void rop_bi_fr_md_xr(n_real*, long, long, int); 3535dfecf96Smrgstatic INLINE void radd_bi_fr(n_real*, long, long); 3545dfecf96Smrgstatic INLINE void rsub_bi_fr(n_real*, long, long); 3555dfecf96Smrgstatic INLINE void rmul_bi_fr(n_real*, long, long); 3565dfecf96Smrgstatic INLINE void rdiv_bi_fr(n_real*, long, long); 3575dfecf96Smrgstatic int cmp_bi_fr(mpi*, long, long); 3585dfecf96Smrg 3595dfecf96Smrg/* bignum bigratio */ 3605dfecf96Smrgstatic void rop_bi_br_as_xr(n_real*, mpr*, int); 3615dfecf96Smrgstatic void rop_bi_br_md_xr(n_real*, mpr*, int); 3625dfecf96Smrgstatic INLINE void radd_bi_br(n_real*, mpr*); 3635dfecf96Smrgstatic INLINE void rsub_bi_br(n_real*, mpr*); 3645dfecf96Smrgstatic INLINE void rmul_bi_br(n_real*, mpr*); 3655dfecf96Smrgstatic INLINE void rdiv_bi_br(n_real*, mpr*); 3665dfecf96Smrgstatic int cmp_bi_br(mpi*, mpr*); 3675dfecf96Smrg 3685dfecf96Smrg/* fixratio fixnum */ 3695dfecf96Smrgstatic void rop_fr_fi_as_xr(n_real*, long, int); 3705dfecf96Smrgstatic void rop_fr_fi_md_xr(n_real*, long, int); 3715dfecf96Smrgstatic INLINE void radd_fr_fi(n_real*, long); 3725dfecf96Smrgstatic INLINE void rsub_fr_fi(n_real*, long); 3735dfecf96Smrgstatic INLINE void rmul_fr_fi(n_real*, long); 3745dfecf96Smrgstatic INLINE void rdiv_fr_fi(n_real*, long); 3755dfecf96Smrgstatic INLINE int cmp_fr_fi(long, long, long); 3765dfecf96Smrg 3775dfecf96Smrg/* fixratio bignum */ 3785dfecf96Smrgstatic void rop_fr_bi_as_xr(n_real*, mpi*, int); 3795dfecf96Smrgstatic void rop_fr_bi_md_xr(n_real*, mpi*, int); 3805dfecf96Smrgstatic INLINE void radd_fr_bi(n_real*, mpi*); 3815dfecf96Smrgstatic INLINE void rsub_fr_bi(n_real*, mpi*); 3825dfecf96Smrgstatic INLINE void rmul_fr_bi(n_real*, mpi*); 3835dfecf96Smrgstatic INLINE void rdiv_fr_bi(n_real*, mpi*); 3845dfecf96Smrgstatic int cmp_fr_bi(long, long, mpi*); 3855dfecf96Smrg 3865dfecf96Smrg/* fixratio fixratio */ 3875dfecf96Smrgstatic void rop_fr_fr_as_xr(n_real*, long, long, int); 3885dfecf96Smrgstatic void rop_fr_fr_md_xr(n_real*, long, long, int); 3895dfecf96Smrgstatic INLINE void radd_fr_fr(n_real*, long, long); 3905dfecf96Smrgstatic INLINE void rsub_fr_fr(n_real*, long, long); 3915dfecf96Smrgstatic INLINE void rmul_fr_fr(n_real*, long, long); 3925dfecf96Smrgstatic INLINE void rdiv_fr_fr(n_real*, long, long); 3935dfecf96Smrgstatic INLINE int cmp_fr_fr(long, long, long, long); 3945dfecf96Smrg 3955dfecf96Smrg/* fixratio bigratio */ 3965dfecf96Smrgstatic void rop_fr_br_asmd_xr(n_real*, mpr*, int); 3975dfecf96Smrgstatic INLINE void radd_fr_br(n_real*, mpr*); 3985dfecf96Smrgstatic INLINE void rsub_fr_br(n_real*, mpr*); 3995dfecf96Smrgstatic INLINE void rmul_fr_br(n_real*, mpr*); 4005dfecf96Smrgstatic INLINE void rdiv_fr_br(n_real*, mpr*); 4015dfecf96Smrgstatic int cmp_fr_br(long, long, mpr*); 4025dfecf96Smrg 4035dfecf96Smrg/* bigratio fixnum */ 4045dfecf96Smrgstatic void rop_br_fi_asmd_xr(n_real*, long, int); 4055dfecf96Smrgstatic INLINE void radd_br_fi(n_real*, long); 4065dfecf96Smrgstatic INLINE void rsub_br_fi(n_real*, long); 4075dfecf96Smrgstatic INLINE void rmul_br_fi(n_real*, long); 4085dfecf96Smrgstatic INLINE void rdiv_br_fi(n_real*, long); 4095dfecf96Smrgstatic int cmp_br_fi(mpr*, long); 4105dfecf96Smrg 4115dfecf96Smrg/* bigratio bignum */ 4125dfecf96Smrgstatic void rop_br_bi_as_xr(n_real*, mpi*, int); 4135dfecf96Smrgstatic INLINE void radd_br_bi(n_real*, mpi*); 4145dfecf96Smrgstatic INLINE void rsub_br_bi(n_real*, mpi*); 4155dfecf96Smrgstatic INLINE void rmul_br_bi(n_real*, mpi*); 4165dfecf96Smrgstatic INLINE void rdiv_br_bi(n_real*, mpi*); 4175dfecf96Smrgstatic int cmp_br_bi(mpr*, mpi*); 4185dfecf96Smrg 4195dfecf96Smrg/* bigratio fixratio */ 4205dfecf96Smrgstatic void rop_br_fr_asmd_xr(n_real*, long, long, int); 4215dfecf96Smrgstatic INLINE void radd_br_fr(n_real*, long, long); 4225dfecf96Smrgstatic INLINE void rsub_br_fr(n_real*, long, long); 4235dfecf96Smrgstatic INLINE void rmul_br_fr(n_real*, long, long); 4245dfecf96Smrgstatic INLINE void rdiv_br_fr(n_real*, long, long); 4255dfecf96Smrgstatic int cmp_br_fr(mpr*, long, long); 4265dfecf96Smrg 4275dfecf96Smrg/* bigratio bigratio */ 4285dfecf96Smrgstatic INLINE void radd_br_br(n_real*, mpr*); 4295dfecf96Smrgstatic INLINE void rsub_br_br(n_real*, mpr*); 4305dfecf96Smrgstatic INLINE void rmul_br_br(n_real*, mpr*); 4315dfecf96Smrgstatic INLINE void rdiv_br_br(n_real*, mpr*); 4325dfecf96Smrgstatic INLINE int cmp_br_br(mpr*, mpr*); 4335dfecf96Smrg 4345dfecf96Smrg/* 4355dfecf96Smrg * Initialization 4365dfecf96Smrg */ 4375dfecf96Smrgstatic n_real zero, one, two; 4385dfecf96Smrg 4395dfecf96Smrgstatic char *fatal_error_strings[] = { 4405dfecf96Smrg#define DIVIDE_BY_ZERO 0 4415dfecf96Smrg "divide by zero", 4425dfecf96Smrg#define FLOATING_POINT_OVERFLOW 1 4435dfecf96Smrg "floating point overflow", 4445dfecf96Smrg#define FLOATING_POINT_EXCEPTION 2 4455dfecf96Smrg "floating point exception" 4465dfecf96Smrg}; 4475dfecf96Smrg 4485dfecf96Smrgstatic char *fatal_object_error_strings[] = { 4495dfecf96Smrg#define NOT_A_NUMBER 0 4505dfecf96Smrg "is not a number", 4515dfecf96Smrg#define NOT_A_REAL_NUMBER 1 4525dfecf96Smrg "is not a real number", 4535dfecf96Smrg#define NOT_AN_INTEGER 2 4545dfecf96Smrg "is not an integer" 4555dfecf96Smrg}; 4565dfecf96Smrg 4575dfecf96Smrg/* 4585dfecf96Smrg * Implementation 4595dfecf96Smrg */ 4605dfecf96Smrgstatic void 4615dfecf96Smrgfatal_error(int num) 4625dfecf96Smrg{ 46331de2854Smrg LispDestroy("%s", fatal_error_strings[num]); 4645dfecf96Smrg} 4655dfecf96Smrg 4665dfecf96Smrgstatic void 4675dfecf96Smrgfatal_object_error(LispObj *obj, int num) 4685dfecf96Smrg{ 4695dfecf96Smrg LispDestroy("%s %s", STROBJ(obj), fatal_object_error_strings[num]); 4705dfecf96Smrg} 4715dfecf96Smrg 4725dfecf96Smrgstatic void 4735dfecf96Smrgfatal_builtin_object_error(LispBuiltin *builtin, LispObj *obj, int num) 4745dfecf96Smrg{ 4755dfecf96Smrg LispDestroy("%s: %s %s", STRFUN(builtin), STROBJ(obj), 4765dfecf96Smrg fatal_object_error_strings[num]); 4775dfecf96Smrg} 4785dfecf96Smrg 4795dfecf96Smrgstatic void 4805dfecf96Smrgnumber_init(void) 4815dfecf96Smrg{ 4825dfecf96Smrg zero.type = one.type = two.type = N_FIXNUM; 4835dfecf96Smrg zero.data.fixnum = 0; 4845dfecf96Smrg one.data.fixnum = 1; 4855dfecf96Smrg two.data.fixnum = 2; 4865dfecf96Smrg} 4875dfecf96Smrg 4885dfecf96Smrgstatic double 4895dfecf96Smrgbi_getd(mpi *bignum) 4905dfecf96Smrg{ 4915dfecf96Smrg double value = mpi_getd(bignum); 4925dfecf96Smrg 4935dfecf96Smrg if (!finite(value)) 4945dfecf96Smrg fatal_error(FLOATING_POINT_EXCEPTION); 4955dfecf96Smrg 4965dfecf96Smrg return (value); 4975dfecf96Smrg} 4985dfecf96Smrg 4995dfecf96Smrgstatic double 5005dfecf96Smrgbr_getd(mpr *bigratio) 5015dfecf96Smrg{ 5025dfecf96Smrg double value = mpr_getd(bigratio); 5035dfecf96Smrg 5045dfecf96Smrg if (!finite(value)) 5055dfecf96Smrg fatal_error(FLOATING_POINT_EXCEPTION); 5065dfecf96Smrg 5075dfecf96Smrg return (value); 5085dfecf96Smrg} 5095dfecf96Smrg 5105dfecf96Smrgstatic LispObj * 5115dfecf96Smrgnumber_pi(void) 5125dfecf96Smrg{ 5135dfecf96Smrg LispObj *result; 5145dfecf96Smrg#ifndef M_PI 5155dfecf96Smrg#define M_PI 3.14159265358979323846 5165dfecf96Smrg#endif 5175dfecf96Smrg result = DFLOAT(M_PI); 5185dfecf96Smrg 5195dfecf96Smrg return (result); 5205dfecf96Smrg} 5215dfecf96Smrg 5225dfecf96Smrgstatic void 5235dfecf96Smrgset_real_real(n_real *real, n_real *val) 5245dfecf96Smrg{ 5255dfecf96Smrg switch (RTYPE(real) = RTYPE(val)) { 5265dfecf96Smrg case N_FIXNUM: 5275dfecf96Smrg RFI(real) = RFI(val); 5285dfecf96Smrg break; 5295dfecf96Smrg case N_BIGNUM: 5305dfecf96Smrg RBI(real) = XALLOC(mpi); 5315dfecf96Smrg mpi_init(RBI(real)); 5325dfecf96Smrg mpi_set(RBI(real), RBI(val)); 5335dfecf96Smrg break; 5345dfecf96Smrg case N_FLONUM: 5355dfecf96Smrg RFF(real) = RFF(val); 5365dfecf96Smrg break; 5375dfecf96Smrg case N_FIXRATIO: 5385dfecf96Smrg RFRN(real) = RFRN(val); 5395dfecf96Smrg RFRD(real) = RFRD(val); 5405dfecf96Smrg break; 5415dfecf96Smrg case N_BIGRATIO: 5425dfecf96Smrg RBR(real) = XALLOC(mpr); 5435dfecf96Smrg mpr_init(RBR(real)); 5445dfecf96Smrg mpr_set(RBR(real), RBR(val)); 5455dfecf96Smrg break; 5465dfecf96Smrg } 5475dfecf96Smrg} 5485dfecf96Smrg 5495dfecf96Smrgstatic void 5505dfecf96Smrgset_real_object(n_real *real, LispObj *obj) 5515dfecf96Smrg{ 5525dfecf96Smrg switch (OBJECT_TYPE(obj)) { 5535dfecf96Smrg case LispFixnum_t: 5545dfecf96Smrg RTYPE(real) = N_FIXNUM; 5555dfecf96Smrg RFI(real) = OFI(obj); 5565dfecf96Smrg break; 5575dfecf96Smrg case LispInteger_t: 5585dfecf96Smrg RTYPE(real) = N_FIXNUM; 5595dfecf96Smrg RFI(real) = OII(obj); 5605dfecf96Smrg break; 5615dfecf96Smrg case LispBignum_t: 5625dfecf96Smrg RTYPE(real) = N_BIGNUM; 5635dfecf96Smrg RBI(real) = XALLOC(mpi); 5645dfecf96Smrg mpi_init(RBI(real)); 5655dfecf96Smrg mpi_set(RBI(real), OBI(obj)); 5665dfecf96Smrg break; 5675dfecf96Smrg case LispDFloat_t: 5685dfecf96Smrg RTYPE(real) = N_FLONUM; 5695dfecf96Smrg RFF(real) = ODF(obj); 5705dfecf96Smrg break; 5715dfecf96Smrg case LispRatio_t: 5725dfecf96Smrg RTYPE(real) = N_FIXRATIO; 5735dfecf96Smrg RFRN(real) = OFRN(obj); 5745dfecf96Smrg RFRD(real) = OFRD(obj); 5755dfecf96Smrg break; 5765dfecf96Smrg case LispBigratio_t: 5775dfecf96Smrg RTYPE(real) = N_BIGRATIO; 5785dfecf96Smrg RBR(real) = XALLOC(mpr); 5795dfecf96Smrg mpr_init(RBR(real)); 5805dfecf96Smrg mpr_set(RBR(real), OBR(obj)); 5815dfecf96Smrg break; 5825dfecf96Smrg default: 5835dfecf96Smrg fatal_object_error(obj, NOT_A_REAL_NUMBER); 5845dfecf96Smrg break; 5855dfecf96Smrg } 5865dfecf96Smrg} 5875dfecf96Smrg 5885dfecf96Smrgstatic void 5895dfecf96Smrgset_number_object(n_number *num, LispObj *obj) 5905dfecf96Smrg{ 5915dfecf96Smrg switch (OBJECT_TYPE(obj)) { 5925dfecf96Smrg case LispFixnum_t: 5935dfecf96Smrg num->complex = 0; 5945dfecf96Smrg NRTYPE(num) = N_FIXNUM; 5955dfecf96Smrg NRFI(num) = OFI(obj); 5965dfecf96Smrg break; 5975dfecf96Smrg case LispInteger_t: 5985dfecf96Smrg num->complex = 0; 5995dfecf96Smrg NRTYPE(num) = N_FIXNUM; 6005dfecf96Smrg NRFI(num) = OII(obj); 6015dfecf96Smrg break; 6025dfecf96Smrg case LispBignum_t: 6035dfecf96Smrg num->complex = 0; 6045dfecf96Smrg NRTYPE(num) = N_BIGNUM; 6055dfecf96Smrg NRBI(num) = XALLOC(mpi); 6065dfecf96Smrg mpi_init(NRBI(num)); 6075dfecf96Smrg mpi_set(NRBI(num), OBI(obj)); 6085dfecf96Smrg break; 6095dfecf96Smrg case LispDFloat_t: 6105dfecf96Smrg num->complex = 0; 6115dfecf96Smrg NRTYPE(num) = N_FLONUM; 6125dfecf96Smrg NRFF(num) = ODF(obj); 6135dfecf96Smrg break; 6145dfecf96Smrg case LispRatio_t: 6155dfecf96Smrg num->complex = 0; 6165dfecf96Smrg NRTYPE(num) = N_FIXRATIO; 6175dfecf96Smrg NRFRN(num) = OFRN(obj); 6185dfecf96Smrg NRFRD(num) = OFRD(obj); 6195dfecf96Smrg break; 6205dfecf96Smrg case LispBigratio_t: 6215dfecf96Smrg num->complex = 0; 6225dfecf96Smrg NRTYPE(num) = N_BIGRATIO; 6235dfecf96Smrg NRBR(num) = XALLOC(mpr); 6245dfecf96Smrg mpr_init(NRBR(num)); 6255dfecf96Smrg mpr_set(NRBR(num), OBR(obj)); 6265dfecf96Smrg break; 6275dfecf96Smrg case LispComplex_t: 6285dfecf96Smrg num->complex = 1; 6295dfecf96Smrg set_real_object(NREAL(num), OCXR(obj)); 6305dfecf96Smrg set_real_object(NIMAG(num), OCXI(obj)); 6315dfecf96Smrg break; 6325dfecf96Smrg default: 6335dfecf96Smrg fatal_object_error(obj, NOT_A_NUMBER); 6345dfecf96Smrg break; 6355dfecf96Smrg } 6365dfecf96Smrg} 6375dfecf96Smrg 6385dfecf96Smrgstatic void 6395dfecf96Smrgclear_real(n_real *real) 6405dfecf96Smrg{ 6415dfecf96Smrg if (RTYPE(real) == N_BIGNUM) { 6425dfecf96Smrg mpi_clear(RBI(real)); 6435dfecf96Smrg XFREE(RBI(real)); 6445dfecf96Smrg } 6455dfecf96Smrg else if (RTYPE(real) == N_BIGRATIO) { 6465dfecf96Smrg mpr_clear(RBR(real)); 6475dfecf96Smrg XFREE(RBR(real)); 6485dfecf96Smrg } 6495dfecf96Smrg} 6505dfecf96Smrg 6515dfecf96Smrgstatic void 6525dfecf96Smrgclear_number(n_number *num) 6535dfecf96Smrg{ 6545dfecf96Smrg clear_real(NREAL(num)); 6555dfecf96Smrg if (num->complex) 6565dfecf96Smrg clear_real(NIMAG(num)); 6575dfecf96Smrg} 6585dfecf96Smrg 6595dfecf96Smrgstatic LispObj * 6605dfecf96Smrgmake_real_object(n_real *real) 6615dfecf96Smrg{ 6625dfecf96Smrg LispObj *obj; 6635dfecf96Smrg 6645dfecf96Smrg switch (RTYPE(real)) { 6655dfecf96Smrg case N_FIXNUM: 6665dfecf96Smrg if (RFI(real) > MOST_POSITIVE_FIXNUM || 6675dfecf96Smrg RFI(real) < MOST_NEGATIVE_FIXNUM) { 6685dfecf96Smrg obj = LispNew(NIL, NIL); 6695dfecf96Smrg obj->type = LispInteger_t; 6705dfecf96Smrg OII(obj) = RFI(real); 6715dfecf96Smrg } 6725dfecf96Smrg else 6735dfecf96Smrg obj = FIXNUM(RFI(real)); 6745dfecf96Smrg break; 6755dfecf96Smrg case N_BIGNUM: 6765dfecf96Smrg obj = BIGNUM(RBI(real)); 6775dfecf96Smrg break; 6785dfecf96Smrg case N_FLONUM: 6795dfecf96Smrg obj = DFLOAT(RFF(real)); 6805dfecf96Smrg break; 6815dfecf96Smrg case N_FIXRATIO: 6825dfecf96Smrg obj = LispNew(NIL, NIL); 6835dfecf96Smrg obj->type = LispRatio_t; 6845dfecf96Smrg OFRN(obj) = RFRN(real); 6855dfecf96Smrg OFRD(obj) = RFRD(real); 6865dfecf96Smrg break; 6875dfecf96Smrg case N_BIGRATIO: 6885dfecf96Smrg obj = BIGRATIO(RBR(real)); 6895dfecf96Smrg break; 6905dfecf96Smrg default: 6915dfecf96Smrg obj = NIL; 6925dfecf96Smrg break; 6935dfecf96Smrg } 6945dfecf96Smrg 6955dfecf96Smrg return (obj); 6965dfecf96Smrg} 6975dfecf96Smrg 6985dfecf96Smrgstatic LispObj * 6995dfecf96Smrgmake_number_object(n_number *num) 7005dfecf96Smrg{ 7015dfecf96Smrg LispObj *obj; 7025dfecf96Smrg 7035dfecf96Smrg if (num->complex) { 7045dfecf96Smrg GC_ENTER(); 7055dfecf96Smrg 7065dfecf96Smrg obj = LispNew(NIL, NIL); 7075dfecf96Smrg GC_PROTECT(obj); 7085dfecf96Smrg OCXI(obj) = NIL; 7095dfecf96Smrg obj->type = LispComplex_t; 7105dfecf96Smrg OCXR(obj) = make_real_object(NREAL(num)); 7115dfecf96Smrg OCXI(obj) = make_real_object(NIMAG(num)); 7125dfecf96Smrg GC_LEAVE(); 7135dfecf96Smrg } 7145dfecf96Smrg else { 7155dfecf96Smrg switch (NRTYPE(num)) { 7165dfecf96Smrg case N_FIXNUM: 7175dfecf96Smrg if (NRFI(num) > MOST_POSITIVE_FIXNUM || 7185dfecf96Smrg NRFI(num) < MOST_NEGATIVE_FIXNUM) { 7195dfecf96Smrg obj = LispNew(NIL, NIL); 7205dfecf96Smrg obj->type = LispInteger_t; 7215dfecf96Smrg OII(obj) = NRFI(num); 7225dfecf96Smrg } 7235dfecf96Smrg else 7245dfecf96Smrg obj = FIXNUM(NRFI(num)); 7255dfecf96Smrg break; 7265dfecf96Smrg case N_BIGNUM: 7275dfecf96Smrg obj = BIGNUM(NRBI(num)); 7285dfecf96Smrg break; 7295dfecf96Smrg case N_FLONUM: 7305dfecf96Smrg obj = DFLOAT(NRFF(num)); 7315dfecf96Smrg break; 7325dfecf96Smrg case N_FIXRATIO: 7335dfecf96Smrg obj = LispNew(NIL, NIL); 7345dfecf96Smrg obj->type = LispRatio_t; 7355dfecf96Smrg OFRN(obj) = NRFRN(num); 7365dfecf96Smrg OFRD(obj) = NRFRD(num); 7375dfecf96Smrg break; 7385dfecf96Smrg case N_BIGRATIO: 7395dfecf96Smrg obj = BIGRATIO(NRBR(num)); 7405dfecf96Smrg break; 7415dfecf96Smrg default: 7425dfecf96Smrg obj = NIL; 7435dfecf96Smrg break; 7445dfecf96Smrg } 7455dfecf96Smrg } 7465dfecf96Smrg 7475dfecf96Smrg return (obj); 7485dfecf96Smrg} 7495dfecf96Smrg 7505dfecf96Smrg#define DEFOP_REAL_REAL(OP) \ 7515dfecf96SmrgOP##_real_real(n_real *real, n_real *val) \ 7525dfecf96Smrg{ \ 7535dfecf96Smrg switch (RTYPE(real)) { \ 7545dfecf96Smrg case N_FIXNUM: \ 7555dfecf96Smrg switch (RTYPE(val)) { \ 7565dfecf96Smrg case N_FIXNUM: \ 7575dfecf96Smrg r##OP##_fi_fi(real, RFI(val)); \ 7585dfecf96Smrg break; \ 7595dfecf96Smrg case N_BIGNUM: \ 7605dfecf96Smrg r##OP##_fi_bi(real, RBI(val)); \ 7615dfecf96Smrg break; \ 7625dfecf96Smrg case N_FLONUM: \ 7635dfecf96Smrg r##OP##_flonum(real, (double)RFI(real), RFF(val)); \ 7645dfecf96Smrg break; \ 7655dfecf96Smrg case N_FIXRATIO: \ 7665dfecf96Smrg r##OP##_fi_fr(real, RFRN(val), RFRD(val)); \ 7675dfecf96Smrg break; \ 7685dfecf96Smrg case N_BIGRATIO: \ 7695dfecf96Smrg r##OP##_fi_br(real, RBR(val)); \ 7705dfecf96Smrg break; \ 7715dfecf96Smrg } \ 7725dfecf96Smrg break; \ 7735dfecf96Smrg case N_BIGNUM: \ 7745dfecf96Smrg switch (RTYPE(val)) { \ 7755dfecf96Smrg case N_FIXNUM: \ 7765dfecf96Smrg r##OP##_bi_fi(real, RFI(val)); \ 7775dfecf96Smrg break; \ 7785dfecf96Smrg case N_BIGNUM: \ 7795dfecf96Smrg r##OP##_bi_bi(real, RBI(val)); \ 7805dfecf96Smrg break; \ 7815dfecf96Smrg case N_FLONUM: \ 7825dfecf96Smrg r##OP##_flonum(real, bi_getd(RBI(real)), RFF(val)); \ 7835dfecf96Smrg break; \ 7845dfecf96Smrg case N_FIXRATIO: \ 7855dfecf96Smrg r##OP##_bi_fr(real, RFRN(val), RFRD(val)); \ 7865dfecf96Smrg break; \ 7875dfecf96Smrg case N_BIGRATIO: \ 7885dfecf96Smrg r##OP##_bi_br(real, RBR(val)); \ 7895dfecf96Smrg break; \ 7905dfecf96Smrg } \ 7915dfecf96Smrg break; \ 7925dfecf96Smrg case N_FLONUM: \ 7935dfecf96Smrg switch (RTYPE(val)) { \ 7945dfecf96Smrg case N_FIXNUM: \ 7955dfecf96Smrg r##OP##_flonum(real, RFF(real), (double)RFI(val)); \ 7965dfecf96Smrg break; \ 7975dfecf96Smrg case N_BIGNUM: \ 7985dfecf96Smrg r##OP##_flonum(real, RFF(real), bi_getd(RBI(val))); \ 7995dfecf96Smrg break; \ 8005dfecf96Smrg case N_FLONUM: \ 8015dfecf96Smrg r##OP##_flonum(real, RFF(real), RFF(val)); \ 8025dfecf96Smrg break; \ 8035dfecf96Smrg case N_FIXRATIO: \ 8045dfecf96Smrg r##OP##_flonum(real, RFF(real), \ 8055dfecf96Smrg (double)RFRN(val) / (double)RFRD(val));\ 8065dfecf96Smrg break; \ 8075dfecf96Smrg case N_BIGRATIO: \ 8085dfecf96Smrg r##OP##_flonum(real, RFF(real), br_getd(RBR(val))); \ 8095dfecf96Smrg break; \ 8105dfecf96Smrg } \ 8115dfecf96Smrg break; \ 8125dfecf96Smrg case N_FIXRATIO: \ 8135dfecf96Smrg switch (RTYPE(val)) { \ 8145dfecf96Smrg case N_FIXNUM: \ 8155dfecf96Smrg r##OP##_fr_fi(real, RFI(val)); \ 8165dfecf96Smrg break; \ 8175dfecf96Smrg case N_BIGNUM: \ 8185dfecf96Smrg r##OP##_fr_bi(real, RBI(val)); \ 8195dfecf96Smrg break; \ 8205dfecf96Smrg case N_FLONUM: \ 8215dfecf96Smrg r##OP##_flonum(real, \ 8225dfecf96Smrg (double)RFRN(real) / (double)RFRD(real),\ 8235dfecf96Smrg RFF(val)); \ 8245dfecf96Smrg break; \ 8255dfecf96Smrg case N_FIXRATIO: \ 8265dfecf96Smrg r##OP##_fr_fr(real, RFRN(val), RFRD(val)); \ 8275dfecf96Smrg break; \ 8285dfecf96Smrg case N_BIGRATIO: \ 8295dfecf96Smrg r##OP##_fr_br(real, RBR(val)); \ 8305dfecf96Smrg break; \ 8315dfecf96Smrg } \ 8325dfecf96Smrg break; \ 8335dfecf96Smrg case N_BIGRATIO: \ 8345dfecf96Smrg switch (RTYPE(val)) { \ 8355dfecf96Smrg case N_FIXNUM: \ 8365dfecf96Smrg r##OP##_br_fi(real, RFI(val)); \ 8375dfecf96Smrg break; \ 8385dfecf96Smrg case N_BIGNUM: \ 8395dfecf96Smrg r##OP##_br_bi(real, RBI(val)); \ 8405dfecf96Smrg break; \ 8415dfecf96Smrg case N_FLONUM: \ 8425dfecf96Smrg r##OP##_flonum(real, br_getd(RBR(real)), RFF(val)); \ 8435dfecf96Smrg break; \ 8445dfecf96Smrg case N_FIXRATIO: \ 8455dfecf96Smrg r##OP##_br_fr(real, RFRN(val), RFRD(val)); \ 8465dfecf96Smrg break; \ 8475dfecf96Smrg case N_BIGRATIO: \ 8485dfecf96Smrg r##OP##_br_br(real, RBR(val)); \ 8495dfecf96Smrg break; \ 8505dfecf96Smrg } \ 8515dfecf96Smrg break; \ 8525dfecf96Smrg } \ 8535dfecf96Smrg} 8545dfecf96Smrg 8555dfecf96Smrgstatic void 8565dfecf96SmrgDEFOP_REAL_REAL(add) 8575dfecf96Smrg 8585dfecf96Smrgstatic void 8595dfecf96SmrgDEFOP_REAL_REAL(sub) 8605dfecf96Smrg 8615dfecf96Smrgstatic void 8625dfecf96SmrgDEFOP_REAL_REAL(div) 8635dfecf96Smrg 8645dfecf96Smrgstatic void 8655dfecf96SmrgDEFOP_REAL_REAL(mul) 8665dfecf96Smrg 8675dfecf96Smrg 8685dfecf96Smrg#define DEFOP_REAL_OBJECT(OP) \ 8695dfecf96SmrgOP##_real_object(n_real *real, LispObj *obj) \ 8705dfecf96Smrg{ \ 8715dfecf96Smrg switch (OBJECT_TYPE(obj)) { \ 8725dfecf96Smrg case LispFixnum_t: \ 8735dfecf96Smrg switch (RTYPE(real)) { \ 8745dfecf96Smrg case N_FIXNUM: \ 8755dfecf96Smrg r##OP##_fi_fi(real, OFI(obj)); \ 8765dfecf96Smrg break; \ 8775dfecf96Smrg case N_BIGNUM: \ 8785dfecf96Smrg r##OP##_bi_fi(real, OFI(obj)); \ 8795dfecf96Smrg break; \ 8805dfecf96Smrg case N_FLONUM: \ 8815dfecf96Smrg r##OP##_flonum(real, RFF(real), (double)OFI(obj)); \ 8825dfecf96Smrg break; \ 8835dfecf96Smrg case N_FIXRATIO: \ 8845dfecf96Smrg r##OP##_fr_fi(real, OFI(obj)); \ 8855dfecf96Smrg break; \ 8865dfecf96Smrg case N_BIGRATIO: \ 8875dfecf96Smrg r##OP##_br_fi(real, OFI(obj)); \ 8885dfecf96Smrg break; \ 8895dfecf96Smrg } \ 8905dfecf96Smrg break; \ 8915dfecf96Smrg case LispInteger_t: \ 8925dfecf96Smrg switch (RTYPE(real)) { \ 8935dfecf96Smrg case N_FIXNUM: \ 8945dfecf96Smrg r##OP##_fi_fi(real, OII(obj)); \ 8955dfecf96Smrg break; \ 8965dfecf96Smrg case N_BIGNUM: \ 8975dfecf96Smrg r##OP##_bi_fi(real, OII(obj)); \ 8985dfecf96Smrg break; \ 8995dfecf96Smrg case N_FLONUM: \ 9005dfecf96Smrg r##OP##_flonum(real, RFF(real), (double)OII(obj)); \ 9015dfecf96Smrg break; \ 9025dfecf96Smrg case N_FIXRATIO: \ 9035dfecf96Smrg r##OP##_fr_fi(real, OII(obj)); \ 9045dfecf96Smrg break; \ 9055dfecf96Smrg case N_BIGRATIO: \ 9065dfecf96Smrg r##OP##_br_fi(real, OII(obj)); \ 9075dfecf96Smrg break; \ 9085dfecf96Smrg } \ 9095dfecf96Smrg break; \ 9105dfecf96Smrg case LispBignum_t: \ 9115dfecf96Smrg switch (RTYPE(real)) { \ 9125dfecf96Smrg case N_FIXNUM: \ 9135dfecf96Smrg r##OP##_fi_bi(real, OBI(obj)); \ 9145dfecf96Smrg break; \ 9155dfecf96Smrg case N_BIGNUM: \ 9165dfecf96Smrg r##OP##_bi_bi(real, OBI(obj)); \ 9175dfecf96Smrg break; \ 9185dfecf96Smrg case N_FLONUM: \ 9195dfecf96Smrg r##OP##_flonum(real, RFF(real), bi_getd(OBI(obj))); \ 9205dfecf96Smrg break; \ 9215dfecf96Smrg case N_FIXRATIO: \ 9225dfecf96Smrg r##OP##_fr_bi(real, OBI(obj)); \ 9235dfecf96Smrg break; \ 9245dfecf96Smrg case N_BIGRATIO: \ 9255dfecf96Smrg r##OP##_br_bi(real, OBI(obj)); \ 9265dfecf96Smrg break; \ 9275dfecf96Smrg } \ 9285dfecf96Smrg break; \ 9295dfecf96Smrg case LispDFloat_t: \ 9305dfecf96Smrg switch (RTYPE(real)) { \ 9315dfecf96Smrg case N_FIXNUM: \ 9325dfecf96Smrg r##OP##_flonum(real, (double)RFI(real), ODF(obj)); \ 9335dfecf96Smrg break; \ 9345dfecf96Smrg case N_BIGNUM: \ 9355dfecf96Smrg r##OP##_flonum(real, bi_getd(RBI(real)), ODF(obj)); \ 9365dfecf96Smrg break; \ 9375dfecf96Smrg case N_FLONUM: \ 9385dfecf96Smrg r##OP##_flonum(real, RFF(real), ODF(obj)); \ 9395dfecf96Smrg break; \ 9405dfecf96Smrg case N_FIXRATIO: \ 9415dfecf96Smrg r##OP##_flonum(real, \ 9425dfecf96Smrg (double)RFRN(real) / (double)RFRD(real),\ 9435dfecf96Smrg ODF(obj)); \ 9445dfecf96Smrg break; \ 9455dfecf96Smrg case N_BIGRATIO: \ 9465dfecf96Smrg r##OP##_flonum(real, br_getd(RBR(real)), ODF(obj)); \ 9475dfecf96Smrg break; \ 9485dfecf96Smrg } \ 9495dfecf96Smrg break; \ 9505dfecf96Smrg case LispRatio_t: \ 9515dfecf96Smrg switch (RTYPE(real)) { \ 9525dfecf96Smrg case N_FIXNUM: \ 9535dfecf96Smrg r##OP##_fi_fr(real, OFRN(obj), OFRD(obj)); \ 9545dfecf96Smrg break; \ 9555dfecf96Smrg case N_BIGNUM: \ 9565dfecf96Smrg r##OP##_bi_fr(real, OFRN(obj), OFRD(obj)); \ 9575dfecf96Smrg break; \ 9585dfecf96Smrg case N_FLONUM: \ 9595dfecf96Smrg r##OP##_flonum(real, RFF(real), \ 9605dfecf96Smrg (double)OFRN(obj) / (double)OFRD(obj)); \ 9615dfecf96Smrg break; \ 9625dfecf96Smrg case N_FIXRATIO: \ 9635dfecf96Smrg r##OP##_fr_fr(real, OFRN(obj), OFRD(obj)); \ 9645dfecf96Smrg break; \ 9655dfecf96Smrg case N_BIGRATIO: \ 9665dfecf96Smrg r##OP##_br_fr(real, OFRN(obj), OFRD(obj)); \ 9675dfecf96Smrg break; \ 9685dfecf96Smrg } \ 9695dfecf96Smrg break; \ 9705dfecf96Smrg case LispBigratio_t: \ 9715dfecf96Smrg switch (RTYPE(real)) { \ 9725dfecf96Smrg case N_FIXNUM: \ 9735dfecf96Smrg r##OP##_fi_br(real, OBR(obj)); \ 9745dfecf96Smrg break; \ 9755dfecf96Smrg case N_BIGNUM: \ 9765dfecf96Smrg r##OP##_bi_br(real, OBR(obj)); \ 9775dfecf96Smrg break; \ 9785dfecf96Smrg case N_FLONUM: \ 9795dfecf96Smrg r##OP##_flonum(real, RFF(real), br_getd(OBR(obj))); \ 9805dfecf96Smrg break; \ 9815dfecf96Smrg case N_FIXRATIO: \ 9825dfecf96Smrg r##OP##_fr_br(real, OBR(obj)); \ 9835dfecf96Smrg break; \ 9845dfecf96Smrg case N_BIGRATIO: \ 9855dfecf96Smrg r##OP##_br_br(real, OBR(obj)); \ 9865dfecf96Smrg break; \ 9875dfecf96Smrg } \ 9885dfecf96Smrg break; \ 9895dfecf96Smrg default: \ 9905dfecf96Smrg fatal_object_error(obj, NOT_A_REAL_NUMBER); \ 9915dfecf96Smrg break; \ 9925dfecf96Smrg } \ 9935dfecf96Smrg} 9945dfecf96Smrg 9955dfecf96Smrgstatic void 9965dfecf96SmrgDEFOP_REAL_OBJECT(add) 9975dfecf96Smrg 9985dfecf96Smrgstatic void 9995dfecf96SmrgDEFOP_REAL_OBJECT(sub) 10005dfecf96Smrg 10015dfecf96Smrgstatic void 10025dfecf96SmrgDEFOP_REAL_OBJECT(div) 10035dfecf96Smrg 10045dfecf96Smrgstatic void 10055dfecf96SmrgDEFOP_REAL_OBJECT(mul) 10065dfecf96Smrg 10075dfecf96Smrg 10085dfecf96Smrg#define DEFOP_NUMBER_OBJECT(OP) \ 10095dfecf96SmrgOP##_number_object(n_number *num, LispObj *obj) \ 10105dfecf96Smrg{ \ 10115dfecf96Smrg if (num->complex) { \ 10125dfecf96Smrg switch (OBJECT_TYPE(obj)) { \ 10135dfecf96Smrg case LispFixnum_t: \ 10145dfecf96Smrg case LispInteger_t: \ 10155dfecf96Smrg case LispBignum_t: \ 10165dfecf96Smrg case LispDFloat_t: \ 10175dfecf96Smrg case LispRatio_t: \ 10185dfecf96Smrg case LispBigratio_t: \ 10195dfecf96Smrg n##OP##_cx_re(num, obj); \ 10205dfecf96Smrg break; \ 10215dfecf96Smrg case LispComplex_t: \ 10225dfecf96Smrg n##OP##_cx_cx(num, obj); \ 10235dfecf96Smrg break; \ 10245dfecf96Smrg default: \ 10255dfecf96Smrg fatal_object_error(obj, NOT_A_NUMBER); \ 10265dfecf96Smrg break; \ 10275dfecf96Smrg } \ 10285dfecf96Smrg } \ 10295dfecf96Smrg else { \ 10305dfecf96Smrg switch (OBJECT_TYPE(obj)) { \ 10315dfecf96Smrg case LispFixnum_t: \ 10325dfecf96Smrg switch (NRTYPE(num)) { \ 10335dfecf96Smrg case N_FIXNUM: \ 10345dfecf96Smrg r##OP##_fi_fi(NREAL(num), OFI(obj)); \ 10355dfecf96Smrg break; \ 10365dfecf96Smrg case N_BIGNUM: \ 10375dfecf96Smrg r##OP##_bi_fi(NREAL(num), OFI(obj)); \ 10385dfecf96Smrg break; \ 10395dfecf96Smrg case N_FLONUM: \ 10405dfecf96Smrg r##OP##_flonum(NREAL(num), NRFF(num), \ 10415dfecf96Smrg (double)OFI(obj)); \ 10425dfecf96Smrg break; \ 10435dfecf96Smrg case N_FIXRATIO: \ 10445dfecf96Smrg r##OP##_fr_fi(NREAL(num), OFI(obj)); \ 10455dfecf96Smrg break; \ 10465dfecf96Smrg case N_BIGRATIO: \ 10475dfecf96Smrg r##OP##_br_fi(NREAL(num), OFI(obj)); \ 10485dfecf96Smrg break; \ 10495dfecf96Smrg } \ 10505dfecf96Smrg break; \ 10515dfecf96Smrg case LispInteger_t: \ 10525dfecf96Smrg switch (NRTYPE(num)) { \ 10535dfecf96Smrg case N_FIXNUM: \ 10545dfecf96Smrg r##OP##_fi_fi(NREAL(num), OII(obj)); \ 10555dfecf96Smrg break; \ 10565dfecf96Smrg case N_BIGNUM: \ 10575dfecf96Smrg r##OP##_bi_fi(NREAL(num), OII(obj)); \ 10585dfecf96Smrg break; \ 10595dfecf96Smrg case N_FLONUM: \ 10605dfecf96Smrg r##OP##_flonum(NREAL(num), NRFF(num), \ 10615dfecf96Smrg (double)OII(obj)); \ 10625dfecf96Smrg break; \ 10635dfecf96Smrg case N_FIXRATIO: \ 10645dfecf96Smrg r##OP##_fr_fi(NREAL(num), OII(obj)); \ 10655dfecf96Smrg break; \ 10665dfecf96Smrg case N_BIGRATIO: \ 10675dfecf96Smrg r##OP##_br_fi(NREAL(num), OII(obj)); \ 10685dfecf96Smrg break; \ 10695dfecf96Smrg } \ 10705dfecf96Smrg break; \ 10715dfecf96Smrg case LispBignum_t: \ 10725dfecf96Smrg switch (NRTYPE(num)) { \ 10735dfecf96Smrg case N_FIXNUM: \ 10745dfecf96Smrg r##OP##_fi_bi(NREAL(num), OBI(obj)); \ 10755dfecf96Smrg break; \ 10765dfecf96Smrg case N_BIGNUM: \ 10775dfecf96Smrg r##OP##_bi_bi(NREAL(num), OBI(obj)); \ 10785dfecf96Smrg break; \ 10795dfecf96Smrg case N_FLONUM: \ 10805dfecf96Smrg r##OP##_flonum(NREAL(num), NRFF(num), \ 10815dfecf96Smrg bi_getd(OBI(obj))); \ 10825dfecf96Smrg break; \ 10835dfecf96Smrg case N_FIXRATIO: \ 10845dfecf96Smrg r##OP##_fr_bi(NREAL(num), OBI(obj)); \ 10855dfecf96Smrg break; \ 10865dfecf96Smrg case N_BIGRATIO: \ 10875dfecf96Smrg r##OP##_br_bi(NREAL(num), OBI(obj)); \ 10885dfecf96Smrg break; \ 10895dfecf96Smrg } \ 10905dfecf96Smrg break; \ 10915dfecf96Smrg case LispDFloat_t: \ 10925dfecf96Smrg switch (NRTYPE(num)) { \ 10935dfecf96Smrg case N_FIXNUM: \ 10945dfecf96Smrg r##OP##_flonum(NREAL(num), (double)NRFI(num), \ 10955dfecf96Smrg ODF(obj)); \ 10965dfecf96Smrg break; \ 10975dfecf96Smrg case N_BIGNUM: \ 10985dfecf96Smrg r##OP##_flonum(NREAL(num), bi_getd(NRBI(num)), \ 10995dfecf96Smrg ODF(obj)); \ 11005dfecf96Smrg break; \ 11015dfecf96Smrg case N_FLONUM: \ 11025dfecf96Smrg r##OP##_flonum(NREAL(num), NRFF(num), ODF(obj));\ 11035dfecf96Smrg break; \ 11045dfecf96Smrg case N_FIXRATIO: \ 11055dfecf96Smrg r##OP##_flonum(NREAL(num), \ 11065dfecf96Smrg (double)NRFRN(num) / \ 11075dfecf96Smrg (double)NRFRD(num), \ 11085dfecf96Smrg ODF(obj)); \ 11095dfecf96Smrg break; \ 11105dfecf96Smrg case N_BIGRATIO: \ 11115dfecf96Smrg r##OP##_flonum(NREAL(num), br_getd(NRBR(num)), \ 11125dfecf96Smrg ODF(obj)); \ 11135dfecf96Smrg break; \ 11145dfecf96Smrg } \ 11155dfecf96Smrg break; \ 11165dfecf96Smrg case LispRatio_t: \ 11175dfecf96Smrg switch (NRTYPE(num)) { \ 11185dfecf96Smrg case N_FIXNUM: \ 11195dfecf96Smrg r##OP##_fi_fr(NREAL(num), OFRN(obj), OFRD(obj));\ 11205dfecf96Smrg break; \ 11215dfecf96Smrg case N_BIGNUM: \ 11225dfecf96Smrg r##OP##_bi_fr(NREAL(num), OFRN(obj), OFRD(obj));\ 11235dfecf96Smrg break; \ 11245dfecf96Smrg case N_FLONUM: \ 11255dfecf96Smrg r##OP##_flonum(NREAL(num), NRFF(num), \ 11265dfecf96Smrg (double)OFRN(obj) / \ 11275dfecf96Smrg (double)OFRD(obj)); \ 11285dfecf96Smrg break; \ 11295dfecf96Smrg case N_FIXRATIO: \ 11305dfecf96Smrg r##OP##_fr_fr(NREAL(num), OFRN(obj), OFRD(obj));\ 11315dfecf96Smrg break; \ 11325dfecf96Smrg case N_BIGRATIO: \ 11335dfecf96Smrg r##OP##_br_fr(NREAL(num), OFRN(obj), OFRD(obj));\ 11345dfecf96Smrg break; \ 11355dfecf96Smrg } \ 11365dfecf96Smrg break; \ 11375dfecf96Smrg case LispBigratio_t: \ 11385dfecf96Smrg switch (NRTYPE(num)) { \ 11395dfecf96Smrg case N_FIXNUM: \ 11405dfecf96Smrg r##OP##_fi_br(NREAL(num), OBR(obj)); \ 11415dfecf96Smrg break; \ 11425dfecf96Smrg case N_BIGNUM: \ 11435dfecf96Smrg r##OP##_bi_br(NREAL(num), OBR(obj)); \ 11445dfecf96Smrg break; \ 11455dfecf96Smrg case N_FLONUM: \ 11465dfecf96Smrg r##OP##_flonum(NREAL(num), NRFF(num), \ 11475dfecf96Smrg br_getd(OBR(obj))); \ 11485dfecf96Smrg break; \ 11495dfecf96Smrg case N_FIXRATIO: \ 11505dfecf96Smrg r##OP##_fr_br(NREAL(num), OBR(obj)); \ 11515dfecf96Smrg break; \ 11525dfecf96Smrg case N_BIGRATIO: \ 11535dfecf96Smrg r##OP##_br_br(NREAL(num), OBR(obj)); \ 11545dfecf96Smrg break; \ 11555dfecf96Smrg } \ 11565dfecf96Smrg break; \ 11575dfecf96Smrg case LispComplex_t: \ 11585dfecf96Smrg n##OP##_re_cx(num, obj); \ 11595dfecf96Smrg break; \ 11605dfecf96Smrg default: \ 11615dfecf96Smrg fatal_object_error(obj, NOT_A_NUMBER); \ 11625dfecf96Smrg break; \ 11635dfecf96Smrg } \ 11645dfecf96Smrg } \ 11655dfecf96Smrg} 11665dfecf96Smrg 11675dfecf96Smrgstatic void 11685dfecf96SmrgDEFOP_NUMBER_OBJECT(add) 11695dfecf96Smrg 11705dfecf96Smrgstatic void 11715dfecf96SmrgDEFOP_NUMBER_OBJECT(sub) 11725dfecf96Smrg 11735dfecf96Smrgstatic void 11745dfecf96SmrgDEFOP_NUMBER_OBJECT(div) 11755dfecf96Smrg 11765dfecf96Smrgstatic void 11775dfecf96SmrgDEFOP_NUMBER_OBJECT(mul) 11785dfecf96Smrg 11795dfecf96Smrg 11805dfecf96Smrg/************************************************************************ 11815dfecf96Smrg * ABS 11825dfecf96Smrg ************************************************************************/ 11835dfecf96Smrgstatic void 11845dfecf96Smrgabs_real(n_real *real) 11855dfecf96Smrg{ 11865dfecf96Smrg switch (RTYPE(real)) { 11875dfecf96Smrg case N_FIXNUM: rabs_fi(real); break; 11885dfecf96Smrg case N_BIGNUM: rabs_bi(real); break; 11895dfecf96Smrg case N_FLONUM: rabs_ff(real); break; 11905dfecf96Smrg case N_FIXRATIO: rabs_fr(real); break; 11915dfecf96Smrg case N_BIGRATIO: rabs_br(real); break; 11925dfecf96Smrg } 11935dfecf96Smrg} 11945dfecf96Smrg 11955dfecf96Smrgstatic void 11965dfecf96Smrgabs_number(n_number *num) 11975dfecf96Smrg{ 11985dfecf96Smrg if (num->complex) 11995dfecf96Smrg nabs_cx(num); 12005dfecf96Smrg else { 12015dfecf96Smrg switch (NRTYPE(num)) { 12025dfecf96Smrg case N_FIXNUM: rabs_fi(NREAL(num)); break; 12035dfecf96Smrg case N_BIGNUM: rabs_bi(NREAL(num)); break; 12045dfecf96Smrg case N_FLONUM: rabs_ff(NREAL(num)); break; 12055dfecf96Smrg case N_FIXRATIO: rabs_fr(NREAL(num)); break; 12065dfecf96Smrg case N_BIGRATIO: rabs_br(NREAL(num)); break; 12075dfecf96Smrg } 12085dfecf96Smrg } 12095dfecf96Smrg} 12105dfecf96Smrg 12115dfecf96Smrgstatic void 12125dfecf96Smrgnabs_cx(n_number *num) 12135dfecf96Smrg{ 12145dfecf96Smrg n_real temp; 12155dfecf96Smrg 12165dfecf96Smrg abs_real(NREAL(num)); 12175dfecf96Smrg abs_real(NIMAG(num)); 12185dfecf96Smrg 12195dfecf96Smrg if (cmp_real_real(NREAL(num), NIMAG(num)) < 0) { 12205dfecf96Smrg memcpy(&temp, NIMAG(num), sizeof(n_real)); 12215dfecf96Smrg memcpy(NIMAG(num), NREAL(num), sizeof(n_real)); 12225dfecf96Smrg memcpy(NREAL(num), &temp, sizeof(n_real)); 12235dfecf96Smrg } 12245dfecf96Smrg 12255dfecf96Smrg if (cmp_real_real(NIMAG(num), &zero) == 0) { 12265dfecf96Smrg num->complex = 0; 12275dfecf96Smrg if (NITYPE(num) == N_FLONUM) { 12285dfecf96Smrg /* change number type */ 12295dfecf96Smrg temp.type = N_FLONUM; 12305dfecf96Smrg temp.data.flonum = 1.0; 12315dfecf96Smrg mul_real_real(NREAL(num), &temp); 12325dfecf96Smrg } 12335dfecf96Smrg else 12345dfecf96Smrg clear_real(NIMAG(num)); 12355dfecf96Smrg } 12365dfecf96Smrg else { 12375dfecf96Smrg div_real_real(NIMAG(num), NREAL(num)); 12385dfecf96Smrg set_real_real(&temp, NIMAG(num)); 12395dfecf96Smrg mul_real_real(NIMAG(num), &temp); 12405dfecf96Smrg clear_real(&temp); 12415dfecf96Smrg 12425dfecf96Smrg add_real_real(NIMAG(num), &one); 12435dfecf96Smrg sqrt_real(NIMAG(num)); 12445dfecf96Smrg 12455dfecf96Smrg mul_real_real(NIMAG(num), NREAL(num)); 12465dfecf96Smrg clear_real(NREAL(num)); 12475dfecf96Smrg memcpy(NREAL(num), NIMAG(num), sizeof(n_real)); 12485dfecf96Smrg num->complex = 0; 12495dfecf96Smrg } 12505dfecf96Smrg} 12515dfecf96Smrg 12525dfecf96Smrgstatic INLINE void 12535dfecf96Smrgrabs_fi(n_real *real) 12545dfecf96Smrg{ 12555dfecf96Smrg if (RFI(real) < 0) 12565dfecf96Smrg rneg_fi(real); 12575dfecf96Smrg} 12585dfecf96Smrg 12595dfecf96Smrgstatic INLINE void 12605dfecf96Smrgrabs_bi(n_real *real) 12615dfecf96Smrg{ 12625dfecf96Smrg if (mpi_cmpi(RBI(real), 0) < 0) 12635dfecf96Smrg mpi_neg(RBI(real), RBI(real)); 12645dfecf96Smrg} 12655dfecf96Smrg 12665dfecf96Smrgstatic INLINE void 12675dfecf96Smrgrabs_ff(n_real *real) 12685dfecf96Smrg{ 12695dfecf96Smrg if (RFF(real) < 0.0) 12705dfecf96Smrg RFF(real) = -RFF(real); 12715dfecf96Smrg} 12725dfecf96Smrg 12735dfecf96Smrgstatic INLINE void 12745dfecf96Smrgrabs_fr(n_real *real) 12755dfecf96Smrg{ 12765dfecf96Smrg if (RFRN(real) < 0) 12775dfecf96Smrg rneg_fr(real); 12785dfecf96Smrg} 12795dfecf96Smrg 12805dfecf96Smrgstatic INLINE void 12815dfecf96Smrgrabs_br(n_real *real) 12825dfecf96Smrg{ 12835dfecf96Smrg if (mpi_cmpi(RBRN(real), 0) < 0) 12845dfecf96Smrg mpi_neg(RBRN(real), RBRN(real)); 12855dfecf96Smrg} 12865dfecf96Smrg 12875dfecf96Smrg 12885dfecf96Smrg/************************************************************************ 12895dfecf96Smrg * NEG 12905dfecf96Smrg ************************************************************************/ 12915dfecf96Smrgstatic void 12925dfecf96Smrgneg_real(n_real *real) 12935dfecf96Smrg{ 12945dfecf96Smrg switch (RTYPE(real)) { 12955dfecf96Smrg case N_FIXNUM: rneg_fi(real); break; 12965dfecf96Smrg case N_BIGNUM: rneg_bi(real); break; 12975dfecf96Smrg case N_FLONUM: rneg_ff(real); break; 12985dfecf96Smrg case N_FIXRATIO: rneg_fr(real); break; 12995dfecf96Smrg case N_BIGRATIO: rneg_br(real); break; 13005dfecf96Smrg } 13015dfecf96Smrg} 13025dfecf96Smrg 13035dfecf96Smrgstatic void 13045dfecf96Smrgneg_number(n_number *num) 13055dfecf96Smrg{ 13065dfecf96Smrg if (num->complex) { 13075dfecf96Smrg neg_real(NREAL(num)); 13085dfecf96Smrg neg_real(NIMAG(num)); 13095dfecf96Smrg } 13105dfecf96Smrg else { 13115dfecf96Smrg switch (NRTYPE(num)) { 13125dfecf96Smrg case N_FIXNUM: rneg_fi(NREAL(num)); break; 13135dfecf96Smrg case N_BIGNUM: rneg_bi(NREAL(num)); break; 13145dfecf96Smrg case N_FLONUM: rneg_ff(NREAL(num)); break; 13155dfecf96Smrg case N_FIXRATIO: rneg_fr(NREAL(num)); break; 13165dfecf96Smrg case N_BIGRATIO: rneg_br(NREAL(num)); break; 13175dfecf96Smrg } 13185dfecf96Smrg } 13195dfecf96Smrg} 13205dfecf96Smrg 13215dfecf96Smrgstatic void 13225dfecf96Smrgrneg_fi(n_real *real) 13235dfecf96Smrg{ 13245dfecf96Smrg if (RFI(real) == MINSLONG) { 13255dfecf96Smrg mpi *bigi = XALLOC(mpi); 13265dfecf96Smrg 13275dfecf96Smrg mpi_init(bigi); 13285dfecf96Smrg mpi_seti(bigi, RFI(real)); 13295dfecf96Smrg mpi_neg(bigi, bigi); 13305dfecf96Smrg RTYPE(real) = N_BIGNUM; 13315dfecf96Smrg RBI(real) = bigi; 13325dfecf96Smrg } 13335dfecf96Smrg else 13345dfecf96Smrg RFI(real) = -RFI(real); 13355dfecf96Smrg} 13365dfecf96Smrg 13375dfecf96Smrgstatic INLINE void 13385dfecf96Smrgrneg_bi(n_real *real) 13395dfecf96Smrg{ 13405dfecf96Smrg mpi_neg(RBI(real), RBI(real)); 13415dfecf96Smrg} 13425dfecf96Smrg 13435dfecf96Smrgstatic INLINE void 13445dfecf96Smrgrneg_ff(n_real *real) 13455dfecf96Smrg{ 13465dfecf96Smrg RFF(real) = -RFF(real); 13475dfecf96Smrg} 13485dfecf96Smrg 13495dfecf96Smrgstatic void 13505dfecf96Smrgrneg_fr(n_real *real) 13515dfecf96Smrg{ 13525dfecf96Smrg if (RFRN(real) == MINSLONG) { 13535dfecf96Smrg mpr *bigr = XALLOC(mpr); 13545dfecf96Smrg 13555dfecf96Smrg mpr_init(bigr); 13565dfecf96Smrg mpr_seti(bigr, RFRN(real), RFRD(real)); 13575dfecf96Smrg mpi_neg(mpr_num(bigr), mpr_num(bigr)); 13585dfecf96Smrg RTYPE(real) = N_BIGRATIO; 13595dfecf96Smrg RBR(real) = bigr; 13605dfecf96Smrg } 13615dfecf96Smrg else 13625dfecf96Smrg RFRN(real) = -RFRN(real); 13635dfecf96Smrg} 13645dfecf96Smrg 13655dfecf96Smrgstatic INLINE void 13665dfecf96Smrgrneg_br(n_real *real) 13675dfecf96Smrg{ 13685dfecf96Smrg mpi_neg(RBRN(real), RBRN(real)); 13695dfecf96Smrg} 13705dfecf96Smrg 13715dfecf96Smrg 13725dfecf96Smrg/************************************************************************ 13735dfecf96Smrg * SQRT 13745dfecf96Smrg ************************************************************************/ 13755dfecf96Smrgstatic void 13765dfecf96Smrgsqrt_real(n_real *real) 13775dfecf96Smrg{ 13785dfecf96Smrg switch (RTYPE(real)) { 13795dfecf96Smrg case N_FIXNUM: 13805dfecf96Smrg case N_BIGNUM: 13815dfecf96Smrg rsqrt_xi(real); 13825dfecf96Smrg break; 13835dfecf96Smrg case N_FLONUM: 13845dfecf96Smrg rsqrt_ff(real); 13855dfecf96Smrg break; 13865dfecf96Smrg case N_FIXRATIO: 13875dfecf96Smrg case N_BIGRATIO: 13885dfecf96Smrg rsqrt_xr(real); 13895dfecf96Smrg break; 13905dfecf96Smrg } 13915dfecf96Smrg} 13925dfecf96Smrg 13935dfecf96Smrgstatic void 13945dfecf96Smrgsqrt_number(n_number *num) 13955dfecf96Smrg{ 13965dfecf96Smrg if (num->complex) 13975dfecf96Smrg nsqrt_cx(num); 13985dfecf96Smrg else { 13995dfecf96Smrg switch (NRTYPE(num)) { 14005dfecf96Smrg case N_FIXNUM: 14015dfecf96Smrg case N_BIGNUM: 14025dfecf96Smrg nsqrt_xi(num); 14035dfecf96Smrg break; 14045dfecf96Smrg case N_FLONUM: 14055dfecf96Smrg nsqrt_ff(num); 14065dfecf96Smrg break; 14075dfecf96Smrg case N_FIXRATIO: 14085dfecf96Smrg case N_BIGRATIO: 14095dfecf96Smrg nsqrt_xr(num); 14105dfecf96Smrg break; 14115dfecf96Smrg } 14125dfecf96Smrg } 14135dfecf96Smrg} 14145dfecf96Smrg 14155dfecf96Smrgstatic void 14165dfecf96Smrgrsqrt_xi(n_real *real) 14175dfecf96Smrg{ 14185dfecf96Smrg int exact; 14195dfecf96Smrg mpi bignum; 14205dfecf96Smrg 14215dfecf96Smrg if (cmp_real_real(real, &zero) < 0) 14225dfecf96Smrg fatal_error(FLOATING_POINT_EXCEPTION); 14235dfecf96Smrg 14245dfecf96Smrg mpi_init(&bignum); 14255dfecf96Smrg if (RTYPE(real) == N_BIGNUM) 14265dfecf96Smrg exact = mpi_sqrt(&bignum, RBI(real)); 14275dfecf96Smrg else { 14285dfecf96Smrg mpi tmp; 14295dfecf96Smrg 14305dfecf96Smrg mpi_init(&tmp); 14315dfecf96Smrg mpi_seti(&tmp, RFI(real)); 14325dfecf96Smrg exact = mpi_sqrt(&bignum, &tmp); 14335dfecf96Smrg mpi_clear(&tmp); 14345dfecf96Smrg } 14355dfecf96Smrg if (exact) { 14365dfecf96Smrg if (RTYPE(real) == N_BIGNUM) { 14375dfecf96Smrg mpi_set(RBI(real), &bignum); 14385dfecf96Smrg rbi_canonicalize(real); 14395dfecf96Smrg } 14405dfecf96Smrg else 14415dfecf96Smrg RFI(real) = mpi_geti(&bignum); 14425dfecf96Smrg } 14435dfecf96Smrg else { 14445dfecf96Smrg double value; 14455dfecf96Smrg 14465dfecf96Smrg if (RTYPE(real) == N_BIGNUM) { 14475dfecf96Smrg value = bi_getd(RBI(real)); 14485dfecf96Smrg RCLEAR_BI(real); 14495dfecf96Smrg } 14505dfecf96Smrg else 14515dfecf96Smrg value = (double)RFI(real); 14525dfecf96Smrg 14535dfecf96Smrg value = sqrt(value); 14545dfecf96Smrg RTYPE(real) = N_FLONUM; 14555dfecf96Smrg RFF(real) = value; 14565dfecf96Smrg } 14575dfecf96Smrg mpi_clear(&bignum); 14585dfecf96Smrg} 14595dfecf96Smrg 14605dfecf96Smrgstatic void 14615dfecf96Smrgrsqrt_xr(n_real *real) 14625dfecf96Smrg{ 14635dfecf96Smrg n_real num, den; 14645dfecf96Smrg 14655dfecf96Smrg if (cmp_real_real(real, &zero) < 0) 14665dfecf96Smrg fatal_error(FLOATING_POINT_EXCEPTION); 14675dfecf96Smrg 14685dfecf96Smrg if (RTYPE(real) == N_FIXRATIO) { 14695dfecf96Smrg num.type = den.type = N_FIXNUM; 14705dfecf96Smrg num.data.fixnum = RFRN(real); 14715dfecf96Smrg den.data.fixnum = RFRD(real); 14725dfecf96Smrg } 14735dfecf96Smrg else { 14745dfecf96Smrg mpi *bignum; 14755dfecf96Smrg 14765dfecf96Smrg if (mpi_fiti(RBRN(real))) { 14775dfecf96Smrg num.type = N_FIXNUM; 14785dfecf96Smrg num.data.fixnum = mpi_geti(RBRN(real)); 14795dfecf96Smrg } 14805dfecf96Smrg else { 14815dfecf96Smrg bignum = XALLOC(mpi); 14825dfecf96Smrg mpi_init(bignum); 14835dfecf96Smrg mpi_set(bignum, RBRN(real)); 14845dfecf96Smrg num.type = N_BIGNUM; 14855dfecf96Smrg num.data.bignum = bignum; 14865dfecf96Smrg } 14875dfecf96Smrg 14885dfecf96Smrg if (mpi_fiti(RBRD(real))) { 14895dfecf96Smrg den.type = N_FIXNUM; 14905dfecf96Smrg den.data.fixnum = mpi_geti(RBRD(real)); 14915dfecf96Smrg } 14925dfecf96Smrg else { 14935dfecf96Smrg bignum = XALLOC(mpi); 14945dfecf96Smrg mpi_init(bignum); 14955dfecf96Smrg mpi_set(bignum, RBRD(real)); 14965dfecf96Smrg den.type = N_BIGNUM; 14975dfecf96Smrg den.data.bignum = bignum; 14985dfecf96Smrg } 14995dfecf96Smrg } 15005dfecf96Smrg 15015dfecf96Smrg rsqrt_xi(&num); 15025dfecf96Smrg rsqrt_xi(&den); 15035dfecf96Smrg 15045dfecf96Smrg clear_real(real); 15055dfecf96Smrg memcpy(real, &num, sizeof(n_real)); 15065dfecf96Smrg div_real_real(real, &den); 15075dfecf96Smrg clear_real(&den); 15085dfecf96Smrg} 15095dfecf96Smrg 15105dfecf96Smrgstatic void 15115dfecf96Smrgrsqrt_ff(n_real *real) 15125dfecf96Smrg{ 15135dfecf96Smrg if (RFF(real) < 0.0) 15145dfecf96Smrg fatal_error(FLOATING_POINT_EXCEPTION); 15155dfecf96Smrg RFF(real) = sqrt(RFF(real)); 15165dfecf96Smrg} 15175dfecf96Smrg 15185dfecf96Smrg 15195dfecf96Smrgstatic void 15205dfecf96Smrgnsqrt_cx(n_number *num) 15215dfecf96Smrg{ 15225dfecf96Smrg n_number mag; 15235dfecf96Smrg n_real *real, *imag; 15245dfecf96Smrg 15255dfecf96Smrg real = &(mag.real); 15265dfecf96Smrg imag = &(mag.imag); 15275dfecf96Smrg set_real_real(real, NREAL(num)); 15285dfecf96Smrg set_real_real(imag, NIMAG(num)); 15295dfecf96Smrg mag.complex = 1; 15305dfecf96Smrg 15315dfecf96Smrg nabs_cx(&mag); /* this will free the imag part data */ 15325dfecf96Smrg if (cmp_real_real(real, &zero) == 0) { 15335dfecf96Smrg clear_number(num); 15345dfecf96Smrg memcpy(NREAL(num), real, sizeof(n_real)); 15355dfecf96Smrg clear_real(real); 15365dfecf96Smrg num->complex = 0; 15375dfecf96Smrg return; 15385dfecf96Smrg } 15395dfecf96Smrg else if (cmp_real_real(NREAL(num), &zero) > 0) { 15405dfecf96Smrg /* R = sqrt((mag + Ra) / 2) */ 15415dfecf96Smrg add_real_real(NREAL(num), real); 15425dfecf96Smrg clear_real(real); 15435dfecf96Smrg div_real_real(NREAL(num), &two); 15445dfecf96Smrg sqrt_real(NREAL(num)); 15455dfecf96Smrg 15465dfecf96Smrg /* I = Ia / R / 2 */ 15475dfecf96Smrg div_real_real(NIMAG(num), NREAL(num)); 15485dfecf96Smrg div_real_real(NIMAG(num), &two); 15495dfecf96Smrg } 15505dfecf96Smrg else { 15515dfecf96Smrg /* remember old imag part */ 15525dfecf96Smrg memcpy(imag, NIMAG(num), sizeof(n_real)); 15535dfecf96Smrg 15545dfecf96Smrg /* I = sqrt((mag - Ra) / 2) */ 15555dfecf96Smrg memcpy(NIMAG(num), real, sizeof(n_real)); 15565dfecf96Smrg sub_real_real(NIMAG(num), NREAL(num)); 15575dfecf96Smrg div_real_real(NIMAG(num), &two); 15585dfecf96Smrg sqrt_real(NIMAG(num)); 15595dfecf96Smrg if (cmp_real_real(imag, &zero) < 0) 15605dfecf96Smrg neg_real(NIMAG(num)); 15615dfecf96Smrg 15625dfecf96Smrg /* R = Ia / I / 2 */ 15635dfecf96Smrg clear_real(NREAL(num)); 15645dfecf96Smrg /* start with old imag part */ 15655dfecf96Smrg memcpy(NREAL(num), imag, sizeof(n_real)); 15665dfecf96Smrg div_real_real(NREAL(num), NIMAG(num)); 15675dfecf96Smrg div_real_real(NREAL(num), &two); 15685dfecf96Smrg } 15695dfecf96Smrg 15705dfecf96Smrg ncx_canonicalize(num); 15715dfecf96Smrg} 15725dfecf96Smrg 15735dfecf96Smrgstatic void 15745dfecf96Smrgnsqrt_xi(n_number *num) 15755dfecf96Smrg{ 15765dfecf96Smrg if (cmp_real_real(NREAL(num), &zero) < 0) { 15775dfecf96Smrg memcpy(NIMAG(num), NREAL(num), sizeof(n_real)); 15785dfecf96Smrg neg_real(NIMAG(num)); 15795dfecf96Smrg rsqrt_xi(NIMAG(num)); 15805dfecf96Smrg NRTYPE(num) = N_FIXNUM; 15815dfecf96Smrg NRFI(num) = 0; 15825dfecf96Smrg num->complex = 1; 15835dfecf96Smrg } 15845dfecf96Smrg else 15855dfecf96Smrg rsqrt_xi(NREAL(num)); 15865dfecf96Smrg} 15875dfecf96Smrg 15885dfecf96Smrgstatic void 15895dfecf96Smrgnsqrt_ff(n_number *num) 15905dfecf96Smrg{ 15915dfecf96Smrg double value; 15925dfecf96Smrg 15935dfecf96Smrg if (NRFF(num) < 0.0) { 15945dfecf96Smrg value = sqrt(-NRFF(num)); 15955dfecf96Smrg 15965dfecf96Smrg NITYPE(num) = N_FLONUM; 15975dfecf96Smrg NIFF(num) = value; 15985dfecf96Smrg NRTYPE(num) = N_FIXNUM; 15995dfecf96Smrg NRFI(num) = 0; 16005dfecf96Smrg num->complex = 1; 16015dfecf96Smrg } 16025dfecf96Smrg else { 16035dfecf96Smrg value = sqrt(NRFF(num)); 16045dfecf96Smrg NRFF(num) = value; 16055dfecf96Smrg } 16065dfecf96Smrg} 16075dfecf96Smrg 16085dfecf96Smrgstatic void 16095dfecf96Smrgnsqrt_xr(n_number *num) 16105dfecf96Smrg{ 16115dfecf96Smrg if (cmp_real_real(NREAL(num), &zero) < 0) { 16125dfecf96Smrg memcpy(NIMAG(num), NREAL(num), sizeof(n_real)); 16135dfecf96Smrg neg_real(NIMAG(num)); 16145dfecf96Smrg rsqrt_xr(NIMAG(num)); 16155dfecf96Smrg NRTYPE(num) = N_FIXNUM; 16165dfecf96Smrg NRFI(num) = 0; 16175dfecf96Smrg num->complex = 1; 16185dfecf96Smrg } 16195dfecf96Smrg else 16205dfecf96Smrg rsqrt_xr(NREAL(num)); 16215dfecf96Smrg} 16225dfecf96Smrg 16235dfecf96Smrg 16245dfecf96Smrg/************************************************************************ 16255dfecf96Smrg * MOD 16265dfecf96Smrg ************************************************************************/ 16275dfecf96Smrgstatic void 16285dfecf96Smrgmod_real_real(n_real *real, n_real *val) 16295dfecf96Smrg{ 16305dfecf96Smrg /* Assume both operands are integers */ 16315dfecf96Smrg switch (RTYPE(real)) { 16325dfecf96Smrg case N_FIXNUM: 16335dfecf96Smrg switch (RTYPE(val)) { 16345dfecf96Smrg case N_FIXNUM: 16355dfecf96Smrg rmod_fi_fi(real, RFI(val)); 16365dfecf96Smrg break; 16375dfecf96Smrg case N_BIGNUM: 16385dfecf96Smrg rmod_fi_bi(real, RBI(val)); 16395dfecf96Smrg break; 16405dfecf96Smrg } 16415dfecf96Smrg break; 16425dfecf96Smrg case N_BIGNUM: 16435dfecf96Smrg switch (RTYPE(val)) { 16445dfecf96Smrg case N_FIXNUM: 16455dfecf96Smrg rmod_bi_fi(real, RFI(val)); 16465dfecf96Smrg break; 16475dfecf96Smrg case N_BIGNUM: 16485dfecf96Smrg rmod_bi_bi(real, RBI(val)); 16495dfecf96Smrg break; 16505dfecf96Smrg } 16515dfecf96Smrg break; 16525dfecf96Smrg } 16535dfecf96Smrg} 16545dfecf96Smrg 16555dfecf96Smrgstatic void 16565dfecf96Smrgmod_real_object(n_real *real, LispObj *obj) 16575dfecf96Smrg{ 16585dfecf96Smrg switch (RTYPE(real)) { 16595dfecf96Smrg case N_FIXNUM: 16605dfecf96Smrg switch (OBJECT_TYPE(obj)) { 16615dfecf96Smrg case LispFixnum_t: 16625dfecf96Smrg rmod_fi_fi(real, OFI(obj)); 16635dfecf96Smrg return; 16645dfecf96Smrg case LispInteger_t: 16655dfecf96Smrg rmod_fi_fi(real, OII(obj)); 16665dfecf96Smrg return; 16675dfecf96Smrg case LispBignum_t: 16685dfecf96Smrg rmod_fi_bi(real, OBI(obj)); 16695dfecf96Smrg return; 16705dfecf96Smrg default: 16715dfecf96Smrg break; 16725dfecf96Smrg } 16735dfecf96Smrg break; 16745dfecf96Smrg case N_BIGNUM: 16755dfecf96Smrg switch (OBJECT_TYPE(obj)) { 16765dfecf96Smrg case LispFixnum_t: 16775dfecf96Smrg rmod_bi_fi(real, OFI(obj)); 16785dfecf96Smrg return; 16795dfecf96Smrg case LispInteger_t: 16805dfecf96Smrg rmod_bi_fi(real, OII(obj)); 16815dfecf96Smrg return; 16825dfecf96Smrg case LispBignum_t: 16835dfecf96Smrg rmod_bi_bi(real, OBI(obj)); 16845dfecf96Smrg return; 16855dfecf96Smrg default: 16865dfecf96Smrg break; 16875dfecf96Smrg } 16885dfecf96Smrg break; 16895dfecf96Smrg /* Assume the n_real object is an integer */ 16905dfecf96Smrg } 16915dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 16925dfecf96Smrg} 16935dfecf96Smrg 16945dfecf96Smrgstatic void 16955dfecf96Smrgrmod_fi_fi(n_real *real, long fi) 16965dfecf96Smrg{ 16975dfecf96Smrg if (fi == 0) 16985dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 16995dfecf96Smrg 17005dfecf96Smrg if ((RFI(real) < 0) ^ (fi < 0)) 17015dfecf96Smrg RFI(real) = (RFI(real) % fi) + fi; 17025dfecf96Smrg else if (RFI(real) == MINSLONG || fi == MINSLONG) { 17035dfecf96Smrg mpi bignum; 17045dfecf96Smrg 17055dfecf96Smrg mpi_init(&bignum); 17065dfecf96Smrg mpi_seti(&bignum, RFI(real)); 17075dfecf96Smrg RFI(real) = mpi_modi(&bignum, fi); 17085dfecf96Smrg mpi_clear(&bignum); 17095dfecf96Smrg } 17105dfecf96Smrg else 17115dfecf96Smrg RFI(real) = RFI(real) % fi; 17125dfecf96Smrg} 17135dfecf96Smrg 17145dfecf96Smrgstatic void 17155dfecf96Smrgrmod_fi_bi(n_real *real, mpi *bignum) 17165dfecf96Smrg{ 17175dfecf96Smrg mpi *bigi; 17185dfecf96Smrg 17195dfecf96Smrg if (mpi_cmpi(bignum, 0) == 0) 17205dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 17215dfecf96Smrg 17225dfecf96Smrg bigi = XALLOC(mpi); 17235dfecf96Smrg mpi_init(bigi); 17245dfecf96Smrg mpi_seti(bigi, RFI(real)); 17255dfecf96Smrg mpi_mod(bigi, bigi, bignum); 17265dfecf96Smrg RTYPE(real) = N_BIGNUM; 17275dfecf96Smrg RBI(real) = bigi; 17285dfecf96Smrg rbi_canonicalize(real); 17295dfecf96Smrg} 17305dfecf96Smrg 17315dfecf96Smrgstatic void 17325dfecf96Smrgrmod_bi_fi(n_real *real, long fi) 17335dfecf96Smrg{ 17345dfecf96Smrg mpi iop; 17355dfecf96Smrg 17365dfecf96Smrg if (fi == 0) 17375dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 17385dfecf96Smrg 17395dfecf96Smrg mpi_init(&iop); 17405dfecf96Smrg mpi_seti(&iop, fi); 17415dfecf96Smrg mpi_mod(RBI(real), RBI(real), &iop); 17425dfecf96Smrg mpi_clear(&iop); 17435dfecf96Smrg rbi_canonicalize(real); 17445dfecf96Smrg} 17455dfecf96Smrg 17465dfecf96Smrgstatic void 17475dfecf96Smrgrmod_bi_bi(n_real *real, mpi *bignum) 17485dfecf96Smrg{ 17495dfecf96Smrg if (mpi_cmpi(bignum, 0) == 0) 17505dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 17515dfecf96Smrg 17525dfecf96Smrg mpi_mod(RBI(real), RBI(real), bignum); 17535dfecf96Smrg rbi_canonicalize(real); 17545dfecf96Smrg} 17555dfecf96Smrg 17565dfecf96Smrg/************************************************************************ 17575dfecf96Smrg * REM 17585dfecf96Smrg ************************************************************************/ 17595dfecf96Smrgstatic void 17605dfecf96Smrgrem_real_object(n_real *real, LispObj *obj) 17615dfecf96Smrg{ 17625dfecf96Smrg switch (RTYPE(real)) { 17635dfecf96Smrg case N_FIXNUM: 17645dfecf96Smrg switch (OBJECT_TYPE(obj)) { 17655dfecf96Smrg case LispFixnum_t: 17665dfecf96Smrg rrem_fi_fi(real, OFI(obj)); 17675dfecf96Smrg return; 17685dfecf96Smrg case LispInteger_t: 17695dfecf96Smrg rrem_fi_fi(real, OII(obj)); 17705dfecf96Smrg return; 17715dfecf96Smrg case LispBignum_t: 17725dfecf96Smrg rrem_fi_bi(real, OBI(obj)); 17735dfecf96Smrg return; 17745dfecf96Smrg default: 17755dfecf96Smrg break; 17765dfecf96Smrg } 17775dfecf96Smrg break; 17785dfecf96Smrg case N_BIGNUM: 17795dfecf96Smrg switch (OBJECT_TYPE(obj)) { 17805dfecf96Smrg case LispFixnum_t: 17815dfecf96Smrg rrem_bi_fi(real, OFI(obj)); 17825dfecf96Smrg return; 17835dfecf96Smrg case LispInteger_t: 17845dfecf96Smrg rrem_bi_fi(real, OII(obj)); 17855dfecf96Smrg return; 17865dfecf96Smrg case LispBignum_t: 17875dfecf96Smrg rrem_bi_bi(real, OBI(obj)); 17885dfecf96Smrg return; 17895dfecf96Smrg default: 17905dfecf96Smrg break; 17915dfecf96Smrg } 17925dfecf96Smrg break; 17935dfecf96Smrg /* Assume the n_real object is an integer */ 17945dfecf96Smrg } 17955dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 17965dfecf96Smrg} 17975dfecf96Smrg 17985dfecf96Smrgstatic void 17995dfecf96Smrgrrem_fi_fi(n_real *real, long fi) 18005dfecf96Smrg{ 18015dfecf96Smrg if (fi == 0) 18025dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 18035dfecf96Smrg 18045dfecf96Smrg if (RFI(real) == MINSLONG || fi == MINSLONG) { 18055dfecf96Smrg mpi bignum; 18065dfecf96Smrg 18075dfecf96Smrg mpi_init(&bignum); 18085dfecf96Smrg mpi_seti(&bignum, RFI(real)); 18095dfecf96Smrg RFI(real) = mpi_remi(&bignum, fi); 18105dfecf96Smrg mpi_clear(&bignum); 18115dfecf96Smrg } 18125dfecf96Smrg else 18135dfecf96Smrg RFI(real) = RFI(real) % fi; 18145dfecf96Smrg} 18155dfecf96Smrg 18165dfecf96Smrgstatic void 18175dfecf96Smrgrrem_fi_bi(n_real *real, mpi *bignum) 18185dfecf96Smrg{ 18195dfecf96Smrg mpi *bigi; 18205dfecf96Smrg 18215dfecf96Smrg if (mpi_cmpi(bignum, 0) == 0) 18225dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 18235dfecf96Smrg 18245dfecf96Smrg bigi = XALLOC(mpi); 18255dfecf96Smrg mpi_init(bigi); 18265dfecf96Smrg mpi_seti(bigi, RFI(real)); 18275dfecf96Smrg mpi_rem(bigi, bigi, bignum); 18285dfecf96Smrg RTYPE(real) = N_BIGNUM; 18295dfecf96Smrg RBI(real) = bigi; 18305dfecf96Smrg rbi_canonicalize(real); 18315dfecf96Smrg} 18325dfecf96Smrg 18335dfecf96Smrgstatic void 18345dfecf96Smrgrrem_bi_fi(n_real *real, long fi) 18355dfecf96Smrg{ 18365dfecf96Smrg mpi iop; 18375dfecf96Smrg 18385dfecf96Smrg if (fi == 0) 18395dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 18405dfecf96Smrg 18415dfecf96Smrg mpi_init(&iop); 18425dfecf96Smrg mpi_seti(&iop, fi); 18435dfecf96Smrg mpi_rem(RBI(real), RBI(real), &iop); 18445dfecf96Smrg mpi_clear(&iop); 18455dfecf96Smrg rbi_canonicalize(real); 18465dfecf96Smrg} 18475dfecf96Smrg 18485dfecf96Smrgstatic void 18495dfecf96Smrgrrem_bi_bi(n_real *real, mpi *bignum) 18505dfecf96Smrg{ 18515dfecf96Smrg if (mpi_cmpi(bignum, 0) == 0) 18525dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 18535dfecf96Smrg 18545dfecf96Smrg mpi_rem(RBI(real), RBI(real), bignum); 18555dfecf96Smrg rbi_canonicalize(real); 18565dfecf96Smrg} 18575dfecf96Smrg 18585dfecf96Smrg 18595dfecf96Smrg/************************************************************************ 18605dfecf96Smrg * GCD 18615dfecf96Smrg ************************************************************************/ 18625dfecf96Smrgstatic void 18635dfecf96Smrggcd_real_object(n_real *real, LispObj *obj) 18645dfecf96Smrg{ 18655dfecf96Smrg if (!INTEGERP(obj)) 18665dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 18675dfecf96Smrg 18685dfecf96Smrg /* check for zero operand */ 18695dfecf96Smrg if (cmp_real_real(real, &zero) == 0) 18705dfecf96Smrg set_real_object(real, obj); 18715dfecf96Smrg else if (cmp_real_object(&zero, obj) != 0) { 18725dfecf96Smrg n_real rest, temp; 18735dfecf96Smrg 18745dfecf96Smrg set_real_object(&rest, obj); 18755dfecf96Smrg for (;;) { 18765dfecf96Smrg mod_real_real(&rest, real); 18775dfecf96Smrg if (cmp_real_real(&rest, &zero) == 0) 18785dfecf96Smrg break; 18795dfecf96Smrg memcpy(&temp, real, sizeof(n_real)); 18805dfecf96Smrg memcpy(real, &rest, sizeof(n_real)); 18815dfecf96Smrg memcpy(&rest, &temp, sizeof(n_real)); 18825dfecf96Smrg } 18835dfecf96Smrg clear_real(&rest); 18845dfecf96Smrg } 18855dfecf96Smrg} 18865dfecf96Smrg 18875dfecf96Smrg/************************************************************************ 18885dfecf96Smrg * AND 18895dfecf96Smrg ************************************************************************/ 18905dfecf96Smrgstatic void 18915dfecf96Smrgand_real_object(n_real *real, LispObj *obj) 18925dfecf96Smrg{ 18935dfecf96Smrg mpi *bigi, iop; 18945dfecf96Smrg 18955dfecf96Smrg switch (OBJECT_TYPE(obj)) { 18965dfecf96Smrg case LispFixnum_t: 18975dfecf96Smrg switch (RTYPE(real)) { 18985dfecf96Smrg case N_FIXNUM: 18995dfecf96Smrg RFI(real) &= OFI(obj); 19005dfecf96Smrg break; 19015dfecf96Smrg case N_BIGNUM: 19025dfecf96Smrg mpi_init(&iop); 19035dfecf96Smrg mpi_seti(&iop, OFI(obj)); 19045dfecf96Smrg mpi_and(RBI(real), RBI(real), &iop); 19055dfecf96Smrg mpi_clear(&iop); 19065dfecf96Smrg rbi_canonicalize(real); 19075dfecf96Smrg break; 19085dfecf96Smrg } 19095dfecf96Smrg break; 19105dfecf96Smrg case LispInteger_t: 19115dfecf96Smrg switch (RTYPE(real)) { 19125dfecf96Smrg case N_FIXNUM: 19135dfecf96Smrg RFI(real) &= OII(obj); 19145dfecf96Smrg break; 19155dfecf96Smrg case N_BIGNUM: 19165dfecf96Smrg mpi_init(&iop); 19175dfecf96Smrg mpi_seti(&iop, OII(obj)); 19185dfecf96Smrg mpi_and(RBI(real), RBI(real), &iop); 19195dfecf96Smrg mpi_clear(&iop); 19205dfecf96Smrg rbi_canonicalize(real); 19215dfecf96Smrg break; 19225dfecf96Smrg } 19235dfecf96Smrg break; 19245dfecf96Smrg case LispBignum_t: 19255dfecf96Smrg switch (RTYPE(real)) { 19265dfecf96Smrg case N_FIXNUM: 19275dfecf96Smrg bigi = XALLOC(mpi); 19285dfecf96Smrg mpi_init(bigi); 19295dfecf96Smrg mpi_seti(bigi, RFI(real)); 19305dfecf96Smrg mpi_and(bigi, bigi, OBI(obj)); 19315dfecf96Smrg RTYPE(real) = N_BIGNUM; 19325dfecf96Smrg RBI(real) = bigi; 19335dfecf96Smrg rbi_canonicalize(real); 19345dfecf96Smrg break; 19355dfecf96Smrg case N_BIGNUM: 19365dfecf96Smrg mpi_and(RBI(real), RBI(real), OBI(obj)); 19375dfecf96Smrg rbi_canonicalize(real); 19385dfecf96Smrg break; 19395dfecf96Smrg } 19405dfecf96Smrg break; 19415dfecf96Smrg default: 19425dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 19435dfecf96Smrg break; 19445dfecf96Smrg } 19455dfecf96Smrg} 19465dfecf96Smrg 19475dfecf96Smrg 19485dfecf96Smrg/************************************************************************ 19495dfecf96Smrg * EQV 19505dfecf96Smrg ************************************************************************/ 19515dfecf96Smrgstatic void 19525dfecf96Smrgeqv_real_object(n_real *real, LispObj *obj) 19535dfecf96Smrg{ 19545dfecf96Smrg mpi *bigi, iop; 19555dfecf96Smrg 19565dfecf96Smrg switch (OBJECT_TYPE(obj)) { 19575dfecf96Smrg case LispFixnum_t: 19585dfecf96Smrg switch (RTYPE(real)) { 19595dfecf96Smrg case N_FIXNUM: 19605dfecf96Smrg RFI(real) ^= ~OFI(obj); 19615dfecf96Smrg break; 19625dfecf96Smrg case N_BIGNUM: 19635dfecf96Smrg mpi_init(&iop); 19645dfecf96Smrg mpi_seti(&iop, OFI(obj)); 19655dfecf96Smrg mpi_com(&iop, &iop); 19665dfecf96Smrg mpi_xor(RBI(real), RBI(real), &iop); 19675dfecf96Smrg mpi_clear(&iop); 19685dfecf96Smrg rbi_canonicalize(real); 19695dfecf96Smrg break; 19705dfecf96Smrg } 19715dfecf96Smrg break; 19725dfecf96Smrg case LispInteger_t: 19735dfecf96Smrg switch (RTYPE(real)) { 19745dfecf96Smrg case N_FIXNUM: 19755dfecf96Smrg RFI(real) ^= ~OII(obj); 19765dfecf96Smrg break; 19775dfecf96Smrg case N_BIGNUM: 19785dfecf96Smrg mpi_init(&iop); 19795dfecf96Smrg mpi_seti(&iop, OII(obj)); 19805dfecf96Smrg mpi_com(&iop, &iop); 19815dfecf96Smrg mpi_xor(RBI(real), RBI(real), &iop); 19825dfecf96Smrg mpi_clear(&iop); 19835dfecf96Smrg rbi_canonicalize(real); 19845dfecf96Smrg break; 19855dfecf96Smrg } 19865dfecf96Smrg break; 19875dfecf96Smrg case LispBignum_t: 19885dfecf96Smrg switch (RTYPE(real)) { 19895dfecf96Smrg case N_FIXNUM: 19905dfecf96Smrg bigi = XALLOC(mpi); 19915dfecf96Smrg mpi_init(bigi); 19925dfecf96Smrg mpi_seti(bigi, RFI(real)); 19935dfecf96Smrg mpi_com(bigi, bigi); 19945dfecf96Smrg mpi_xor(bigi, bigi, OBI(obj)); 19955dfecf96Smrg RTYPE(real) = N_BIGNUM; 19965dfecf96Smrg RBI(real) = bigi; 19975dfecf96Smrg rbi_canonicalize(real); 19985dfecf96Smrg break; 19995dfecf96Smrg case N_BIGNUM: 20005dfecf96Smrg mpi_com(RBI(real), RBI(real)); 20015dfecf96Smrg mpi_xor(RBI(real), RBI(real), OBI(obj)); 20025dfecf96Smrg rbi_canonicalize(real); 20035dfecf96Smrg break; 20045dfecf96Smrg } 20055dfecf96Smrg break; 20065dfecf96Smrg default: 20075dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 20085dfecf96Smrg break; 20095dfecf96Smrg } 20105dfecf96Smrg} 20115dfecf96Smrg 20125dfecf96Smrg 20135dfecf96Smrg/************************************************************************ 20145dfecf96Smrg * IOR 20155dfecf96Smrg ************************************************************************/ 20165dfecf96Smrgstatic void 20175dfecf96Smrgior_real_object(n_real *real, LispObj *obj) 20185dfecf96Smrg{ 20195dfecf96Smrg mpi *bigi, iop; 20205dfecf96Smrg 20215dfecf96Smrg switch (OBJECT_TYPE(obj)) { 20225dfecf96Smrg case LispFixnum_t: 20235dfecf96Smrg switch (RTYPE(real)) { 20245dfecf96Smrg case N_FIXNUM: 20255dfecf96Smrg RFI(real) |= OFI(obj); 20265dfecf96Smrg break; 20275dfecf96Smrg case N_BIGNUM: 20285dfecf96Smrg mpi_init(&iop); 20295dfecf96Smrg mpi_seti(&iop, OFI(obj)); 20305dfecf96Smrg mpi_ior(RBI(real), RBI(real), &iop); 20315dfecf96Smrg mpi_clear(&iop); 20325dfecf96Smrg rbi_canonicalize(real); 20335dfecf96Smrg break; 20345dfecf96Smrg } 20355dfecf96Smrg break; 20365dfecf96Smrg case LispInteger_t: 20375dfecf96Smrg switch (RTYPE(real)) { 20385dfecf96Smrg case N_FIXNUM: 20395dfecf96Smrg RFI(real) |= OII(obj); 20405dfecf96Smrg break; 20415dfecf96Smrg case N_BIGNUM: 20425dfecf96Smrg mpi_init(&iop); 20435dfecf96Smrg mpi_seti(&iop, OII(obj)); 20445dfecf96Smrg mpi_ior(RBI(real), RBI(real), &iop); 20455dfecf96Smrg mpi_clear(&iop); 20465dfecf96Smrg rbi_canonicalize(real); 20475dfecf96Smrg break; 20485dfecf96Smrg } 20495dfecf96Smrg break; 20505dfecf96Smrg case LispBignum_t: 20515dfecf96Smrg switch (RTYPE(real)) { 20525dfecf96Smrg case N_FIXNUM: 20535dfecf96Smrg bigi = XALLOC(mpi); 20545dfecf96Smrg mpi_init(bigi); 20555dfecf96Smrg mpi_seti(bigi, RFI(real)); 20565dfecf96Smrg mpi_ior(bigi, bigi, OBI(obj)); 20575dfecf96Smrg RTYPE(real) = N_BIGNUM; 20585dfecf96Smrg RBI(real) = bigi; 20595dfecf96Smrg rbi_canonicalize(real); 20605dfecf96Smrg break; 20615dfecf96Smrg case N_BIGNUM: 20625dfecf96Smrg mpi_ior(RBI(real), RBI(real), OBI(obj)); 20635dfecf96Smrg rbi_canonicalize(real); 20645dfecf96Smrg break; 20655dfecf96Smrg } 20665dfecf96Smrg break; 20675dfecf96Smrg default: 20685dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 20695dfecf96Smrg break; 20705dfecf96Smrg } 20715dfecf96Smrg} 20725dfecf96Smrg 20735dfecf96Smrg 20745dfecf96Smrg/************************************************************************ 20755dfecf96Smrg * NOT 20765dfecf96Smrg ************************************************************************/ 20775dfecf96Smrgstatic void 20785dfecf96Smrgnot_real(n_real *real) 20795dfecf96Smrg{ 20805dfecf96Smrg if (RTYPE(real) == N_FIXNUM) 20815dfecf96Smrg RFI(real) = ~RFI(real); 20825dfecf96Smrg else { 20835dfecf96Smrg mpi_com(RBI(real), RBI(real)); 20845dfecf96Smrg rbi_canonicalize(real); 20855dfecf96Smrg } 20865dfecf96Smrg} 20875dfecf96Smrg 20885dfecf96Smrg/************************************************************************ 20895dfecf96Smrg * XOR 20905dfecf96Smrg ************************************************************************/ 20915dfecf96Smrgstatic void 20925dfecf96Smrgxor_real_object(n_real *real, LispObj *obj) 20935dfecf96Smrg{ 20945dfecf96Smrg mpi *bigi, iop; 20955dfecf96Smrg 20965dfecf96Smrg switch (OBJECT_TYPE(obj)) { 20975dfecf96Smrg case LispFixnum_t: 20985dfecf96Smrg switch (RTYPE(real)) { 20995dfecf96Smrg case N_FIXNUM: 21005dfecf96Smrg RFI(real) ^= OFI(obj); 21015dfecf96Smrg break; 21025dfecf96Smrg case N_BIGNUM: 21035dfecf96Smrg mpi_init(&iop); 21045dfecf96Smrg mpi_seti(&iop, OFI(obj)); 21055dfecf96Smrg mpi_xor(RBI(real), RBI(real), &iop); 21065dfecf96Smrg mpi_clear(&iop); 21075dfecf96Smrg rbi_canonicalize(real); 21085dfecf96Smrg break; 21095dfecf96Smrg } 21105dfecf96Smrg break; 21115dfecf96Smrg case LispInteger_t: 21125dfecf96Smrg switch (RTYPE(real)) { 21135dfecf96Smrg case N_FIXNUM: 21145dfecf96Smrg RFI(real) ^= OII(obj); 21155dfecf96Smrg break; 21165dfecf96Smrg case N_BIGNUM: 21175dfecf96Smrg mpi_init(&iop); 21185dfecf96Smrg mpi_seti(&iop, OII(obj)); 21195dfecf96Smrg mpi_xor(RBI(real), RBI(real), &iop); 21205dfecf96Smrg mpi_clear(&iop); 21215dfecf96Smrg rbi_canonicalize(real); 21225dfecf96Smrg break; 21235dfecf96Smrg } 21245dfecf96Smrg break; 21255dfecf96Smrg case LispBignum_t: 21265dfecf96Smrg switch (RTYPE(real)) { 21275dfecf96Smrg case N_FIXNUM: 21285dfecf96Smrg bigi = XALLOC(mpi); 21295dfecf96Smrg mpi_init(bigi); 21305dfecf96Smrg mpi_seti(bigi, RFI(real)); 21315dfecf96Smrg mpi_xor(bigi, bigi, OBI(obj)); 21325dfecf96Smrg RTYPE(real) = N_BIGNUM; 21335dfecf96Smrg RBI(real) = bigi; 21345dfecf96Smrg rbi_canonicalize(real); 21355dfecf96Smrg break; 21365dfecf96Smrg case N_BIGNUM: 21375dfecf96Smrg mpi_xor(RBI(real), RBI(real), OBI(obj)); 21385dfecf96Smrg rbi_canonicalize(real); 21395dfecf96Smrg break; 21405dfecf96Smrg } 21415dfecf96Smrg break; 21425dfecf96Smrg default: 21435dfecf96Smrg fatal_object_error(obj, NOT_AN_INTEGER); 21445dfecf96Smrg break; 21455dfecf96Smrg } 21465dfecf96Smrg} 21475dfecf96Smrg 21485dfecf96Smrg 21495dfecf96Smrg/************************************************************************ 21505dfecf96Smrg * DIVIDE 21515dfecf96Smrg ************************************************************************/ 21525dfecf96Smrgstatic void 21535dfecf96Smrgdivide_number_object(n_number *num, LispObj *obj, int fun, int flo) 21545dfecf96Smrg{ 21555dfecf96Smrg switch (OBJECT_TYPE(obj)) { 21565dfecf96Smrg case LispFixnum_t: 21575dfecf96Smrg switch (NRTYPE(num)) { 21585dfecf96Smrg case N_FIXNUM: 21595dfecf96Smrg ndivide_fi_fi(num, OFI(obj), fun, flo); 21605dfecf96Smrg break; 21615dfecf96Smrg case N_BIGNUM: 21625dfecf96Smrg ndivide_xi_xi(num, obj, fun, flo); 21635dfecf96Smrg break; 21645dfecf96Smrg case N_FLONUM: 21655dfecf96Smrg ndivide_flonum(num, NRFF(num), (double)OFI(obj), fun, flo); 21665dfecf96Smrg break; 21675dfecf96Smrg case N_FIXRATIO: 21685dfecf96Smrg case N_BIGRATIO: 21695dfecf96Smrg ndivide_xr_xi(num, obj, fun, flo); 21705dfecf96Smrg break; 21715dfecf96Smrg } 21725dfecf96Smrg break; 21735dfecf96Smrg case LispInteger_t: 21745dfecf96Smrg switch (NRTYPE(num)) { 21755dfecf96Smrg case N_FIXNUM: 21765dfecf96Smrg ndivide_fi_fi(num, OII(obj), fun, flo); 21775dfecf96Smrg break; 21785dfecf96Smrg case N_BIGNUM: 21795dfecf96Smrg ndivide_xi_xi(num, obj, fun, flo); 21805dfecf96Smrg break; 21815dfecf96Smrg case N_FLONUM: 21825dfecf96Smrg ndivide_flonum(num, NRFF(num), (double)OII(obj), fun, flo); 21835dfecf96Smrg break; 21845dfecf96Smrg case N_FIXRATIO: 21855dfecf96Smrg case N_BIGRATIO: 21865dfecf96Smrg ndivide_xr_xi(num, obj, fun, flo); 21875dfecf96Smrg break; 21885dfecf96Smrg } 21895dfecf96Smrg break; 21905dfecf96Smrg case LispBignum_t: 21915dfecf96Smrg switch (NRTYPE(num)) { 21925dfecf96Smrg case N_FIXNUM: 21935dfecf96Smrg case N_BIGNUM: 21945dfecf96Smrg ndivide_xi_xi(num, obj, fun, flo); 21955dfecf96Smrg break; 21965dfecf96Smrg case N_FLONUM: 21975dfecf96Smrg ndivide_flonum(num, NRFF(num), bi_getd(OBI(obj)), 21985dfecf96Smrg fun, flo); 21995dfecf96Smrg break; 22005dfecf96Smrg case N_FIXRATIO: 22015dfecf96Smrg case N_BIGRATIO: 22025dfecf96Smrg ndivide_xr_xi(num, obj, fun, flo); 22035dfecf96Smrg break; 22045dfecf96Smrg } 22055dfecf96Smrg break; 22065dfecf96Smrg case LispDFloat_t: 22075dfecf96Smrg switch (NRTYPE(num)) { 22085dfecf96Smrg case N_FIXNUM: 22095dfecf96Smrg ndivide_flonum(num, (double)NRFI(num), ODF(obj), 22105dfecf96Smrg fun, flo); 22115dfecf96Smrg break; 22125dfecf96Smrg case N_BIGNUM: 22135dfecf96Smrg ndivide_flonum(num, bi_getd(NRBI(num)), ODF(obj), 22145dfecf96Smrg fun, flo); 22155dfecf96Smrg break; 22165dfecf96Smrg case N_FLONUM: 22175dfecf96Smrg ndivide_flonum(num, NRFF(num), ODF(obj), fun, flo); 22185dfecf96Smrg break; 22195dfecf96Smrg case N_FIXRATIO: 22205dfecf96Smrg ndivide_flonum(num, 22215dfecf96Smrg (double)NRFRN(num) / (double)NRFRD(num), 22225dfecf96Smrg ODF(obj), fun, flo); 22235dfecf96Smrg break; 22245dfecf96Smrg case N_BIGRATIO: 22255dfecf96Smrg ndivide_flonum(num, br_getd(NRBR(num)), ODF(obj), 22265dfecf96Smrg fun, flo); 22275dfecf96Smrg break; 22285dfecf96Smrg } 22295dfecf96Smrg break; 22305dfecf96Smrg case LispRatio_t: 22315dfecf96Smrg switch (NRTYPE(num)) { 22325dfecf96Smrg case N_FIXNUM: 22335dfecf96Smrg case N_BIGNUM: 22345dfecf96Smrg ndivide_xi_xr(num, obj, fun, flo); 22355dfecf96Smrg break; 22365dfecf96Smrg case N_FLONUM: 22375dfecf96Smrg ndivide_flonum(num, NRFF(num), 22385dfecf96Smrg (double)OFRN(obj) / (double)OFRD(obj), 22395dfecf96Smrg fun, flo); 22405dfecf96Smrg break; 22415dfecf96Smrg case N_FIXRATIO: 22425dfecf96Smrg case N_BIGRATIO: 22435dfecf96Smrg ndivide_xr_xr(num, obj, fun, flo); 22445dfecf96Smrg break; 22455dfecf96Smrg } 22465dfecf96Smrg break; 22475dfecf96Smrg case LispBigratio_t: 22485dfecf96Smrg switch (NRTYPE(num)) { 22495dfecf96Smrg case N_FIXNUM: 22505dfecf96Smrg case N_BIGNUM: 22515dfecf96Smrg ndivide_xi_xr(num, obj, fun, flo); 22525dfecf96Smrg break; 22535dfecf96Smrg case N_FLONUM: 22545dfecf96Smrg ndivide_flonum(num, NRFF(num), br_getd(OBR(obj)), 22555dfecf96Smrg fun, flo); 22565dfecf96Smrg break; 22575dfecf96Smrg case N_FIXRATIO: 22585dfecf96Smrg case N_BIGRATIO: 22595dfecf96Smrg ndivide_xr_xr(num, obj, fun, flo); 22605dfecf96Smrg break; 22615dfecf96Smrg } 22625dfecf96Smrg break; 22635dfecf96Smrg default: 22645dfecf96Smrg fatal_object_error(obj, NOT_A_REAL_NUMBER); 22655dfecf96Smrg break; 22665dfecf96Smrg } 22675dfecf96Smrg} 22685dfecf96Smrg 22695dfecf96Smrg 22705dfecf96Smrg/************************************************************************ 22715dfecf96Smrg * COMPARE 22725dfecf96Smrg ************************************************************************/ 22735dfecf96Smrgstatic int 22745dfecf96Smrgcmp_real_real(n_real *op1, n_real *op2) 22755dfecf96Smrg{ 22765dfecf96Smrg switch (RTYPE(op1)) { 22775dfecf96Smrg case N_FIXNUM: 22785dfecf96Smrg switch (RTYPE(op2)) { 22795dfecf96Smrg case N_FIXNUM: 22805dfecf96Smrg return (cmp_fi_fi(RFI(op1), RFI(op2))); 22815dfecf96Smrg case N_BIGNUM: 22825dfecf96Smrg return (cmp_fi_bi(RFI(op1), RBI(op2))); 22835dfecf96Smrg case N_FLONUM: 22845dfecf96Smrg return (cmp_flonum((double)RFI(op1), RFF(op2))); 22855dfecf96Smrg case N_FIXRATIO: 22865dfecf96Smrg return (cmp_fi_fr(RFI(op1), RFRN(op2), RFRD(op2))); 22875dfecf96Smrg case N_BIGRATIO: 22885dfecf96Smrg return (cmp_fi_br(RFI(op1), RBR(op2))); 22895dfecf96Smrg } 22905dfecf96Smrg break; 22915dfecf96Smrg case N_BIGNUM: 22925dfecf96Smrg switch (RTYPE(op2)) { 22935dfecf96Smrg case N_FIXNUM: 22945dfecf96Smrg return (cmp_bi_fi(RBI(op1), RFI(op2))); 22955dfecf96Smrg case N_BIGNUM: 22965dfecf96Smrg return (cmp_bi_bi(RBI(op1), RBI(op2))); 22975dfecf96Smrg case N_FLONUM: 22985dfecf96Smrg return (cmp_flonum(bi_getd(RBI(op1)), RFF(op2))); 22995dfecf96Smrg case N_FIXRATIO: 23005dfecf96Smrg return (cmp_bi_fr(RBI(op1), RFRN(op2), RFRD(op2))); 23015dfecf96Smrg case N_BIGRATIO: 23025dfecf96Smrg return (cmp_bi_br(RBI(op1), RBR(op2))); 23035dfecf96Smrg } 23045dfecf96Smrg break; 23055dfecf96Smrg case N_FLONUM: 23065dfecf96Smrg switch (RTYPE(op2)) { 23075dfecf96Smrg case N_FIXNUM: 23085dfecf96Smrg return (cmp_flonum(RFF(op1), (double)RFI(op2))); 23095dfecf96Smrg case N_BIGNUM: 23105dfecf96Smrg return (cmp_flonum(RFF(op1), bi_getd(RBI(op2)))); 23115dfecf96Smrg case N_FLONUM: 23125dfecf96Smrg return (cmp_flonum(RFF(op1), RFF(op2))); 23135dfecf96Smrg case N_FIXRATIO: 23145dfecf96Smrg return (cmp_flonum(RFF(op1), 23155dfecf96Smrg (double)RFRN(op2) / (double)RFRD(op2))); 23165dfecf96Smrg case N_BIGRATIO: 23175dfecf96Smrg return (cmp_flonum(RFF(op1), br_getd(RBR(op2)))); 23185dfecf96Smrg } 23195dfecf96Smrg break; 23205dfecf96Smrg case N_FIXRATIO: 23215dfecf96Smrg switch (RTYPE(op2)) { 23225dfecf96Smrg case N_FIXNUM: 23235dfecf96Smrg return (cmp_fr_fi(RFRN(op1), RFRD(op1), RFI(op2))); 23245dfecf96Smrg case N_BIGNUM: 23255dfecf96Smrg return (cmp_fr_bi(RFRN(op1), RFRD(op1), RBI(op2))); 23265dfecf96Smrg case N_FLONUM: 23275dfecf96Smrg return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1), 23285dfecf96Smrg RFF(op2))); 23295dfecf96Smrg case N_FIXRATIO: 23305dfecf96Smrg return (cmp_fr_fr(RFRN(op1), RFRD(op1), 23315dfecf96Smrg RFRN(op2), RFRD(op2))); 23325dfecf96Smrg case N_BIGRATIO: 23335dfecf96Smrg return (cmp_fr_br(RFRN(op1), RFRD(op1), RBR(op2))); 23345dfecf96Smrg } 23355dfecf96Smrg break; 23365dfecf96Smrg case N_BIGRATIO: 23375dfecf96Smrg switch (RTYPE(op2)) { 23385dfecf96Smrg case N_FIXNUM: 23395dfecf96Smrg return (cmp_br_fi(RBR(op1), RFI(op2))); 23405dfecf96Smrg case N_BIGNUM: 23415dfecf96Smrg return (cmp_br_bi(RBR(op1), RBI(op2))); 23425dfecf96Smrg case N_FLONUM: 23435dfecf96Smrg return (cmp_flonum(br_getd(RBR(op1)), RFF(op2))); 23445dfecf96Smrg case N_FIXRATIO: 23455dfecf96Smrg return (cmp_br_fr(RBR(op1), RFRN(op2), RFRD(op2))); 23465dfecf96Smrg case N_BIGRATIO: 23475dfecf96Smrg return (cmp_br_br(RBR(op1), RBR(op2))); 23485dfecf96Smrg } 23495dfecf96Smrg } 23505dfecf96Smrg 23515dfecf96Smrg return (0); 23525dfecf96Smrg} 23535dfecf96Smrg 23545dfecf96Smrgstatic int 23555dfecf96Smrgcmp_real_object(n_real *op1, LispObj *op2) 23565dfecf96Smrg{ 23575dfecf96Smrg switch (OBJECT_TYPE(op2)) { 23585dfecf96Smrg case LispFixnum_t: 23595dfecf96Smrg switch (RTYPE(op1)) { 23605dfecf96Smrg case N_FIXNUM: 23615dfecf96Smrg return (cmp_fi_fi(RFI(op1), OFI(op2))); 23625dfecf96Smrg case N_BIGNUM: 23635dfecf96Smrg return (cmp_bi_fi(RBI(op1), OFI(op2))); 23645dfecf96Smrg case N_FLONUM: 23655dfecf96Smrg return (cmp_flonum(RFF(op1), (double)OFI(op2))); 23665dfecf96Smrg case N_FIXRATIO: 23675dfecf96Smrg return (cmp_fr_fi(RFRD(op1), RFRN(op1), OFI(op2))); 23685dfecf96Smrg case N_BIGRATIO: 23695dfecf96Smrg return (cmp_br_fi(RBR(op1), OFI(op2))); 23705dfecf96Smrg } 23715dfecf96Smrg break; 23725dfecf96Smrg case LispInteger_t: 23735dfecf96Smrg switch (RTYPE(op1)) { 23745dfecf96Smrg case N_FIXNUM: 23755dfecf96Smrg return (cmp_fi_fi(RFI(op1), OII(op2))); 23765dfecf96Smrg case N_BIGNUM: 23775dfecf96Smrg return (cmp_bi_fi(RBI(op1), OII(op2))); 23785dfecf96Smrg case N_FLONUM: 23795dfecf96Smrg return (cmp_flonum(RFF(op1), (double)OII(op2))); 23805dfecf96Smrg case N_FIXRATIO: 23815dfecf96Smrg return (cmp_fr_fi(RFRD(op1), RFRN(op1), OII(op2))); 23825dfecf96Smrg case N_BIGRATIO: 23835dfecf96Smrg return (cmp_br_fi(RBR(op1), OII(op2))); 23845dfecf96Smrg } 23855dfecf96Smrg break; 23865dfecf96Smrg case LispBignum_t: 23875dfecf96Smrg switch (RTYPE(op1)) { 23885dfecf96Smrg case N_FIXNUM: 23895dfecf96Smrg return (cmp_fi_bi(RFI(op1), OBI(op2))); 23905dfecf96Smrg case N_BIGNUM: 23915dfecf96Smrg return (cmp_bi_bi(RBI(op1), OBI(op2))); 23925dfecf96Smrg case N_FLONUM: 23935dfecf96Smrg return (cmp_flonum(RFF(op1), bi_getd(OBI(op2)))); 23945dfecf96Smrg case N_FIXRATIO: 23955dfecf96Smrg return (cmp_fr_bi(RFRD(op1), RFRN(op1), OBI(op2))); 23965dfecf96Smrg case N_BIGRATIO: 23975dfecf96Smrg return (cmp_br_bi(RBR(op1), OBI(op2))); 23985dfecf96Smrg } 23995dfecf96Smrg break; 24005dfecf96Smrg case LispDFloat_t: 24015dfecf96Smrg switch (RTYPE(op1)) { 24025dfecf96Smrg case N_FIXNUM: 24035dfecf96Smrg return (cmp_flonum((double)RFI(op1), ODF(op2))); 24045dfecf96Smrg case N_BIGNUM: 24055dfecf96Smrg return (cmp_flonum(bi_getd(RBI(op1)), ODF(op2))); 24065dfecf96Smrg case N_FLONUM: 24075dfecf96Smrg return (cmp_flonum(RFF(op1), ODF(op2))); 24085dfecf96Smrg case N_FIXRATIO: 24095dfecf96Smrg return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1), 24105dfecf96Smrg ODF(op2))); 24115dfecf96Smrg case N_BIGRATIO: 24125dfecf96Smrg return (cmp_flonum(br_getd(RBR(op1)), ODF(op2))); 24135dfecf96Smrg } 24145dfecf96Smrg break; 24155dfecf96Smrg case LispRatio_t: 24165dfecf96Smrg switch (RTYPE(op1)) { 24175dfecf96Smrg case N_FIXNUM: 24185dfecf96Smrg return (cmp_fi_fr(RFI(op1), OFRN(op2), OFRD(op2))); 24195dfecf96Smrg case N_BIGNUM: 24205dfecf96Smrg return (cmp_bi_fr(RBI(op1), OFRN(op2), OFRD(op2))); 24215dfecf96Smrg case N_FLONUM: 24225dfecf96Smrg return (cmp_flonum(RFF(op1), 24235dfecf96Smrg (double)OFRN(op2) / (double)OFRD(op2))); 24245dfecf96Smrg case N_FIXRATIO: 24255dfecf96Smrg return (cmp_fr_fr(RFRN(op1), RFRD(op1), 24265dfecf96Smrg OFRN(op2), OFRD(op2))); 24275dfecf96Smrg case N_BIGRATIO: 24285dfecf96Smrg return (cmp_br_fr(RBR(op1), OFRN(op2), OFRD(op2))); 24295dfecf96Smrg } 24305dfecf96Smrg break; 24315dfecf96Smrg case LispBigratio_t: 24325dfecf96Smrg switch (RTYPE(op1)) { 24335dfecf96Smrg case N_FIXNUM: 24345dfecf96Smrg return (cmp_fi_br(RFI(op1), OBR(op2))); 24355dfecf96Smrg case N_BIGNUM: 24365dfecf96Smrg return (cmp_bi_br(RBI(op1), OBR(op2))); 24375dfecf96Smrg case N_FLONUM: 24385dfecf96Smrg return (cmp_flonum(RFF(op1), br_getd(OBR(op2)))); 24395dfecf96Smrg case N_FIXRATIO: 24405dfecf96Smrg return (cmp_fr_br(RFRN(op1), RFRD(op1), OBR(op2))); 24415dfecf96Smrg case N_BIGRATIO: 24425dfecf96Smrg return (cmp_br_br(RBR(op1), OBR(op2))); 24435dfecf96Smrg } 24445dfecf96Smrg break; 24455dfecf96Smrg default: 24465dfecf96Smrg fatal_object_error(op2, NOT_A_REAL_NUMBER); 24475dfecf96Smrg break; 24485dfecf96Smrg } 24495dfecf96Smrg 24505dfecf96Smrg return (0); 24515dfecf96Smrg} 24525dfecf96Smrg 24535dfecf96Smrg#if 0 /* not used */ 24545dfecf96Smrgstatic int 24555dfecf96Smrgcmp_number_object(n_number *op1, LispObj *op2) 24565dfecf96Smrg{ 24575dfecf96Smrg if (op1->complex) { 24585dfecf96Smrg if (OBJECT_TYPE(op2) == LispComplex_t) { 24595dfecf96Smrg if (cmp_real_object(NREAL(op1), OCXR(op2)) == 0) 24605dfecf96Smrg return (cmp_real_object(NIMAG(op1), OCXI(op2))); 24615dfecf96Smrg return (1); 24625dfecf96Smrg } 24635dfecf96Smrg else if (cmp_real_real(NIMAG(op1), &zero) == 0) 24645dfecf96Smrg return (cmp_real_object(NREAL(op1), op2)); 24655dfecf96Smrg else 24665dfecf96Smrg return (1); 24675dfecf96Smrg } 24685dfecf96Smrg else { 24695dfecf96Smrg switch (OBJECT_TYPE(op2)) { 24705dfecf96Smrg case LispFixnum_t: 24715dfecf96Smrg switch (NRTYPE(op1)) { 24725dfecf96Smrg case N_FIXNUM: 24735dfecf96Smrg return (cmp_fi_fi(NRFI(op1), OFI(op2))); 24745dfecf96Smrg case N_BIGNUM: 24755dfecf96Smrg return (cmp_bi_fi(NRBI(op1), OFI(op2))); 24765dfecf96Smrg case N_FLONUM: 24775dfecf96Smrg return (cmp_flonum(NRFF(op1), (double)OFI(op2))); 24785dfecf96Smrg case N_FIXRATIO: 24795dfecf96Smrg return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OFI(op2))); 24805dfecf96Smrg case N_BIGRATIO: 24815dfecf96Smrg return (cmp_br_fi(NRBR(op1), OFI(op2))); 24825dfecf96Smrg } 24835dfecf96Smrg break; 24845dfecf96Smrg case LispInteger_t: 24855dfecf96Smrg switch (NRTYPE(op1)) { 24865dfecf96Smrg case N_FIXNUM: 24875dfecf96Smrg return (cmp_fi_fi(NRFI(op1), OII(op2))); 24885dfecf96Smrg case N_BIGNUM: 24895dfecf96Smrg return (cmp_bi_fi(NRBI(op1), OII(op2))); 24905dfecf96Smrg case N_FLONUM: 24915dfecf96Smrg return (cmp_flonum(NRFF(op1), (double)OII(op2))); 24925dfecf96Smrg case N_FIXRATIO: 24935dfecf96Smrg return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OII(op2))); 24945dfecf96Smrg case N_BIGRATIO: 24955dfecf96Smrg return (cmp_br_fi(NRBR(op1), OII(op2))); 24965dfecf96Smrg } 24975dfecf96Smrg break; 24985dfecf96Smrg case LispBignum_t: 24995dfecf96Smrg switch (NRTYPE(op1)) { 25005dfecf96Smrg case N_FIXNUM: 25015dfecf96Smrg return (cmp_fi_bi(NRFI(op1), OBI(op2))); 25025dfecf96Smrg case N_BIGNUM: 25035dfecf96Smrg return (cmp_bi_bi(NRBI(op1), OBI(op2))); 25045dfecf96Smrg case N_FLONUM: 25055dfecf96Smrg return (cmp_flonum(NRFF(op1), bi_getd(OBI(op2)))); 25065dfecf96Smrg case N_FIXRATIO: 25075dfecf96Smrg return (cmp_fr_bi(NRFRD(op1), NRFRN(op1), OBI(op2))); 25085dfecf96Smrg case N_BIGRATIO: 25095dfecf96Smrg return (cmp_br_bi(NRBR(op1), OBI(op2))); 25105dfecf96Smrg } 25115dfecf96Smrg break; 25125dfecf96Smrg case LispDFloat_t: 25135dfecf96Smrg switch (NRTYPE(op1)) { 25145dfecf96Smrg case N_FIXNUM: 25155dfecf96Smrg return (cmp_flonum((double)NRFI(op1), ODF(op2))); 25165dfecf96Smrg case N_BIGNUM: 25175dfecf96Smrg return (cmp_flonum(bi_getd(NRBI(op1)), ODF(op2))); 25185dfecf96Smrg case N_FLONUM: 25195dfecf96Smrg return (cmp_flonum(NRFF(op1), ODF(op2))); 25205dfecf96Smrg case N_FIXRATIO: 25215dfecf96Smrg return (cmp_flonum((double)NRFRN(op1) / 25225dfecf96Smrg (double)NRFRD(op1), 25235dfecf96Smrg ODF(op2))); 25245dfecf96Smrg case N_BIGRATIO: 25255dfecf96Smrg return (cmp_flonum(br_getd(NRBR(op1)), ODF(op2))); 25265dfecf96Smrg } 25275dfecf96Smrg break; 25285dfecf96Smrg case LispRatio_t: 25295dfecf96Smrg switch (NRTYPE(op1)) { 25305dfecf96Smrg case N_FIXNUM: 25315dfecf96Smrg return (cmp_fi_fr(NRFI(op1), OFRN(op2), OFRD(op2))); 25325dfecf96Smrg case N_BIGNUM: 25335dfecf96Smrg return (cmp_bi_fr(NRBI(op1), OFRN(op2), OFRD(op2))); 25345dfecf96Smrg case N_FLONUM: 25355dfecf96Smrg return (cmp_flonum(NRFF(op1), 25365dfecf96Smrg (double)OFRN(op2) / (double)OFRD(op2))); 25375dfecf96Smrg case N_FIXRATIO: 25385dfecf96Smrg return (cmp_fr_fr(NRFRN(op1), NRFRD(op1), 25395dfecf96Smrg OFRN(op2), OFRD(op2))); 25405dfecf96Smrg case N_BIGRATIO: 25415dfecf96Smrg return (cmp_br_fr(NRBR(op1), OFRN(op2), OFRD(op2))); 25425dfecf96Smrg } 25435dfecf96Smrg break; 25445dfecf96Smrg case LispBigratio_t: 25455dfecf96Smrg switch (NRTYPE(op1)) { 25465dfecf96Smrg case N_FIXNUM: 25475dfecf96Smrg return (cmp_fi_br(NRFI(op1), OBR(op2))); 25485dfecf96Smrg case N_BIGNUM: 25495dfecf96Smrg return (cmp_bi_br(NRBI(op1), OBR(op2))); 25505dfecf96Smrg case N_FLONUM: 25515dfecf96Smrg return (cmp_flonum(NRFF(op1), br_getd(OBR(op2)))); 25525dfecf96Smrg case N_FIXRATIO: 25535dfecf96Smrg return (cmp_fr_br(NRFRN(op1), NRFRD(op1), OBR(op2))); 25545dfecf96Smrg case N_BIGRATIO: 25555dfecf96Smrg return (cmp_br_br(NRBR(op1), OBR(op2))); 25565dfecf96Smrg } 25575dfecf96Smrg break; 25585dfecf96Smrg case LispComplex_t: 25595dfecf96Smrg if (cmp_real_object(&zero, OCXI(op2)) == 0) 25605dfecf96Smrg return (cmp_real_object(NREAL(op1), OCXR(op2))); 25615dfecf96Smrg return (1); 25625dfecf96Smrg default: 25635dfecf96Smrg fatal_object_error(op2, NOT_A_NUMBER); 25645dfecf96Smrg break; 25655dfecf96Smrg } 25665dfecf96Smrg } 25675dfecf96Smrg 25685dfecf96Smrg return (0); 25695dfecf96Smrg} 25705dfecf96Smrg#endif 25715dfecf96Smrg 25725dfecf96Smrgstatic int 25735dfecf96Smrgcmp_object_object(LispObj *op1, LispObj *op2, int real) 25745dfecf96Smrg{ 25755dfecf96Smrg if (OBJECT_TYPE(op1) == LispComplex_t) { 25765dfecf96Smrg if (real) 25775dfecf96Smrg fatal_object_error(op1, NOT_A_REAL_NUMBER); 25785dfecf96Smrg if (OBJECT_TYPE(op2) == LispComplex_t) 25795dfecf96Smrg return (cmp_cx_cx(op1, op2)); 25805dfecf96Smrg else if (cmp_real_object(&zero, OCXI(op1)) == 0) 25815dfecf96Smrg return (cmp_object_object(OCXR(op1), op2, real)); 25825dfecf96Smrg return (1); 25835dfecf96Smrg } 25845dfecf96Smrg else if (OBJECT_TYPE(op2) == LispComplex_t) { 25855dfecf96Smrg if (real) 25865dfecf96Smrg fatal_object_error(op1, NOT_A_REAL_NUMBER); 25875dfecf96Smrg if (cmp_real_object(&zero, OCXI(op2)) == 0) 25885dfecf96Smrg return (cmp_object_object(op1, OCXR(op2), real)); 25895dfecf96Smrg return (1); 25905dfecf96Smrg } 25915dfecf96Smrg else { 25925dfecf96Smrg switch (OBJECT_TYPE(op1)) { 25935dfecf96Smrg case LispFixnum_t: 25945dfecf96Smrg switch (OBJECT_TYPE(op2)) { 25955dfecf96Smrg case LispFixnum_t: 25965dfecf96Smrg return (cmp_fi_fi(OFI(op1), OFI(op2))); 25975dfecf96Smrg case LispInteger_t: 25985dfecf96Smrg return (cmp_fi_fi(OFI(op1), OII(op2))); 25995dfecf96Smrg case LispBignum_t: 26005dfecf96Smrg return (cmp_fi_bi(OFI(op1), OBI(op2))); 26015dfecf96Smrg case LispDFloat_t: 26025dfecf96Smrg return (cmp_flonum((double)OFI(op1), ODF(op2))); 26035dfecf96Smrg case LispRatio_t: 26045dfecf96Smrg return (cmp_fi_fr(OFI(op1), 26055dfecf96Smrg OFRN(op2), OFRD(op2))); 26065dfecf96Smrg case LispBigratio_t: 26075dfecf96Smrg return (cmp_fi_br(OFI(op1), OBR(op2))); 26085dfecf96Smrg default: 26095dfecf96Smrg break; 26105dfecf96Smrg } 26115dfecf96Smrg break; 26125dfecf96Smrg case LispInteger_t: 26135dfecf96Smrg switch (OBJECT_TYPE(op2)) { 26145dfecf96Smrg case LispFixnum_t: 26155dfecf96Smrg return (cmp_fi_fi(OII(op1), OFI(op2))); 26165dfecf96Smrg case LispInteger_t: 26175dfecf96Smrg return (cmp_fi_fi(OII(op1), OII(op2))); 26185dfecf96Smrg case LispBignum_t: 26195dfecf96Smrg return (cmp_fi_bi(OII(op1), OBI(op2))); 26205dfecf96Smrg case LispDFloat_t: 26215dfecf96Smrg return (cmp_flonum((double)OII(op1), ODF(op2))); 26225dfecf96Smrg case LispRatio_t: 26235dfecf96Smrg return (cmp_fi_fr(OII(op1), 26245dfecf96Smrg OFRN(op2), OFRD(op2))); 26255dfecf96Smrg case LispBigratio_t: 26265dfecf96Smrg return (cmp_fi_br(OII(op1), OBR(op2))); 26275dfecf96Smrg default: 26285dfecf96Smrg break; 26295dfecf96Smrg } 26305dfecf96Smrg break; 26315dfecf96Smrg case LispBignum_t: 26325dfecf96Smrg switch (OBJECT_TYPE(op2)) { 26335dfecf96Smrg case LispFixnum_t: 26345dfecf96Smrg return (cmp_bi_fi(OBI(op1), OFI(op2))); 26355dfecf96Smrg case LispInteger_t: 26365dfecf96Smrg return (cmp_bi_fi(OBI(op1), OII(op2))); 26375dfecf96Smrg case LispBignum_t: 26385dfecf96Smrg return (cmp_bi_bi(OBI(op1), OBI(op2))); 26395dfecf96Smrg case LispDFloat_t: 26405dfecf96Smrg return (cmp_flonum(bi_getd(OBI(op1)), ODF(op2))); 26415dfecf96Smrg case LispRatio_t: 26425dfecf96Smrg return (cmp_bi_fr(OBI(op1), 26435dfecf96Smrg OFRN(op2), OFRD(op2))); 26445dfecf96Smrg case LispBigratio_t: 26455dfecf96Smrg return (cmp_bi_br(OBI(op1), OBR(op2))); 26465dfecf96Smrg default: 26475dfecf96Smrg break; 26485dfecf96Smrg } 26495dfecf96Smrg break; 26505dfecf96Smrg case LispDFloat_t: 26515dfecf96Smrg switch (OBJECT_TYPE(op2)) { 26525dfecf96Smrg case LispFixnum_t: 26535dfecf96Smrg return (cmp_flonum(ODF(op1), (double)OFI(op2))); 26545dfecf96Smrg case LispInteger_t: 26555dfecf96Smrg return (cmp_flonum(ODF(op1), (double)OII(op2))); 26565dfecf96Smrg case LispBignum_t: 26575dfecf96Smrg return (cmp_flonum(ODF(op1), bi_getd(OBI(op2)))); 26585dfecf96Smrg case LispDFloat_t: 26595dfecf96Smrg return (cmp_flonum(ODF(op1), ODF(op2))); 26605dfecf96Smrg break; 26615dfecf96Smrg case LispRatio_t: 26625dfecf96Smrg return (cmp_flonum(ODF(op1), 26635dfecf96Smrg (double)OFRN(op2) / 26645dfecf96Smrg (double)OFRD(op2))); 26655dfecf96Smrg case LispBigratio_t: 26665dfecf96Smrg return (cmp_flonum(ODF(op1), br_getd(OBR(op2)))); 26675dfecf96Smrg default: 26685dfecf96Smrg break; 26695dfecf96Smrg } 26705dfecf96Smrg break; 26715dfecf96Smrg case LispRatio_t: 26725dfecf96Smrg switch (OBJECT_TYPE(op2)) { 26735dfecf96Smrg case LispFixnum_t: 26745dfecf96Smrg return (cmp_fr_fi(OFRN(op1), OFRD(op1), OFI(op2))); 26755dfecf96Smrg case LispInteger_t: 26765dfecf96Smrg return (cmp_fr_fi(OFRN(op1), OFRD(op1), OII(op2))); 26775dfecf96Smrg case LispBignum_t: 26785dfecf96Smrg return (cmp_fr_bi(OFRN(op1), OFRD(op1), OBI(op2))); 26795dfecf96Smrg case LispDFloat_t: 26805dfecf96Smrg return (cmp_flonum((double)OFRN(op1) / 26815dfecf96Smrg (double)OFRD(op1), 26825dfecf96Smrg ODF(op2))); 26835dfecf96Smrg case LispRatio_t: 26845dfecf96Smrg return (cmp_fr_fr(OFRN(op1), OFRD(op1), 26855dfecf96Smrg OFRN(op2), OFRD(op2))); 26865dfecf96Smrg case LispBigratio_t: 26875dfecf96Smrg return (cmp_fr_br(OFRN(op1), OFRD(op1), OBR(op2))); 26885dfecf96Smrg default: 26895dfecf96Smrg break; 26905dfecf96Smrg } 26915dfecf96Smrg break; 26925dfecf96Smrg case LispBigratio_t: 26935dfecf96Smrg switch (OBJECT_TYPE(op2)) { 26945dfecf96Smrg case LispFixnum_t: 26955dfecf96Smrg return (cmp_br_fi(OBR(op1), OFI(op2))); 26965dfecf96Smrg case LispInteger_t: 26975dfecf96Smrg return (cmp_br_fi(OBR(op1), OII(op2))); 26985dfecf96Smrg case LispBignum_t: 26995dfecf96Smrg return (cmp_br_bi(OBR(op1), OBI(op2))); 27005dfecf96Smrg case LispDFloat_t: 27015dfecf96Smrg return (cmp_flonum(br_getd(OBR(op1)), ODF(op2))); 27025dfecf96Smrg case LispRatio_t: 27035dfecf96Smrg return (cmp_br_fr(OBR(op1), OFRN(op2), OFRD(op2))); 27045dfecf96Smrg case LispBigratio_t: 27055dfecf96Smrg return (cmp_br_br(OBR(op1), OBR(op2))); 27065dfecf96Smrg default: 27075dfecf96Smrg break; 27085dfecf96Smrg } 27095dfecf96Smrg break; 27105dfecf96Smrg default: 27115dfecf96Smrg fatal_object_error(op1, NOT_A_NUMBER); 27125dfecf96Smrg break; 27135dfecf96Smrg } 27145dfecf96Smrg } 27155dfecf96Smrg 27165dfecf96Smrg fatal_object_error(op2, NOT_A_NUMBER); 27175dfecf96Smrg return (0); 27185dfecf96Smrg} 27195dfecf96Smrg 27205dfecf96Smrg 27215dfecf96Smrg/************************************************************************ 27225dfecf96Smrg * FIXNUM 27235dfecf96Smrg ************************************************************************/ 27245dfecf96Smrg/* 27255dfecf96Smrg * check if op1 + op2 will overflow 27265dfecf96Smrg */ 27275dfecf96Smrgstatic INLINE int 27285dfecf96Smrgfi_fi_add_overflow(long op1, long op2) 27295dfecf96Smrg{ 27305dfecf96Smrg long op = op1 + op2; 27315dfecf96Smrg 273231de2854Smrg return (op2 >= 0 ? op < op1 : op > op1); 27335dfecf96Smrg} 27345dfecf96Smrg 27355dfecf96Smrg/* 27365dfecf96Smrg * check if op1 - op2 will overflow 27375dfecf96Smrg */ 27385dfecf96Smrgstatic INLINE int 27395dfecf96Smrgfi_fi_sub_overflow(long op1, long op2) 27405dfecf96Smrg{ 27415dfecf96Smrg long op = op1 - op2; 27425dfecf96Smrg 274331de2854Smrg return (op2 >= 0 ? op > op1 : op < op1); 27445dfecf96Smrg} 27455dfecf96Smrg 27465dfecf96Smrg/* 27475dfecf96Smrg * check if op1 * op2 will overflow 27485dfecf96Smrg */ 27495dfecf96Smrgstatic INLINE int 27505dfecf96Smrgfi_fi_mul_overflow(long op1, long op2) 27515dfecf96Smrg{ 27525dfecf96Smrg if (op1 == 0 || op1 == 1 || op2 == 0 || op2 == 1) 27535dfecf96Smrg return (0); 27545dfecf96Smrg if (op1 == MINSLONG || op2 == MINSLONG) 27555dfecf96Smrg return (1); 27565dfecf96Smrg if (op1 < 0) 27575dfecf96Smrg op1 = -op1; 27585dfecf96Smrg if (op2 < 0) 27595dfecf96Smrg op2 = -op2; 276031de2854Smrg return (op1 > MAXSLONG / op2); 27615dfecf96Smrg} 27625dfecf96Smrg 27635dfecf96Smrg 27645dfecf96Smrg/************************************************************************ 27655dfecf96Smrg * BIGNUM 27665dfecf96Smrg ************************************************************************/ 27675dfecf96Smrgstatic void 27685dfecf96Smrgrbi_canonicalize(n_real *real) 27695dfecf96Smrg{ 27705dfecf96Smrg if (mpi_fiti(RBI(real))) { 27715dfecf96Smrg long fi = mpi_geti(RBI(real)); 27725dfecf96Smrg 27735dfecf96Smrg RTYPE(real) = N_FIXNUM; 27745dfecf96Smrg mpi_clear(RBI(real)); 27755dfecf96Smrg XFREE(RBI(real)); 27765dfecf96Smrg RFI(real) = fi; 27775dfecf96Smrg } 27785dfecf96Smrg} 27795dfecf96Smrg 27805dfecf96Smrg 27815dfecf96Smrg/************************************************************************ 27825dfecf96Smrg * RATIO 27835dfecf96Smrg ************************************************************************/ 27845dfecf96Smrgstatic void 27855dfecf96Smrgrfr_canonicalize(n_real *real) 27865dfecf96Smrg{ 27875dfecf96Smrg long num, numerator, den, denominator, rest; 27885dfecf96Smrg 27895dfecf96Smrg num = numerator = RFRN(real); 27905dfecf96Smrg den = denominator = RFRD(real); 27915dfecf96Smrg if (denominator == 0) 27925dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 27935dfecf96Smrg 27945dfecf96Smrg if (num == MINSLONG || den == MINSLONG) { 27955dfecf96Smrg mpr *bigratio = XALLOC(mpr); 27965dfecf96Smrg 27975dfecf96Smrg mpr_init(bigratio); 27985dfecf96Smrg mpr_seti(bigratio, num, den); 27995dfecf96Smrg RTYPE(real) = N_BIGRATIO; 28005dfecf96Smrg RBR(real) = bigratio; 28015dfecf96Smrg rbr_canonicalize(real); 28025dfecf96Smrg return; 28035dfecf96Smrg } 28045dfecf96Smrg 28055dfecf96Smrg if (num < 0) 28065dfecf96Smrg num = -num; 28075dfecf96Smrg else if (num == 0) { 28085dfecf96Smrg RFI(real) = 0; 28095dfecf96Smrg RTYPE(real) = N_FIXNUM; 28105dfecf96Smrg return; 28115dfecf96Smrg } 28125dfecf96Smrg for (;;) { 28135dfecf96Smrg if ((rest = den % num) == 0) 28145dfecf96Smrg break; 28155dfecf96Smrg den = num; 28165dfecf96Smrg num = rest; 28175dfecf96Smrg } 28185dfecf96Smrg if (den != 1) { 28195dfecf96Smrg denominator /= num; 28205dfecf96Smrg numerator /= num; 28215dfecf96Smrg } 28225dfecf96Smrg if (denominator < 0) { 28235dfecf96Smrg numerator = -numerator; 28245dfecf96Smrg denominator = -denominator; 28255dfecf96Smrg } 28265dfecf96Smrg if (denominator == 1) { 28275dfecf96Smrg RTYPE(real) = N_FIXNUM; 28285dfecf96Smrg RFI(real) = numerator; 28295dfecf96Smrg } 28305dfecf96Smrg else { 28315dfecf96Smrg RFRN(real) = numerator; 28325dfecf96Smrg RFRD(real) = denominator; 28335dfecf96Smrg } 28345dfecf96Smrg} 28355dfecf96Smrg 28365dfecf96Smrgstatic void 28375dfecf96Smrgrbr_canonicalize(n_real *real) 28385dfecf96Smrg{ 28395dfecf96Smrg int fitnum, fitden; 28405dfecf96Smrg long numerator, denominator; 28415dfecf96Smrg 28425dfecf96Smrg mpr_canonicalize(RBR(real)); 28435dfecf96Smrg fitnum = mpi_fiti(RBRN(real)); 28445dfecf96Smrg fitden = mpi_fiti(RBRD(real)); 28455dfecf96Smrg if (fitnum && fitden) { 28465dfecf96Smrg numerator = mpi_geti(RBRN(real)); 28475dfecf96Smrg denominator = mpi_geti(RBRD(real)); 28485dfecf96Smrg mpr_clear(RBR(real)); 28495dfecf96Smrg XFREE(RBR(real)); 28505dfecf96Smrg if (numerator == 0) { 28515dfecf96Smrg RFI(real) = 0; 28525dfecf96Smrg RTYPE(real) = N_FIXNUM; 28535dfecf96Smrg } 28545dfecf96Smrg else if (denominator == 1) { 28555dfecf96Smrg RTYPE(real) = N_FIXNUM; 28565dfecf96Smrg RFI(real) = numerator; 28575dfecf96Smrg } 28585dfecf96Smrg else { 28595dfecf96Smrg RTYPE(real) = N_FIXRATIO; 28605dfecf96Smrg RFRN(real) = numerator; 28615dfecf96Smrg RFRD(real) = denominator; 28625dfecf96Smrg } 28635dfecf96Smrg } 28645dfecf96Smrg else if (fitden) { 28655dfecf96Smrg denominator = mpi_geti(RBRD(real)); 28665dfecf96Smrg if (denominator == 1) { 28675dfecf96Smrg mpi *bigi = XALLOC(mpi); 28685dfecf96Smrg 28695dfecf96Smrg mpi_init(bigi); 28705dfecf96Smrg mpi_set(bigi, RBRN(real)); 28715dfecf96Smrg mpr_clear(RBR(real)); 28725dfecf96Smrg XFREE(RBR(real)); 28735dfecf96Smrg RTYPE(real) = N_BIGNUM; 28745dfecf96Smrg RBI(real) = bigi; 28755dfecf96Smrg } 28765dfecf96Smrg else if (denominator == 0) 28775dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 28785dfecf96Smrg } 28795dfecf96Smrg} 28805dfecf96Smrg 28815dfecf96Smrg 28825dfecf96Smrg/************************************************************************ 28835dfecf96Smrg * COMPLEX 28845dfecf96Smrg ************************************************************************/ 28855dfecf96Smrgstatic void 28865dfecf96Smrgncx_canonicalize(n_number *num) 28875dfecf96Smrg{ 28885dfecf96Smrg if (NITYPE(num) == N_FIXNUM && NIFI(num) == 0) 28895dfecf96Smrg num->complex = 0; 28905dfecf96Smrg} 28915dfecf96Smrg 28925dfecf96Smrg 28935dfecf96Smrg/************************************************************************ 28945dfecf96Smrg * DIVIDE 28955dfecf96Smrg ************************************************************************/ 28965dfecf96Smrg#define NDIVIDE_NOP 0 28975dfecf96Smrg#define NDIVIDE_ADD 1 28985dfecf96Smrg#define NDIVIDE_SUB 2 28995dfecf96Smrgstatic void 29005dfecf96Smrgndivide_fi_fi(n_number *num, long div, int fun, int flo) 29015dfecf96Smrg{ 29025dfecf96Smrg long quo, rem; 29035dfecf96Smrg 29045dfecf96Smrg if (NRFI(num) == MINSLONG || div == MINSLONG) { 29055dfecf96Smrg LispObj integer; 29065dfecf96Smrg mpi *bignum = XALLOC(mpi); 29075dfecf96Smrg 29085dfecf96Smrg mpi_init(bignum); 29095dfecf96Smrg mpi_seti(bignum, NRFI(num)); 29105dfecf96Smrg NRBI(num) = bignum; 29115dfecf96Smrg NRTYPE(num) = N_BIGNUM; 29125dfecf96Smrg integer.type = LispInteger_t; 29135dfecf96Smrg integer.data.integer = div; 29145dfecf96Smrg ndivide_xi_xi(num, &integer, fun, flo); 29155dfecf96Smrg return; 29165dfecf96Smrg } 29175dfecf96Smrg else { 29185dfecf96Smrg quo = NRFI(num) / div; 29195dfecf96Smrg rem = NRFI(num) % div; 29205dfecf96Smrg } 29215dfecf96Smrg 29225dfecf96Smrg switch (fun) { 29235dfecf96Smrg case NDIVIDE_CEIL: 29245dfecf96Smrg if ((rem < 0 && div < 0) || (rem > 0 && div > 0)) { 29255dfecf96Smrg ++quo; 29265dfecf96Smrg rem -= div; 29275dfecf96Smrg } 29285dfecf96Smrg break; 29295dfecf96Smrg case NDIVIDE_FLOOR: 29305dfecf96Smrg if ((rem < 0 && div > 0) || (rem > 0 && div < 0)) { 29315dfecf96Smrg --quo; 29325dfecf96Smrg rem += div; 29335dfecf96Smrg } 29345dfecf96Smrg break; 29355dfecf96Smrg case NDIVIDE_ROUND: 29365dfecf96Smrg if (div > 0) { 29375dfecf96Smrg if (rem > 0) { 29385dfecf96Smrg if (rem >= (div + 1) / 2) { 29395dfecf96Smrg ++quo; 29405dfecf96Smrg rem -= div; 29415dfecf96Smrg } 29425dfecf96Smrg } 29435dfecf96Smrg else { 29445dfecf96Smrg if (rem <= (-div - 1) / 2) { 29455dfecf96Smrg --quo; 29465dfecf96Smrg rem += div; 29475dfecf96Smrg } 29485dfecf96Smrg } 29495dfecf96Smrg } 29505dfecf96Smrg else { 29515dfecf96Smrg if (rem > 0) { 29525dfecf96Smrg if (rem >= (-div + 1) / 2) { 29535dfecf96Smrg --quo; 29545dfecf96Smrg rem += div; 29555dfecf96Smrg } 29565dfecf96Smrg } 29575dfecf96Smrg else { 29585dfecf96Smrg if (rem <= (div - 1) / 2) { 29595dfecf96Smrg ++quo; 29605dfecf96Smrg rem -= div; 29615dfecf96Smrg } 29625dfecf96Smrg } 29635dfecf96Smrg } 29645dfecf96Smrg break; 29655dfecf96Smrg } 29665dfecf96Smrg 29675dfecf96Smrg NITYPE(num) = N_FIXNUM; 29685dfecf96Smrg NIFI(num) = rem; 29695dfecf96Smrg if (flo) { 29705dfecf96Smrg NRTYPE(num) = N_FLONUM; 29715dfecf96Smrg NRFF(num) = (double)quo; 29725dfecf96Smrg } 29735dfecf96Smrg else 29745dfecf96Smrg NRFI(num) = quo; 29755dfecf96Smrg} 29765dfecf96Smrg 29775dfecf96Smrgstatic void 29785dfecf96Smrgndivide_xi_xi(n_number *num, LispObj *div, int fun, int flo) 29795dfecf96Smrg{ 29805dfecf96Smrg LispType type = OBJECT_TYPE(div); 29815dfecf96Smrg int state = NDIVIDE_NOP, dsign, rsign; 29825dfecf96Smrg mpi *quo, *rem; 29835dfecf96Smrg 29845dfecf96Smrg quo = XALLOC(mpi); 29855dfecf96Smrg mpi_init(quo); 29865dfecf96Smrg if (NRTYPE(num) == N_FIXNUM) 29875dfecf96Smrg mpi_seti(quo, NRFI(num)); 29885dfecf96Smrg else 29895dfecf96Smrg mpi_set(quo, NRBI(num)); 29905dfecf96Smrg 29915dfecf96Smrg rem = XALLOC(mpi); 29925dfecf96Smrg mpi_init(rem); 29935dfecf96Smrg 29945dfecf96Smrg switch (type) { 29955dfecf96Smrg case LispFixnum_t: 29965dfecf96Smrg mpi_seti(rem, OFI(div)); 29975dfecf96Smrg break; 29985dfecf96Smrg case LispInteger_t: 29995dfecf96Smrg mpi_seti(rem, OII(div)); 30005dfecf96Smrg break; 30015dfecf96Smrg default: 30025dfecf96Smrg mpi_set(rem, OBI(div)); 30035dfecf96Smrg } 30045dfecf96Smrg 30055dfecf96Smrg dsign = mpi_sgn(rem); 30065dfecf96Smrg 30075dfecf96Smrg mpi_divqr(quo, rem, quo, rem); 30085dfecf96Smrg rsign = mpi_sgn(rem); 30095dfecf96Smrg 30105dfecf96Smrg switch (fun) { 30115dfecf96Smrg case NDIVIDE_CEIL: 30125dfecf96Smrg if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0)) 30135dfecf96Smrg state = NDIVIDE_ADD; 30145dfecf96Smrg break; 30155dfecf96Smrg case NDIVIDE_FLOOR: 30165dfecf96Smrg if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0)) 30175dfecf96Smrg state = NDIVIDE_SUB; 30185dfecf96Smrg break; 30195dfecf96Smrg case NDIVIDE_ROUND: { 30205dfecf96Smrg mpi test; 30215dfecf96Smrg 30225dfecf96Smrg mpi_init(&test); 30235dfecf96Smrg switch (type) { 30245dfecf96Smrg case LispFixnum_t: 30255dfecf96Smrg mpi_seti(&test, OFI(div)); 30265dfecf96Smrg break; 30275dfecf96Smrg case LispInteger_t: 30285dfecf96Smrg mpi_seti(&test, OII(div)); 30295dfecf96Smrg break; 30305dfecf96Smrg default: 30315dfecf96Smrg mpi_set(&test, OBI(div)); 30325dfecf96Smrg } 30335dfecf96Smrg if (dsign > 0) { 30345dfecf96Smrg if (rsign > 0) { 30355dfecf96Smrg mpi_addi(&test, &test, 1); 30365dfecf96Smrg mpi_divi(&test, &test, 2); 30375dfecf96Smrg if (mpi_cmp(rem, &test) >= 0) 30385dfecf96Smrg state = NDIVIDE_ADD; 30395dfecf96Smrg } 30405dfecf96Smrg else { 30415dfecf96Smrg mpi_neg(&test, &test); 30425dfecf96Smrg mpi_subi(&test, &test, 1); 30435dfecf96Smrg mpi_divi(&test, &test, 2); 30445dfecf96Smrg if (mpi_cmp(rem, &test) <= 0) 30455dfecf96Smrg state = NDIVIDE_SUB; 30465dfecf96Smrg } 30475dfecf96Smrg } 30485dfecf96Smrg else { 30495dfecf96Smrg if (rsign > 0) { 30505dfecf96Smrg mpi_neg(&test, &test); 30515dfecf96Smrg mpi_addi(&test, &test, 1); 30525dfecf96Smrg mpi_divi(&test, &test, 2); 30535dfecf96Smrg if (mpi_cmp(rem, &test) >= 0) 30545dfecf96Smrg state = NDIVIDE_SUB; 30555dfecf96Smrg } 30565dfecf96Smrg else { 30575dfecf96Smrg mpi_subi(&test, &test, 1); 30585dfecf96Smrg mpi_divi(&test, &test, 2); 30595dfecf96Smrg if (mpi_cmp(rem, &test) <= 0) 30605dfecf96Smrg state = NDIVIDE_ADD; 30615dfecf96Smrg } 30625dfecf96Smrg } 30635dfecf96Smrg mpi_clear(&test); 30645dfecf96Smrg } break; 30655dfecf96Smrg } 30665dfecf96Smrg 30675dfecf96Smrg if (state == NDIVIDE_ADD) { 30685dfecf96Smrg mpi_addi(quo, quo, 1); 30695dfecf96Smrg switch (type) { 30705dfecf96Smrg case LispFixnum_t: 30715dfecf96Smrg mpi_subi(rem, rem, OFI(div)); 30725dfecf96Smrg break; 30735dfecf96Smrg case LispInteger_t: 30745dfecf96Smrg mpi_subi(rem, rem, OII(div)); 30755dfecf96Smrg break; 30765dfecf96Smrg default: 30775dfecf96Smrg mpi_sub(rem, rem, OBI(div)); 30785dfecf96Smrg } 30795dfecf96Smrg } 30805dfecf96Smrg else if (state == NDIVIDE_SUB) { 30815dfecf96Smrg mpi_subi(quo, quo, 1); 30825dfecf96Smrg switch (type) { 30835dfecf96Smrg case LispFixnum_t: 30845dfecf96Smrg mpi_addi(rem, rem, OFI(div)); 30855dfecf96Smrg break; 30865dfecf96Smrg case LispInteger_t: 30875dfecf96Smrg mpi_addi(rem, rem, OII(div)); 30885dfecf96Smrg break; 30895dfecf96Smrg default: 30905dfecf96Smrg mpi_add(rem, rem, OBI(div)); 30915dfecf96Smrg } 30925dfecf96Smrg } 30935dfecf96Smrg 30945dfecf96Smrg if (mpi_fiti(rem)) { 30955dfecf96Smrg NITYPE(num) = N_FIXNUM; 30965dfecf96Smrg NIFI(num) = mpi_geti(rem); 30975dfecf96Smrg mpi_clear(rem); 30985dfecf96Smrg XFREE(rem); 30995dfecf96Smrg } 31005dfecf96Smrg else { 31015dfecf96Smrg NITYPE(num) = N_BIGNUM; 31025dfecf96Smrg NIBI(num) = rem; 31035dfecf96Smrg } 31045dfecf96Smrg 31055dfecf96Smrg clear_real(NREAL(num)); 31065dfecf96Smrg 31075dfecf96Smrg if (flo) { 31085dfecf96Smrg double dval = bi_getd(quo); 31095dfecf96Smrg 31105dfecf96Smrg mpi_clear(quo); 31115dfecf96Smrg XFREE(quo); 31125dfecf96Smrg NRTYPE(num) = N_FLONUM; 31135dfecf96Smrg NRFF(num) = dval; 31145dfecf96Smrg } 31155dfecf96Smrg else { 31165dfecf96Smrg NRTYPE(num) = N_BIGNUM; 31175dfecf96Smrg NRBI(num) = quo; 31185dfecf96Smrg rbi_canonicalize(NREAL(num)); 31195dfecf96Smrg } 31205dfecf96Smrg} 31215dfecf96Smrg 31225dfecf96Smrgstatic void 31235dfecf96Smrgndivide_flonum(n_number *number, double num, double div, int fun, int flo) 31245dfecf96Smrg{ 31255dfecf96Smrg double quo, rem, modp, tmp; 31265dfecf96Smrg 31275dfecf96Smrg modp = modf(num / div, &quo); 31285dfecf96Smrg rem = num - quo * div; 31295dfecf96Smrg 31305dfecf96Smrg switch (fun) { 31315dfecf96Smrg case NDIVIDE_CEIL: 31325dfecf96Smrg if ((rem < 0.0 && div < 0.0) || (rem > 0.0 && div > 0.0)) { 31335dfecf96Smrg quo += 1.0; 31345dfecf96Smrg rem -= div; 31355dfecf96Smrg } 31365dfecf96Smrg break; 31375dfecf96Smrg case NDIVIDE_FLOOR: 31385dfecf96Smrg if ((rem < 0.0 && div > 0.0) || (rem > 0.0 && div < 0.0)) { 31395dfecf96Smrg quo -= 1.0; 31405dfecf96Smrg rem += div; 31415dfecf96Smrg } 31425dfecf96Smrg break; 31435dfecf96Smrg case NDIVIDE_ROUND: 31445dfecf96Smrg if (fabs(modp) != 0.5 || modf(quo * 0.5, &tmp) != 0.0) { 31455dfecf96Smrg if (div > 0.0) { 31465dfecf96Smrg if (rem > 0.0) { 31475dfecf96Smrg if (rem >= div * 0.5) { 31485dfecf96Smrg quo += 1.0; 31495dfecf96Smrg rem -= div; 31505dfecf96Smrg } 31515dfecf96Smrg } 31525dfecf96Smrg else { 31535dfecf96Smrg if (rem <= div * -0.5) { 31545dfecf96Smrg quo -= 1.0; 31555dfecf96Smrg rem += div; 31565dfecf96Smrg } 31575dfecf96Smrg } 31585dfecf96Smrg } 31595dfecf96Smrg else { 31605dfecf96Smrg if (rem > 0.0) { 31615dfecf96Smrg if (rem >= div * -0.5) { 31625dfecf96Smrg quo -= 1.0; 31635dfecf96Smrg rem += div; 31645dfecf96Smrg } 31655dfecf96Smrg } 31665dfecf96Smrg else { 31675dfecf96Smrg if (rem <= div * 0.5) { 31685dfecf96Smrg quo += 1.0; 31695dfecf96Smrg rem -= div; 31705dfecf96Smrg } 31715dfecf96Smrg } 31725dfecf96Smrg } 31735dfecf96Smrg } 31745dfecf96Smrg break; 31755dfecf96Smrg } 31765dfecf96Smrg if (!finite(quo) || !finite(rem)) 31775dfecf96Smrg fatal_error(FLOATING_POINT_OVERFLOW); 31785dfecf96Smrg 31795dfecf96Smrg NITYPE(number) = N_FLONUM; 31805dfecf96Smrg NIFF(number) = rem; 31815dfecf96Smrg 31825dfecf96Smrg clear_real(NREAL(number)); 31835dfecf96Smrg 31845dfecf96Smrg if (flo) { 31855dfecf96Smrg NRTYPE(number) = N_FLONUM; 31865dfecf96Smrg NRFF(number) = quo; 31875dfecf96Smrg } 31885dfecf96Smrg else { 31895dfecf96Smrg if ((long)quo == quo) { 31905dfecf96Smrg NRTYPE(number) = N_FIXNUM; 31915dfecf96Smrg NRFI(number) = (long)quo; 31925dfecf96Smrg } 31935dfecf96Smrg else { 31945dfecf96Smrg mpi *bigi = XALLOC(mpi); 31955dfecf96Smrg 31965dfecf96Smrg mpi_init(bigi); 31975dfecf96Smrg mpi_setd(bigi, quo); 31985dfecf96Smrg NRBI(number) = bigi; 31995dfecf96Smrg NRTYPE(number) = N_BIGNUM; 32005dfecf96Smrg } 32015dfecf96Smrg } 32025dfecf96Smrg} 32035dfecf96Smrg 32045dfecf96Smrgstatic void 32055dfecf96Smrgndivide_xi_xr(n_number *num, LispObj *div, int fun, int flo) 32065dfecf96Smrg{ 32075dfecf96Smrg int state = NDIVIDE_NOP, dsign, rsign; 32085dfecf96Smrg mpi *quo; 32095dfecf96Smrg mpr *rem; 32105dfecf96Smrg 32115dfecf96Smrg quo = XALLOC(mpi); 32125dfecf96Smrg mpi_init(quo); 32135dfecf96Smrg if (NRTYPE(num) == N_FIXNUM) 32145dfecf96Smrg mpi_seti(quo, NRFI(num)); 32155dfecf96Smrg else 32165dfecf96Smrg mpi_set(quo, NRBI(num)); 32175dfecf96Smrg 32185dfecf96Smrg rem = XALLOC(mpr); 32195dfecf96Smrg mpr_init(rem); 32205dfecf96Smrg 32215dfecf96Smrg if (XOBJECT_TYPE(div) == LispRatio_t) 32225dfecf96Smrg mpr_seti(rem, OFRN(div), OFRD(div)); 32235dfecf96Smrg else 32245dfecf96Smrg mpr_set(rem, OBR(div)); 32255dfecf96Smrg dsign = mpi_sgn(mpr_num(rem)); 32265dfecf96Smrg mpi_mul(quo, quo, mpr_den(rem)); 32275dfecf96Smrg 32285dfecf96Smrg mpi_divqr(quo, mpr_num(rem), quo, mpr_num(rem)); 32295dfecf96Smrg mpr_canonicalize(rem); 32305dfecf96Smrg 32315dfecf96Smrg rsign = mpi_sgn(mpr_num(rem)); 32325dfecf96Smrg if (mpr_fiti(rem)) { 32335dfecf96Smrg if (mpi_geti(mpr_den(rem)) == 1) { 32345dfecf96Smrg NITYPE(num) = N_FIXNUM; 32355dfecf96Smrg NIFI(num) = mpi_geti(mpr_num(rem)); 32365dfecf96Smrg } 32375dfecf96Smrg else { 32385dfecf96Smrg NITYPE(num) = N_FIXRATIO; 32395dfecf96Smrg NIFRN(num) = mpi_geti(mpr_num(rem)); 32405dfecf96Smrg NIFRD(num) = mpi_geti(mpr_den(rem)); 32415dfecf96Smrg } 32425dfecf96Smrg mpr_clear(rem); 32435dfecf96Smrg XFREE(rem); 32445dfecf96Smrg } 32455dfecf96Smrg else { 32465dfecf96Smrg if (mpi_fiti(mpr_den(rem)) && mpi_geti(mpr_den(rem)) == 1) { 32475dfecf96Smrg NITYPE(num) = N_BIGNUM; 32485dfecf96Smrg NIBI(num) = mpr_num(rem); 32495dfecf96Smrg mpi_clear(mpr_den(rem)); 32505dfecf96Smrg XFREE(rem); 32515dfecf96Smrg } 32525dfecf96Smrg else { 32535dfecf96Smrg NITYPE(num) = N_BIGRATIO; 32545dfecf96Smrg NIBR(num) = rem; 32555dfecf96Smrg } 32565dfecf96Smrg } 32575dfecf96Smrg 32585dfecf96Smrg switch (fun) { 32595dfecf96Smrg case NDIVIDE_CEIL: 32605dfecf96Smrg if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0)) 32615dfecf96Smrg state = NDIVIDE_ADD; 32625dfecf96Smrg break; 32635dfecf96Smrg case NDIVIDE_FLOOR: 32645dfecf96Smrg if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0)) 32655dfecf96Smrg state = NDIVIDE_SUB; 32665dfecf96Smrg break; 32675dfecf96Smrg case NDIVIDE_ROUND: { 32685dfecf96Smrg n_real cmp; 32695dfecf96Smrg 32705dfecf96Smrg set_real_object(&cmp, div); 32715dfecf96Smrg div_real_real(&cmp, &two); 32725dfecf96Smrg if (dsign > 0) { 32735dfecf96Smrg if (rsign > 0) { 32745dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) >= 0) 32755dfecf96Smrg state = NDIVIDE_ADD; 32765dfecf96Smrg } 32775dfecf96Smrg else { 32785dfecf96Smrg neg_real(&cmp); 32795dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) <= 0) 32805dfecf96Smrg state = NDIVIDE_SUB; 32815dfecf96Smrg } 32825dfecf96Smrg } 32835dfecf96Smrg else { 32845dfecf96Smrg if (rsign > 0) { 32855dfecf96Smrg neg_real(&cmp); 32865dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) >= 0) 32875dfecf96Smrg state = NDIVIDE_SUB; 32885dfecf96Smrg } 32895dfecf96Smrg else { 32905dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) <= 0) 32915dfecf96Smrg state = NDIVIDE_ADD; 32925dfecf96Smrg } 32935dfecf96Smrg } 32945dfecf96Smrg clear_real(&cmp); 32955dfecf96Smrg } break; 32965dfecf96Smrg } 32975dfecf96Smrg 32985dfecf96Smrg if (state == NDIVIDE_ADD) { 32995dfecf96Smrg mpi_addi(quo, quo, 1); 33005dfecf96Smrg sub_real_object(NIMAG(num), div); 33015dfecf96Smrg } 33025dfecf96Smrg else if (state == NDIVIDE_SUB) { 33035dfecf96Smrg mpi_subi(quo, quo, 1); 33045dfecf96Smrg add_real_object(NIMAG(num), div); 33055dfecf96Smrg } 33065dfecf96Smrg 33075dfecf96Smrg clear_real(NREAL(num)); 33085dfecf96Smrg 33095dfecf96Smrg if (flo) { 33105dfecf96Smrg double dval = bi_getd(quo); 33115dfecf96Smrg 33125dfecf96Smrg mpi_clear(quo); 33135dfecf96Smrg XFREE(quo); 33145dfecf96Smrg NRTYPE(num) = N_FLONUM; 33155dfecf96Smrg NRFF(num) = dval; 33165dfecf96Smrg } 33175dfecf96Smrg else { 33185dfecf96Smrg NRBI(num) = quo; 33195dfecf96Smrg NRTYPE(num) = N_BIGNUM; 33205dfecf96Smrg rbi_canonicalize(NREAL(num)); 33215dfecf96Smrg } 33225dfecf96Smrg} 33235dfecf96Smrg 33245dfecf96Smrgstatic void 33255dfecf96Smrgndivide_xr_xi(n_number *num, LispObj *div, int fun, int flo) 33265dfecf96Smrg{ 33275dfecf96Smrg LispType type = OBJECT_TYPE(div); 33285dfecf96Smrg int state = NDIVIDE_NOP, dsign, rsign; 33295dfecf96Smrg mpi *quo; 33305dfecf96Smrg mpr *rem; 33315dfecf96Smrg 33325dfecf96Smrg quo = XALLOC(mpi); 33335dfecf96Smrg mpi_init(quo); 33345dfecf96Smrg switch (type) { 33355dfecf96Smrg case LispFixnum_t: 33365dfecf96Smrg dsign = OFI(div) < 0 ? -1 : OFI(div) > 0 ? 1 : 0; 33375dfecf96Smrg mpi_seti(quo, OFI(div)); 33385dfecf96Smrg break; 33395dfecf96Smrg case LispInteger_t: 33405dfecf96Smrg dsign = OII(div) < 0 ? -1 : OII(div) > 0 ? 1 : 0; 33415dfecf96Smrg mpi_seti(quo, OII(div)); 33425dfecf96Smrg break; 33435dfecf96Smrg default: 33445dfecf96Smrg dsign = mpi_sgn(OBI(div)); 33455dfecf96Smrg mpi_set(quo, OBI(div)); 33465dfecf96Smrg break; 33475dfecf96Smrg } 33485dfecf96Smrg 33495dfecf96Smrg rem = XALLOC(mpr); 33505dfecf96Smrg mpr_init(rem); 33515dfecf96Smrg if (NRTYPE(num) == N_FIXRATIO) { 33525dfecf96Smrg mpr_seti(rem, NRFRN(num), NRFRD(num)); 33535dfecf96Smrg mpi_muli(quo, quo, NRFRD(num)); 33545dfecf96Smrg } 33555dfecf96Smrg else { 33565dfecf96Smrg mpr_set(rem, NRBR(num)); 33575dfecf96Smrg mpi_mul(quo, quo, NRBRD(num)); 33585dfecf96Smrg } 33595dfecf96Smrg mpi_divqr(quo, mpr_num(rem), mpr_num(rem), quo); 33605dfecf96Smrg mpr_canonicalize(rem); 33615dfecf96Smrg 33625dfecf96Smrg rsign = mpi_sgn(mpr_num(rem)); 33635dfecf96Smrg if (mpr_fiti(rem)) { 33645dfecf96Smrg NITYPE(num) = N_FIXRATIO; 33655dfecf96Smrg NIFRN(num) = mpi_geti(mpr_num(rem)); 33665dfecf96Smrg NIFRD(num) = mpi_geti(mpr_den(rem)); 33675dfecf96Smrg mpr_clear(rem); 33685dfecf96Smrg XFREE(rem); 33695dfecf96Smrg } 33705dfecf96Smrg else { 33715dfecf96Smrg NITYPE(num) = N_BIGRATIO; 33725dfecf96Smrg NIBR(num) = rem; 33735dfecf96Smrg } 33745dfecf96Smrg 33755dfecf96Smrg switch (fun) { 33765dfecf96Smrg case NDIVIDE_CEIL: 33775dfecf96Smrg if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0)) 33785dfecf96Smrg state = NDIVIDE_ADD; 33795dfecf96Smrg break; 33805dfecf96Smrg case NDIVIDE_FLOOR: 33815dfecf96Smrg if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0)) 33825dfecf96Smrg state = NDIVIDE_SUB; 33835dfecf96Smrg break; 33845dfecf96Smrg case NDIVIDE_ROUND: { 33855dfecf96Smrg n_real cmp; 33865dfecf96Smrg 33875dfecf96Smrg set_real_object(&cmp, div); 33885dfecf96Smrg div_real_real(&cmp, &two); 33895dfecf96Smrg if (dsign > 0) { 33905dfecf96Smrg if (rsign > 0) { 33915dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) >= 0) 33925dfecf96Smrg state = NDIVIDE_ADD; 33935dfecf96Smrg } 33945dfecf96Smrg else { 33955dfecf96Smrg neg_real(&cmp); 33965dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) <= 0) 33975dfecf96Smrg state = NDIVIDE_SUB; 33985dfecf96Smrg } 33995dfecf96Smrg } 34005dfecf96Smrg else { 34015dfecf96Smrg if (rsign > 0) { 34025dfecf96Smrg neg_real(&cmp); 34035dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) >= 0) 34045dfecf96Smrg state = NDIVIDE_SUB; 34055dfecf96Smrg } 34065dfecf96Smrg else { 34075dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) <= 0) 34085dfecf96Smrg state = NDIVIDE_ADD; 34095dfecf96Smrg } 34105dfecf96Smrg } 34115dfecf96Smrg clear_real(&cmp); 34125dfecf96Smrg } break; 34135dfecf96Smrg } 34145dfecf96Smrg 34155dfecf96Smrg if (state == NDIVIDE_ADD) { 34165dfecf96Smrg mpi_addi(quo, quo, 1); 34175dfecf96Smrg sub_real_object(NIMAG(num), div); 34185dfecf96Smrg } 34195dfecf96Smrg else if (state == NDIVIDE_SUB) { 34205dfecf96Smrg mpi_subi(quo, quo, 1); 34215dfecf96Smrg add_real_object(NIMAG(num), div); 34225dfecf96Smrg } 34235dfecf96Smrg 34245dfecf96Smrg clear_real(NREAL(num)); 34255dfecf96Smrg 34265dfecf96Smrg if (flo) { 34275dfecf96Smrg double dval = bi_getd(quo); 34285dfecf96Smrg 34295dfecf96Smrg mpi_clear(quo); 34305dfecf96Smrg XFREE(quo); 34315dfecf96Smrg NRTYPE(num) = N_FLONUM; 34325dfecf96Smrg NRFF(num) = dval; 34335dfecf96Smrg } 34345dfecf96Smrg else { 34355dfecf96Smrg NRBI(num) = quo; 34365dfecf96Smrg NRTYPE(num) = N_BIGNUM; 34375dfecf96Smrg rbi_canonicalize(NREAL(num)); 34385dfecf96Smrg } 34395dfecf96Smrg} 34405dfecf96Smrg 34415dfecf96Smrgstatic void 34425dfecf96Smrgndivide_xr_xr(n_number *num, LispObj *div, int fun, int flo) 34435dfecf96Smrg{ 34445dfecf96Smrg int state = NDIVIDE_NOP, dsign, rsign, modp; 34455dfecf96Smrg mpr *bigr; 34465dfecf96Smrg mpi *bigi; 34475dfecf96Smrg 34485dfecf96Smrg bigr = XALLOC(mpr); 34495dfecf96Smrg mpr_init(bigr); 34505dfecf96Smrg if (NRTYPE(num) == N_FIXRATIO) 34515dfecf96Smrg mpr_seti(bigr, NRFRN(num), NRFRD(num)); 34525dfecf96Smrg else 34535dfecf96Smrg mpr_set(bigr, NRBR(num)); 34545dfecf96Smrg 34555dfecf96Smrg NITYPE(num) = N_BIGRATIO; 34565dfecf96Smrg NIBR(num) = bigr; 34575dfecf96Smrg 34585dfecf96Smrg if (OBJECT_TYPE(div) == LispRatio_t) { 34595dfecf96Smrg dsign = OFRN(div) < 0 ? -1 : OFRN(div) > 0 ? 1 : 0; 34605dfecf96Smrg mpi_muli(mpr_num(bigr), mpr_num(bigr), OFRD(div)); 34615dfecf96Smrg mpi_muli(mpr_den(bigr), mpr_den(bigr), OFRN(div)); 34625dfecf96Smrg } 34635dfecf96Smrg else { 34645dfecf96Smrg dsign = mpi_sgn(OBRN(div)); 34655dfecf96Smrg mpr_div(bigr, bigr, OBR(div)); 34665dfecf96Smrg } 34675dfecf96Smrg modp = mpi_fiti(mpr_den(bigr)) && mpi_geti(mpr_den(bigr)) == 2; 34685dfecf96Smrg 34695dfecf96Smrg bigi = XALLOC(mpi); 34705dfecf96Smrg mpi_init(bigi); 34715dfecf96Smrg mpi_divqr(bigi, mpr_num(bigr), mpr_num(bigr), mpr_den(bigr)); 34725dfecf96Smrg 34735dfecf96Smrg if (OBJECT_TYPE(div) == LispRatio_t) 34745dfecf96Smrg mpi_seti(mpr_den(bigr), OFRD(div)); 34755dfecf96Smrg else 34765dfecf96Smrg mpi_set(mpr_den(bigr), OBRD(div)); 34775dfecf96Smrg if (NRTYPE(num) == N_FIXRATIO) 34785dfecf96Smrg mpi_muli(mpr_den(bigr), mpr_den(bigr), NRFRD(num)); 34795dfecf96Smrg else 34805dfecf96Smrg mpi_mul(mpr_den(bigr), mpr_den(bigr), NRBRD(num)); 34815dfecf96Smrg 34825dfecf96Smrg clear_real(NREAL(num)); 34835dfecf96Smrg NRTYPE(num) = N_BIGNUM; 34845dfecf96Smrg NRBI(num) = bigi; 34855dfecf96Smrg 34865dfecf96Smrg rbr_canonicalize(NIMAG(num)); 34875dfecf96Smrg rsign = cmp_real_real(NIMAG(num), &zero); 34885dfecf96Smrg 34895dfecf96Smrg switch (fun) { 34905dfecf96Smrg case NDIVIDE_CEIL: 34915dfecf96Smrg if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0)) 34925dfecf96Smrg state = NDIVIDE_ADD; 34935dfecf96Smrg break; 34945dfecf96Smrg case NDIVIDE_FLOOR: 34955dfecf96Smrg if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0)) 34965dfecf96Smrg state = NDIVIDE_SUB; 34975dfecf96Smrg break; 34985dfecf96Smrg case NDIVIDE_ROUND: 34995dfecf96Smrg if (!modp || (bigi->digs[0] & 1) == 1) { 35005dfecf96Smrg n_real cmp; 35015dfecf96Smrg 35025dfecf96Smrg set_real_object(&cmp, div); 35035dfecf96Smrg div_real_real(&cmp, &two); 35045dfecf96Smrg if (dsign > 0) { 35055dfecf96Smrg if (rsign > 0) { 35065dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) >= 0) 35075dfecf96Smrg state = NDIVIDE_ADD; 35085dfecf96Smrg } 35095dfecf96Smrg else { 35105dfecf96Smrg neg_real(&cmp); 35115dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) <= 0) 35125dfecf96Smrg state = NDIVIDE_SUB; 35135dfecf96Smrg } 35145dfecf96Smrg } 35155dfecf96Smrg else { 35165dfecf96Smrg if (rsign > 0) { 35175dfecf96Smrg neg_real(&cmp); 35185dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) >= 0) 35195dfecf96Smrg state = NDIVIDE_SUB; 35205dfecf96Smrg } 35215dfecf96Smrg else { 35225dfecf96Smrg if (cmp_real_real(NIMAG(num), &cmp) <= 0) 35235dfecf96Smrg state = NDIVIDE_ADD; 35245dfecf96Smrg } 35255dfecf96Smrg } 35265dfecf96Smrg clear_real(&cmp); 35275dfecf96Smrg } 35285dfecf96Smrg break; 35295dfecf96Smrg } 35305dfecf96Smrg 35315dfecf96Smrg if (state == NDIVIDE_ADD) { 35325dfecf96Smrg add_real_real(NREAL(num), &one); 35335dfecf96Smrg sub_real_object(NIMAG(num), div); 35345dfecf96Smrg } 35355dfecf96Smrg else if (state == NDIVIDE_SUB) { 35365dfecf96Smrg sub_real_real(NREAL(num), &one); 35375dfecf96Smrg add_real_object(NIMAG(num), div); 35385dfecf96Smrg } 35395dfecf96Smrg 35405dfecf96Smrg if (NRTYPE(num) == N_BIGNUM) { 35415dfecf96Smrg if (flo) { 35425dfecf96Smrg double dval = bi_getd(bigi); 35435dfecf96Smrg 35445dfecf96Smrg mpi_clear(bigi); 35455dfecf96Smrg XFREE(bigi); 35465dfecf96Smrg NRTYPE(num) = N_FLONUM; 35475dfecf96Smrg NRFF(num) = dval; 35485dfecf96Smrg } 35495dfecf96Smrg else 35505dfecf96Smrg rbi_canonicalize(NREAL(num)); 35515dfecf96Smrg } 35525dfecf96Smrg else if (flo) { 35535dfecf96Smrg NRTYPE(num) = N_FLONUM; 35545dfecf96Smrg NRFF(num) = (double)NRFI(num); 35555dfecf96Smrg } 35565dfecf96Smrg} 35575dfecf96Smrg 35585dfecf96Smrg 35595dfecf96Smrg/************************************************************************ 35605dfecf96Smrg * REAL COMPLEX 35615dfecf96Smrg ************************************************************************/ 35625dfecf96Smrgstatic void 35635dfecf96Smrgnadd_re_cx(n_number *num, LispObj *comp) 35645dfecf96Smrg{ 35655dfecf96Smrg/* 35665dfecf96Smrg Ra+Rb Ib 35675dfecf96Smrg */ 35685dfecf96Smrg /* Ra+Rb */ 35695dfecf96Smrg add_real_object(NREAL(num), OCXR(comp)); 35705dfecf96Smrg 35715dfecf96Smrg /* Ib */ 35725dfecf96Smrg set_real_object(NIMAG(num), OCXI(comp)); 35735dfecf96Smrg 35745dfecf96Smrg num->complex = 1; 35755dfecf96Smrg 35765dfecf96Smrg ncx_canonicalize(num); 35775dfecf96Smrg} 35785dfecf96Smrg 35795dfecf96Smrgstatic void 35805dfecf96Smrgnsub_re_cx(n_number *num, LispObj *comp) 35815dfecf96Smrg{ 35825dfecf96Smrg/* 35835dfecf96Smrg Ra-Rb -Ib 35845dfecf96Smrg */ 35855dfecf96Smrg /* Ra-Rb */ 35865dfecf96Smrg sub_real_object(NREAL(num), OCXR(comp)); 35875dfecf96Smrg 35885dfecf96Smrg /* -Ib */ 35895dfecf96Smrg NITYPE(num) = N_FIXNUM; 35905dfecf96Smrg NIFI(num) = -1; 35915dfecf96Smrg mul_real_object(NIMAG(num), OCXI(comp)); 35925dfecf96Smrg 35935dfecf96Smrg num->complex = 1; 35945dfecf96Smrg 35955dfecf96Smrg ncx_canonicalize(num); 35965dfecf96Smrg} 35975dfecf96Smrg 35985dfecf96Smrgstatic void 35995dfecf96Smrgnmul_re_cx(n_number *num, LispObj *comp) 36005dfecf96Smrg{ 36015dfecf96Smrg/* 36025dfecf96Smrg Ra*Rb Ra*Ib 36035dfecf96Smrg */ 36045dfecf96Smrg /* copy before change */ 36055dfecf96Smrg set_real_real(NIMAG(num), NREAL(num)); 36065dfecf96Smrg 36075dfecf96Smrg /* Ra*Rb */ 36085dfecf96Smrg mul_real_object(NREAL(num), OCXR(comp)); 36095dfecf96Smrg 36105dfecf96Smrg /* Ra*Ib */ 36115dfecf96Smrg mul_real_object(NIMAG(num), OCXI(comp)); 36125dfecf96Smrg 36135dfecf96Smrg num->complex = 1; 36145dfecf96Smrg 36155dfecf96Smrg ncx_canonicalize(num); 36165dfecf96Smrg} 36175dfecf96Smrg 36185dfecf96Smrgstatic void 36195dfecf96Smrgndiv_re_cx(n_number *num, LispObj *comp) 36205dfecf96Smrg{ 36215dfecf96Smrg/* 36225dfecf96Smrg Ra*Rb -Ib*Ra 36235dfecf96Smrg ----------- ----------- 36245dfecf96Smrg Rb*Rb+Ib*Ib Rb*Rb+Ib*Ib 36255dfecf96Smrg */ 36265dfecf96Smrg n_real div, temp; 36275dfecf96Smrg 36285dfecf96Smrg /* Rb*Rb */ 36295dfecf96Smrg set_real_object(&div, OCXR(comp)); 36305dfecf96Smrg mul_real_object(&div, OCXR(comp)); 36315dfecf96Smrg 36325dfecf96Smrg /* Ib*Ib */ 36335dfecf96Smrg set_real_object(&temp, OCXI(comp)); 36345dfecf96Smrg mul_real_object(&temp, OCXI(comp)); 36355dfecf96Smrg 36365dfecf96Smrg /* Rb*Rb+Ib*Ib */ 36375dfecf96Smrg add_real_real(&div, &temp); 36385dfecf96Smrg clear_real(&temp); 36395dfecf96Smrg 36405dfecf96Smrg /* -Ib*Ra */ 36415dfecf96Smrg NITYPE(num) = N_FIXNUM; 36425dfecf96Smrg NIFI(num) = -1; 36435dfecf96Smrg mul_real_object(NIMAG(num), OCXI(comp)); 36445dfecf96Smrg mul_real_real(NIMAG(num), NREAL(num)); 36455dfecf96Smrg 36465dfecf96Smrg /* Ra*Rb */ 36475dfecf96Smrg mul_real_object(NREAL(num), OCXR(comp)); 36485dfecf96Smrg 36495dfecf96Smrg div_real_real(NREAL(num), &div); 36505dfecf96Smrg div_real_real(NIMAG(num), &div); 36515dfecf96Smrg clear_real(&div); 36525dfecf96Smrg 36535dfecf96Smrg num->complex = 1; 36545dfecf96Smrg 36555dfecf96Smrg ncx_canonicalize(num); 36565dfecf96Smrg} 36575dfecf96Smrg 36585dfecf96Smrg 36595dfecf96Smrg/************************************************************************ 36605dfecf96Smrg * COMPLEX REAL 36615dfecf96Smrg ************************************************************************/ 36625dfecf96Smrgstatic void 36635dfecf96Smrgnadd_cx_re(n_number *num, LispObj *re) 36645dfecf96Smrg{ 36655dfecf96Smrg/* 36665dfecf96Smrg Ra+Rb Ia 36675dfecf96Smrg */ 36685dfecf96Smrg add_real_object(NREAL(num), re); 36695dfecf96Smrg 36705dfecf96Smrg ncx_canonicalize(num); 36715dfecf96Smrg} 36725dfecf96Smrg 36735dfecf96Smrgstatic void 36745dfecf96Smrgnsub_cx_re(n_number *num, LispObj *re) 36755dfecf96Smrg{ 36765dfecf96Smrg/* 36775dfecf96Smrg Ra-Rb Ia 36785dfecf96Smrg */ 36795dfecf96Smrg sub_real_object(NREAL(num), re); 36805dfecf96Smrg 36815dfecf96Smrg ncx_canonicalize(num); 36825dfecf96Smrg} 36835dfecf96Smrg 36845dfecf96Smrgstatic void 36855dfecf96Smrgnmul_cx_re(n_number *num, LispObj *re) 36865dfecf96Smrg{ 36875dfecf96Smrg/* 36885dfecf96Smrg Ra*Rb Ia*Rb 36895dfecf96Smrg */ 36905dfecf96Smrg mul_real_object(NREAL(num), re); 36915dfecf96Smrg mul_real_object(NIMAG(num), re); 36925dfecf96Smrg 36935dfecf96Smrg ncx_canonicalize(num); 36945dfecf96Smrg} 36955dfecf96Smrg 36965dfecf96Smrgstatic void 36975dfecf96Smrgndiv_cx_re(n_number *num, LispObj *re) 36985dfecf96Smrg{ 36995dfecf96Smrg/* 37005dfecf96Smrg Ra/Rb Ia/Rb 37015dfecf96Smrg */ 37025dfecf96Smrg div_real_object(NREAL(num), re); 37035dfecf96Smrg div_real_object(NIMAG(num), re); 37045dfecf96Smrg 37055dfecf96Smrg ncx_canonicalize(num); 37065dfecf96Smrg} 37075dfecf96Smrg 37085dfecf96Smrg 37095dfecf96Smrg/************************************************************************ 37105dfecf96Smrg * COMPLEX COMPLEX 37115dfecf96Smrg ************************************************************************/ 37125dfecf96Smrgstatic void 37135dfecf96Smrgnadd_cx_cx(n_number *num, LispObj *comp) 37145dfecf96Smrg{ 37155dfecf96Smrg/* 37165dfecf96Smrg Ra+Rb Ia+Ib 37175dfecf96Smrg */ 37185dfecf96Smrg add_real_object(NREAL(num), OCXR(comp)); 37195dfecf96Smrg add_real_object(NIMAG(num), OCXI(comp)); 37205dfecf96Smrg 37215dfecf96Smrg ncx_canonicalize(num); 37225dfecf96Smrg} 37235dfecf96Smrg 37245dfecf96Smrgstatic void 37255dfecf96Smrgnsub_cx_cx(n_number *num, LispObj *comp) 37265dfecf96Smrg{ 37275dfecf96Smrg/* 37285dfecf96Smrg Ra-Rb Ia-Ib 37295dfecf96Smrg */ 37305dfecf96Smrg sub_real_object(NREAL(num), OCXR(comp)); 37315dfecf96Smrg sub_real_object(NIMAG(num), OCXI(comp)); 37325dfecf96Smrg 37335dfecf96Smrg ncx_canonicalize(num); 37345dfecf96Smrg} 37355dfecf96Smrg 37365dfecf96Smrgstatic void 37375dfecf96Smrgnmul_cx_cx(n_number *num, LispObj *comp) 37385dfecf96Smrg{ 37395dfecf96Smrg/* 37405dfecf96Smrg Ra*Rb-Ia*Ib Ra*Ib+Ia*Rb 37415dfecf96Smrg */ 37425dfecf96Smrg n_real IaIb, RaIb; 37435dfecf96Smrg 37445dfecf96Smrg set_real_real(&IaIb, NIMAG(num)); 37455dfecf96Smrg mul_real_object(&IaIb, OCXI(comp)); 37465dfecf96Smrg 37475dfecf96Smrg set_real_real(&RaIb, NREAL(num)); 37485dfecf96Smrg mul_real_object(&RaIb, OCXI(comp)); 37495dfecf96Smrg 37505dfecf96Smrg /* Ra*Rb-Ia*Ib */ 37515dfecf96Smrg mul_real_object(NREAL(num), OCXR(comp)); 37525dfecf96Smrg sub_real_real(NREAL(num), &IaIb); 37535dfecf96Smrg clear_real(&IaIb); 37545dfecf96Smrg 37555dfecf96Smrg /* Ra*Ib+Ia*Rb */ 37565dfecf96Smrg mul_real_object(NIMAG(num), OCXR(comp)); 37575dfecf96Smrg add_real_real(NIMAG(num), &RaIb); 37585dfecf96Smrg clear_real(&RaIb); 37595dfecf96Smrg 37605dfecf96Smrg ncx_canonicalize(num); 37615dfecf96Smrg} 37625dfecf96Smrg 37635dfecf96Smrgstatic void 37645dfecf96Smrgndiv_cx_cx(n_number *num, LispObj *comp) 37655dfecf96Smrg{ 37665dfecf96Smrg/* 37675dfecf96Smrg Ra*Rb+Ia*Ib Ia*Rb-Ib*Ra 37685dfecf96Smrg ----------- ----------- 37695dfecf96Smrg Rb*Rb+Ib*Ib Rb*Rb+Ib*Ib 37705dfecf96Smrg */ 37715dfecf96Smrg n_real temp1, temp2; 37725dfecf96Smrg 37735dfecf96Smrg /* IaIb */ 37745dfecf96Smrg set_real_real(&temp1, NIMAG(num)); 37755dfecf96Smrg mul_real_object(&temp1, OCXI(comp)); 37765dfecf96Smrg 37775dfecf96Smrg /* IbRa */ 37785dfecf96Smrg set_real_real(&temp2, NREAL(num)); 37795dfecf96Smrg mul_real_object(&temp2, OCXI(comp)); 37805dfecf96Smrg 37815dfecf96Smrg /* Ra*Rb+Ia*Ib */ 37825dfecf96Smrg mul_real_object(NREAL(num), OCXR(comp)); 37835dfecf96Smrg add_real_real(NREAL(num), &temp1); 37845dfecf96Smrg clear_real(&temp1); 37855dfecf96Smrg 37865dfecf96Smrg /* Ia*Rb-Ib*Ra */ 37875dfecf96Smrg mul_real_object(NIMAG(num), OCXR(comp)); 37885dfecf96Smrg sub_real_real(NIMAG(num), &temp2); 37895dfecf96Smrg clear_real(&temp2); 37905dfecf96Smrg 37915dfecf96Smrg 37925dfecf96Smrg /* Rb*Rb */ 37935dfecf96Smrg set_real_object(&temp1, OCXR(comp)); 37945dfecf96Smrg mul_real_object(&temp1, OCXR(comp)); 37955dfecf96Smrg 37965dfecf96Smrg /* Ib*Ib */ 37975dfecf96Smrg set_real_object(&temp2, OCXI(comp)); 37985dfecf96Smrg mul_real_object(&temp2, OCXI(comp)); 37995dfecf96Smrg 38005dfecf96Smrg /* Rb*Rb+Ib*Ib */ 38015dfecf96Smrg add_real_real(&temp1, &temp2); 38025dfecf96Smrg clear_real(&temp2); 38035dfecf96Smrg 38045dfecf96Smrg div_real_real(NREAL(num), &temp1); 38055dfecf96Smrg div_real_real(NIMAG(num), &temp1); 38065dfecf96Smrg clear_real(&temp1); 38075dfecf96Smrg 38085dfecf96Smrg ncx_canonicalize(num); 38095dfecf96Smrg} 38105dfecf96Smrg 38115dfecf96Smrgstatic int 38125dfecf96Smrgcmp_cx_cx(LispObj *op1, LispObj *op2) 38135dfecf96Smrg{ 38145dfecf96Smrg int cmp; 38155dfecf96Smrg 38165dfecf96Smrg cmp = cmp_object_object(OCXR(op1), OCXR(op2), 1); 38175dfecf96Smrg if (cmp == 0) 38185dfecf96Smrg cmp = cmp_object_object(OCXI(op1), OCXI(op2), 1); 38195dfecf96Smrg 38205dfecf96Smrg return (cmp); 38215dfecf96Smrg} 38225dfecf96Smrg 38235dfecf96Smrg 38245dfecf96Smrg/************************************************************************ 38255dfecf96Smrg * FLONUM FLONUM 38265dfecf96Smrg ************************************************************************/ 38275dfecf96Smrgstatic void 38285dfecf96Smrgradd_flonum(n_real *real, double op1, double op2) 38295dfecf96Smrg{ 38305dfecf96Smrg double value = op1 + op2; 38315dfecf96Smrg 38325dfecf96Smrg if (!finite(value)) 38335dfecf96Smrg fatal_error(FLOATING_POINT_OVERFLOW); 38345dfecf96Smrg switch (RTYPE(real)) { 38355dfecf96Smrg case N_FIXNUM: 38365dfecf96Smrg case N_FIXRATIO: 38375dfecf96Smrg RTYPE(real) = N_FLONUM; 38385dfecf96Smrg break; 38395dfecf96Smrg case N_BIGNUM: 38405dfecf96Smrg RCLEAR_BI(real); 38415dfecf96Smrg RTYPE(real) = N_FLONUM; 38425dfecf96Smrg break; 38435dfecf96Smrg case N_BIGRATIO: 38445dfecf96Smrg RCLEAR_BR(real); 38455dfecf96Smrg RTYPE(real) = N_FLONUM; 38465dfecf96Smrg break; 38475dfecf96Smrg } 38485dfecf96Smrg RFF(real) = value; 38495dfecf96Smrg} 38505dfecf96Smrg 38515dfecf96Smrgstatic void 38525dfecf96Smrgrsub_flonum(n_real *real, double op1, double op2) 38535dfecf96Smrg{ 38545dfecf96Smrg double value = op1 - op2; 38555dfecf96Smrg 38565dfecf96Smrg if (!finite(value)) 38575dfecf96Smrg fatal_error(FLOATING_POINT_OVERFLOW); 38585dfecf96Smrg switch (RTYPE(real)) { 38595dfecf96Smrg case N_FIXNUM: 38605dfecf96Smrg case N_FIXRATIO: 38615dfecf96Smrg RTYPE(real) = N_FLONUM; 38625dfecf96Smrg break; 38635dfecf96Smrg case N_BIGNUM: 38645dfecf96Smrg RCLEAR_BI(real); 38655dfecf96Smrg RTYPE(real) = N_FLONUM; 38665dfecf96Smrg break; 38675dfecf96Smrg case N_BIGRATIO: 38685dfecf96Smrg RCLEAR_BR(real); 38695dfecf96Smrg RTYPE(real) = N_FLONUM; 38705dfecf96Smrg break; 38715dfecf96Smrg } 38725dfecf96Smrg RFF(real) = value; 38735dfecf96Smrg} 38745dfecf96Smrg 38755dfecf96Smrgstatic void 38765dfecf96Smrgrmul_flonum(n_real *real, double op1, double op2) 38775dfecf96Smrg{ 38785dfecf96Smrg double value = op1 * op2; 38795dfecf96Smrg 38805dfecf96Smrg if (!finite(value)) 38815dfecf96Smrg fatal_error(FLOATING_POINT_OVERFLOW); 38825dfecf96Smrg switch (RTYPE(real)) { 38835dfecf96Smrg case N_FIXNUM: 38845dfecf96Smrg case N_FIXRATIO: 38855dfecf96Smrg RTYPE(real) = N_FLONUM; 38865dfecf96Smrg break; 38875dfecf96Smrg case N_BIGNUM: 38885dfecf96Smrg RCLEAR_BI(real); 38895dfecf96Smrg RTYPE(real) = N_FLONUM; 38905dfecf96Smrg break; 38915dfecf96Smrg case N_BIGRATIO: 38925dfecf96Smrg RCLEAR_BR(real); 38935dfecf96Smrg RTYPE(real) = N_FLONUM; 38945dfecf96Smrg break; 38955dfecf96Smrg } 38965dfecf96Smrg RFF(real) = value; 38975dfecf96Smrg} 38985dfecf96Smrg 38995dfecf96Smrgstatic void 39005dfecf96Smrgrdiv_flonum(n_real *real, double op1, double op2) 39015dfecf96Smrg{ 39025dfecf96Smrg double value; 39035dfecf96Smrg 39045dfecf96Smrg if (op2 == 0.0) 39055dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 39065dfecf96Smrg value = op1 / op2; 39075dfecf96Smrg if (!finite(value)) 39085dfecf96Smrg fatal_error(FLOATING_POINT_OVERFLOW); 39095dfecf96Smrg switch (RTYPE(real)) { 39105dfecf96Smrg case N_FIXNUM: 39115dfecf96Smrg case N_FIXRATIO: 39125dfecf96Smrg RTYPE(real) = N_FLONUM; 39135dfecf96Smrg break; 39145dfecf96Smrg case N_BIGNUM: 39155dfecf96Smrg RCLEAR_BI(real); 39165dfecf96Smrg RTYPE(real) = N_FLONUM; 39175dfecf96Smrg break; 39185dfecf96Smrg case N_BIGRATIO: 39195dfecf96Smrg RCLEAR_BR(real); 39205dfecf96Smrg RTYPE(real) = N_FLONUM; 39215dfecf96Smrg break; 39225dfecf96Smrg } 39235dfecf96Smrg RFF(real) = value; 39245dfecf96Smrg} 39255dfecf96Smrg 39265dfecf96Smrgstatic int 39275dfecf96Smrgcmp_flonum(double op1, double op2) 39285dfecf96Smrg{ 39295dfecf96Smrg double value = op1 - op2; 39305dfecf96Smrg 39315dfecf96Smrg if (!finite(value)) 39325dfecf96Smrg fatal_error(FLOATING_POINT_OVERFLOW); 39335dfecf96Smrg 39345dfecf96Smrg return (value > 0.0 ? 1 : value < 0.0 ? -1 : 0); 39355dfecf96Smrg} 39365dfecf96Smrg 39375dfecf96Smrg 39385dfecf96Smrg/************************************************************************ 39395dfecf96Smrg * FIXNUM FIXNUM 39405dfecf96Smrg ************************************************************************/ 39415dfecf96Smrgstatic void 39425dfecf96Smrgrop_fi_fi_bi(n_real *real, long fi, int op) 39435dfecf96Smrg{ 39445dfecf96Smrg mpi *bigi = XALLOC(mpi); 39455dfecf96Smrg 39465dfecf96Smrg mpi_init(bigi); 39475dfecf96Smrg mpi_seti(bigi, RFI(real)); 39485dfecf96Smrg if (op == NOP_ADD) 39495dfecf96Smrg mpi_addi(bigi, bigi, fi); 39505dfecf96Smrg else if (op == NOP_SUB) 39515dfecf96Smrg mpi_subi(bigi, bigi, fi); 39525dfecf96Smrg else 39535dfecf96Smrg mpi_muli(bigi, bigi, fi); 39545dfecf96Smrg RBI(real) = bigi; 39555dfecf96Smrg RTYPE(real) = N_BIGNUM; 39565dfecf96Smrg} 39575dfecf96Smrg 39585dfecf96Smrgstatic INLINE void 39595dfecf96Smrgradd_fi_fi(n_real *real, long fi) 39605dfecf96Smrg{ 39615dfecf96Smrg if (!fi_fi_add_overflow(RFI(real), fi)) 39625dfecf96Smrg RFI(real) += fi; 39635dfecf96Smrg else 39645dfecf96Smrg rop_fi_fi_bi(real, fi, NOP_ADD); 39655dfecf96Smrg} 39665dfecf96Smrg 39675dfecf96Smrgstatic INLINE void 39685dfecf96Smrgrsub_fi_fi(n_real *real, long fi) 39695dfecf96Smrg{ 39705dfecf96Smrg if (!fi_fi_sub_overflow(RFI(real), fi)) 39715dfecf96Smrg RFI(real) -= fi; 39725dfecf96Smrg else 39735dfecf96Smrg rop_fi_fi_bi(real, fi, NOP_SUB); 39745dfecf96Smrg} 39755dfecf96Smrg 39765dfecf96Smrgstatic INLINE void 39775dfecf96Smrgrmul_fi_fi(n_real *real, long fi) 39785dfecf96Smrg{ 39795dfecf96Smrg if (!fi_fi_mul_overflow(RFI(real), fi)) 39805dfecf96Smrg RFI(real) *= fi; 39815dfecf96Smrg else 39825dfecf96Smrg rop_fi_fi_bi(real, fi, NOP_MUL); 39835dfecf96Smrg} 39845dfecf96Smrg 39855dfecf96Smrgstatic INLINE void 39865dfecf96Smrgrdiv_fi_fi(n_real *real, long fi) 39875dfecf96Smrg{ 39885dfecf96Smrg RTYPE(real) = N_FIXRATIO; 39895dfecf96Smrg RFRN(real) = RFI(real); 39905dfecf96Smrg RFRD(real) = fi; 39915dfecf96Smrg rfr_canonicalize(real); 39925dfecf96Smrg} 39935dfecf96Smrg 39945dfecf96Smrgstatic INLINE int 39955dfecf96Smrgcmp_fi_fi(long op1, long op2) 39965dfecf96Smrg{ 39975dfecf96Smrg if (op1 > op2) 39985dfecf96Smrg return (1); 39995dfecf96Smrg else if (op1 < op2) 40005dfecf96Smrg return (-1); 40015dfecf96Smrg 40025dfecf96Smrg return (0); 40035dfecf96Smrg} 40045dfecf96Smrg 40055dfecf96Smrg 40065dfecf96Smrg/************************************************************************ 40075dfecf96Smrg * FIXNUM BIGNUM 40085dfecf96Smrg ************************************************************************/ 40095dfecf96Smrgstatic void 40105dfecf96Smrgrop_fi_bi_xi(n_real *real, mpi *bi, int nop) 40115dfecf96Smrg{ 40125dfecf96Smrg mpi *bigi = XALLOC(mpi); 40135dfecf96Smrg 40145dfecf96Smrg mpi_init(bigi); 40155dfecf96Smrg mpi_seti(bigi, RFI(real)); 40165dfecf96Smrg if (nop == NOP_ADD) 40175dfecf96Smrg mpi_add(bigi, bigi, bi); 40185dfecf96Smrg else if (nop == NOP_SUB) 40195dfecf96Smrg mpi_sub(bigi, bigi, bi); 40205dfecf96Smrg else 40215dfecf96Smrg mpi_mul(bigi, bigi, bi); 40225dfecf96Smrg 40235dfecf96Smrg if (mpi_fiti(bigi)) { 40245dfecf96Smrg RFI(real) = mpi_geti(bigi); 40255dfecf96Smrg mpi_clear(bigi); 40265dfecf96Smrg XFREE(bigi); 40275dfecf96Smrg } 40285dfecf96Smrg else { 40295dfecf96Smrg RBI(real) = bigi; 40305dfecf96Smrg RTYPE(real) = N_BIGNUM; 40315dfecf96Smrg } 40325dfecf96Smrg} 40335dfecf96Smrg 40345dfecf96Smrgstatic INLINE void 40355dfecf96Smrgradd_fi_bi(n_real *real, mpi *bi) 40365dfecf96Smrg{ 40375dfecf96Smrg rop_fi_bi_xi(real, bi, NOP_ADD); 40385dfecf96Smrg} 40395dfecf96Smrg 40405dfecf96Smrgstatic INLINE void 40415dfecf96Smrgrsub_fi_bi(n_real *real, mpi *bi) 40425dfecf96Smrg{ 40435dfecf96Smrg rop_fi_bi_xi(real, bi, NOP_SUB); 40445dfecf96Smrg} 40455dfecf96Smrg 40465dfecf96Smrgstatic INLINE void 40475dfecf96Smrgrmul_fi_bi(n_real *real, mpi *bi) 40485dfecf96Smrg{ 40495dfecf96Smrg rop_fi_bi_xi(real, bi, NOP_MUL); 40505dfecf96Smrg} 40515dfecf96Smrg 40525dfecf96Smrgstatic void 40535dfecf96Smrgrdiv_fi_bi(n_real *real, mpi *bi) 40545dfecf96Smrg{ 40555dfecf96Smrg mpr *bigr; 40565dfecf96Smrg 40575dfecf96Smrg if (mpi_cmpi(bi, 0) == 0) 40585dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 40595dfecf96Smrg 40605dfecf96Smrg bigr = XALLOC(mpr); 40615dfecf96Smrg mpr_init(bigr); 40625dfecf96Smrg mpi_seti(mpr_num(bigr), RFI(real)); 40635dfecf96Smrg mpi_set(mpr_den(bigr), bi); 40645dfecf96Smrg RBR(real) = bigr; 40655dfecf96Smrg RTYPE(real) = N_BIGRATIO; 40665dfecf96Smrg rbr_canonicalize(real); 40675dfecf96Smrg} 40685dfecf96Smrg 40695dfecf96Smrgstatic INLINE int 40705dfecf96Smrgcmp_fi_bi(long fixnum, mpi *bignum) 40715dfecf96Smrg{ 40725dfecf96Smrg return (-mpi_cmpi(bignum, fixnum)); 40735dfecf96Smrg} 40745dfecf96Smrg 40755dfecf96Smrg 40765dfecf96Smrg/************************************************************************ 40775dfecf96Smrg * FIXNUM FIXRATIO 40785dfecf96Smrg ************************************************************************/ 40795dfecf96Smrgstatic void 40805dfecf96Smrgrop_fi_fr_as_xr(n_real *real, long num, long den, int nop) 40815dfecf96Smrg{ 40825dfecf96Smrg int fit; 40835dfecf96Smrg long value = 0, op = RFI(real); 40845dfecf96Smrg 40855dfecf96Smrg fit = !fi_fi_mul_overflow(op, den); 40865dfecf96Smrg if (fit) { 40875dfecf96Smrg value = op * den; 40885dfecf96Smrg if (nop == NOP_ADD) 40895dfecf96Smrg fit = !fi_fi_add_overflow(value, num); 40905dfecf96Smrg else 40915dfecf96Smrg fit = !fi_fi_sub_overflow(value, num); 40925dfecf96Smrg } 40935dfecf96Smrg if (fit) { 40945dfecf96Smrg if (nop == NOP_ADD) 40955dfecf96Smrg RFRN(real) = value + num; 40965dfecf96Smrg else 40975dfecf96Smrg RFRN(real) = value - num; 40985dfecf96Smrg RFRD(real) = den; 40995dfecf96Smrg RTYPE(real) = N_FIXRATIO; 41005dfecf96Smrg rfr_canonicalize(real); 41015dfecf96Smrg } 41025dfecf96Smrg else { 41035dfecf96Smrg mpi iop; 41045dfecf96Smrg mpr *bigr = XALLOC(mpr); 41055dfecf96Smrg 41065dfecf96Smrg mpi_init(&iop); 41075dfecf96Smrg mpi_seti(&iop, op); 41085dfecf96Smrg mpi_muli(&iop, &iop, den); 41095dfecf96Smrg 41105dfecf96Smrg mpr_init(bigr); 41115dfecf96Smrg mpr_seti(bigr, num, den); 41125dfecf96Smrg if (nop == NOP_ADD) 41135dfecf96Smrg mpi_add(mpr_num(bigr), &iop, mpr_num(bigr)); 41145dfecf96Smrg else 41155dfecf96Smrg mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr)); 41165dfecf96Smrg mpi_clear(&iop); 41175dfecf96Smrg RBR(real) = bigr; 41185dfecf96Smrg RTYPE(real) = N_BIGRATIO; 41195dfecf96Smrg rbr_canonicalize(real); 41205dfecf96Smrg } 41215dfecf96Smrg} 41225dfecf96Smrg 41235dfecf96Smrgstatic void 41245dfecf96Smrgrop_fi_fr_md_xr(n_real *real, long num, long den, int nop) 41255dfecf96Smrg{ 41265dfecf96Smrg int fit; 41275dfecf96Smrg long op = RFI(real); 41285dfecf96Smrg 41295dfecf96Smrg if (nop == NOP_MUL) 41305dfecf96Smrg fit = !fi_fi_mul_overflow(op, num); 41315dfecf96Smrg else 41325dfecf96Smrg fit = !fi_fi_mul_overflow(op, den); 41335dfecf96Smrg if (fit) { 41345dfecf96Smrg if (nop == NOP_MUL) { 41355dfecf96Smrg RFRN(real) = op * num; 41365dfecf96Smrg RFRD(real) = den; 41375dfecf96Smrg } 41385dfecf96Smrg else { 41395dfecf96Smrg RFRN(real) = op * den; 41405dfecf96Smrg RFRD(real) = num; 41415dfecf96Smrg } 41425dfecf96Smrg RTYPE(real) = N_FIXRATIO; 41435dfecf96Smrg rfr_canonicalize(real); 41445dfecf96Smrg } 41455dfecf96Smrg else { 41465dfecf96Smrg mpi iop; 41475dfecf96Smrg mpr *bigr = XALLOC(mpr); 41485dfecf96Smrg 41495dfecf96Smrg mpi_init(&iop); 41505dfecf96Smrg mpi_seti(&iop, op); 41515dfecf96Smrg 41525dfecf96Smrg mpr_init(bigr); 41535dfecf96Smrg if (nop == NOP_MUL) 41545dfecf96Smrg mpr_seti(bigr, num, den); 41555dfecf96Smrg else 41565dfecf96Smrg mpr_seti(bigr, den, num); 41575dfecf96Smrg mpi_mul(mpr_num(bigr), mpr_num(bigr), &iop); 41585dfecf96Smrg mpi_clear(&iop); 41595dfecf96Smrg RBR(real) = bigr; 41605dfecf96Smrg RTYPE(real) = N_BIGRATIO; 41615dfecf96Smrg rbr_canonicalize(real); 41625dfecf96Smrg } 41635dfecf96Smrg} 41645dfecf96Smrg 41655dfecf96Smrgstatic INLINE void 41665dfecf96Smrgradd_fi_fr(n_real *real, long num, long den) 41675dfecf96Smrg{ 41685dfecf96Smrg rop_fi_fr_as_xr(real, num, den, NOP_ADD); 41695dfecf96Smrg} 41705dfecf96Smrg 41715dfecf96Smrgstatic INLINE void 41725dfecf96Smrgrsub_fi_fr(n_real *real, long num, long den) 41735dfecf96Smrg{ 41745dfecf96Smrg rop_fi_fr_as_xr(real, num, den, NOP_SUB); 41755dfecf96Smrg} 41765dfecf96Smrg 41775dfecf96Smrgstatic INLINE void 41785dfecf96Smrgrmul_fi_fr(n_real *real, long num, long den) 41795dfecf96Smrg{ 41805dfecf96Smrg rop_fi_fr_md_xr(real, num, den, NOP_MUL); 41815dfecf96Smrg} 41825dfecf96Smrg 41835dfecf96Smrgstatic INLINE void 41845dfecf96Smrgrdiv_fi_fr(n_real *real, long num, long den) 41855dfecf96Smrg{ 41865dfecf96Smrg rop_fi_fr_md_xr(real, num, den, NOP_DIV); 41875dfecf96Smrg} 41885dfecf96Smrg 41895dfecf96Smrgstatic INLINE int 41905dfecf96Smrgcmp_fi_fr(long fi, long num, long den) 41915dfecf96Smrg{ 41925dfecf96Smrg return (cmp_flonum((double)fi, (double)num / (double)den)); 41935dfecf96Smrg} 41945dfecf96Smrg 41955dfecf96Smrg 41965dfecf96Smrg/************************************************************************ 41975dfecf96Smrg * FIXNUM BIGRATIO 41985dfecf96Smrg ************************************************************************/ 41995dfecf96Smrgstatic void 42005dfecf96Smrgrop_fi_br_as_xr(n_real *real, mpr *ratio, int nop) 42015dfecf96Smrg{ 42025dfecf96Smrg mpi iop; 42035dfecf96Smrg mpr *bigr = XALLOC(mpr); 42045dfecf96Smrg 42055dfecf96Smrg mpi_init(&iop); 42065dfecf96Smrg mpi_seti(&iop, RFI(real)); 42075dfecf96Smrg 42085dfecf96Smrg mpr_init(bigr); 42095dfecf96Smrg mpr_set(bigr, ratio); 42105dfecf96Smrg 42115dfecf96Smrg mpi_mul(&iop, &iop, mpr_den(ratio)); 42125dfecf96Smrg if (nop == NOP_ADD) 42135dfecf96Smrg mpi_add(mpr_num(bigr), &iop, mpr_num(bigr)); 42145dfecf96Smrg else 42155dfecf96Smrg mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr)); 42165dfecf96Smrg 42175dfecf96Smrg mpi_clear(&iop); 42185dfecf96Smrg RBR(real) = bigr; 42195dfecf96Smrg RTYPE(real) = N_BIGRATIO; 42205dfecf96Smrg rbr_canonicalize(real); 42215dfecf96Smrg} 42225dfecf96Smrg 42235dfecf96Smrgstatic void 42245dfecf96Smrgrop_fi_br_md_xr(n_real *real, mpr *ratio, int nop) 42255dfecf96Smrg{ 42265dfecf96Smrg mpi iop; 42275dfecf96Smrg mpr *bigr = XALLOC(mpr); 42285dfecf96Smrg 42295dfecf96Smrg mpi_init(&iop); 42305dfecf96Smrg mpi_seti(&iop, RFI(real)); 42315dfecf96Smrg 42325dfecf96Smrg mpr_init(bigr); 42335dfecf96Smrg if (nop == NOP_MUL) 42345dfecf96Smrg mpr_set(bigr, ratio); 42355dfecf96Smrg else 42365dfecf96Smrg mpr_inv(bigr, ratio); 42375dfecf96Smrg 42385dfecf96Smrg mpi_mul(mpr_num(bigr), &iop, mpr_num(bigr)); 42395dfecf96Smrg 42405dfecf96Smrg mpi_clear(&iop); 42415dfecf96Smrg RBR(real) = bigr; 42425dfecf96Smrg RTYPE(real) = N_BIGRATIO; 42435dfecf96Smrg rbr_canonicalize(real); 42445dfecf96Smrg} 42455dfecf96Smrg 42465dfecf96Smrgstatic INLINE void 42475dfecf96Smrgradd_fi_br(n_real *real, mpr *ratio) 42485dfecf96Smrg{ 42495dfecf96Smrg rop_fi_br_as_xr(real, ratio, NOP_ADD); 42505dfecf96Smrg} 42515dfecf96Smrg 42525dfecf96Smrgstatic INLINE void 42535dfecf96Smrgrsub_fi_br(n_real *real, mpr *ratio) 42545dfecf96Smrg{ 42555dfecf96Smrg rop_fi_br_as_xr(real, ratio, NOP_SUB); 42565dfecf96Smrg} 42575dfecf96Smrg 42585dfecf96Smrgstatic INLINE void 42595dfecf96Smrgrmul_fi_br(n_real *real, mpr *ratio) 42605dfecf96Smrg{ 42615dfecf96Smrg rop_fi_br_md_xr(real, ratio, NOP_MUL); 42625dfecf96Smrg} 42635dfecf96Smrg 42645dfecf96Smrgstatic INLINE void 42655dfecf96Smrgrdiv_fi_br(n_real *real, mpr *ratio) 42665dfecf96Smrg{ 42675dfecf96Smrg rop_fi_br_md_xr(real, ratio, NOP_DIV); 42685dfecf96Smrg} 42695dfecf96Smrg 42705dfecf96Smrgstatic INLINE int 42715dfecf96Smrgcmp_fi_br(long op1, mpr *op2) 42725dfecf96Smrg{ 42735dfecf96Smrg return (-mpr_cmpi(op2, op1)); 42745dfecf96Smrg} 42755dfecf96Smrg 42765dfecf96Smrg 42775dfecf96Smrg/************************************************************************ 42785dfecf96Smrg * BIGNUM FIXNUM 42795dfecf96Smrg ************************************************************************/ 42805dfecf96Smrgstatic INLINE void 42815dfecf96Smrgradd_bi_fi(n_real *real, long fi) 42825dfecf96Smrg{ 42835dfecf96Smrg mpi_addi(RBI(real), RBI(real), fi); 42845dfecf96Smrg rbi_canonicalize(real); 42855dfecf96Smrg} 42865dfecf96Smrg 42875dfecf96Smrgstatic INLINE void 42885dfecf96Smrgrsub_bi_fi(n_real *real, long fi) 42895dfecf96Smrg{ 42905dfecf96Smrg mpi_subi(RBI(real), RBI(real), fi); 42915dfecf96Smrg rbi_canonicalize(real); 42925dfecf96Smrg} 42935dfecf96Smrg 42945dfecf96Smrgstatic INLINE void 42955dfecf96Smrgrmul_bi_fi(n_real *real, long fi) 42965dfecf96Smrg{ 42975dfecf96Smrg mpi_muli(RBI(real), RBI(real), fi); 42985dfecf96Smrg rbi_canonicalize(real); 42995dfecf96Smrg} 43005dfecf96Smrg 43015dfecf96Smrgstatic void 43025dfecf96Smrgrdiv_bi_fi(n_real *real, long fi) 43035dfecf96Smrg{ 43045dfecf96Smrg mpr *bigr; 43055dfecf96Smrg 43065dfecf96Smrg if (RFI(real) == 0) 43075dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 43085dfecf96Smrg 43095dfecf96Smrg bigr = XALLOC(mpr); 43105dfecf96Smrg mpr_init(bigr); 43115dfecf96Smrg mpi_set(mpr_num(bigr), RBI(real)); 43125dfecf96Smrg mpi_seti(mpr_den(bigr), fi); 43135dfecf96Smrg RCLEAR_BI(real); 43145dfecf96Smrg RBR(real) = bigr; 43155dfecf96Smrg RTYPE(real) = N_BIGRATIO; 43165dfecf96Smrg rbr_canonicalize(real); 43175dfecf96Smrg} 43185dfecf96Smrg 43195dfecf96Smrgstatic INLINE int 43205dfecf96Smrgcmp_bi_fi(mpi *bignum, long fi) 43215dfecf96Smrg{ 43225dfecf96Smrg return (mpi_cmpi(bignum, fi)); 43235dfecf96Smrg} 43245dfecf96Smrg 43255dfecf96Smrg 43265dfecf96Smrg/************************************************************************ 43275dfecf96Smrg * BIGNUM BIGNUM 43285dfecf96Smrg ************************************************************************/ 43295dfecf96Smrgstatic INLINE void 43305dfecf96Smrgradd_bi_bi(n_real *real, mpi *bignum) 43315dfecf96Smrg{ 43325dfecf96Smrg mpi_add(RBI(real), RBI(real), bignum); 43335dfecf96Smrg rbi_canonicalize(real); 43345dfecf96Smrg} 43355dfecf96Smrg 43365dfecf96Smrgstatic INLINE void 43375dfecf96Smrgrsub_bi_bi(n_real *real, mpi *bignum) 43385dfecf96Smrg{ 43395dfecf96Smrg mpi_sub(RBI(real), RBI(real), bignum); 43405dfecf96Smrg rbi_canonicalize(real); 43415dfecf96Smrg} 43425dfecf96Smrg 43435dfecf96Smrgstatic INLINE void 43445dfecf96Smrgrmul_bi_bi(n_real *real, mpi *bignum) 43455dfecf96Smrg{ 43465dfecf96Smrg mpi_mul(RBI(real), RBI(real), bignum); 43475dfecf96Smrg rbi_canonicalize(real); 43485dfecf96Smrg} 43495dfecf96Smrg 43505dfecf96Smrgstatic void 43515dfecf96Smrgrdiv_bi_bi(n_real *real, mpi *bignum) 43525dfecf96Smrg{ 43535dfecf96Smrg mpr *bigr; 43545dfecf96Smrg 43555dfecf96Smrg if (mpi_cmpi(bignum, 0) == 0) 43565dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 43575dfecf96Smrg 43585dfecf96Smrg bigr = XALLOC(mpr); 43595dfecf96Smrg mpr_init(bigr); 43605dfecf96Smrg mpi_set(mpr_num(bigr), RBI(real)); 43615dfecf96Smrg mpi_set(mpr_den(bigr), bignum); 43625dfecf96Smrg RCLEAR_BI(real); 43635dfecf96Smrg RBR(real) = bigr; 43645dfecf96Smrg RTYPE(real) = N_BIGRATIO; 43655dfecf96Smrg rbr_canonicalize(real); 43665dfecf96Smrg} 43675dfecf96Smrg 43685dfecf96Smrgstatic INLINE int 43695dfecf96Smrgcmp_bi_bi(mpi *op1, mpi *op2) 43705dfecf96Smrg{ 43715dfecf96Smrg return (mpi_cmp(op1, op2)); 43725dfecf96Smrg} 43735dfecf96Smrg 43745dfecf96Smrg 43755dfecf96Smrg/************************************************************************ 43765dfecf96Smrg * BIGNUM FIXRATIO 43775dfecf96Smrg ************************************************************************/ 43785dfecf96Smrgstatic void 43795dfecf96Smrgrop_bi_fr_as_xr(n_real *real, long num, long den, int nop) 43805dfecf96Smrg{ 43815dfecf96Smrg mpi iop; 43825dfecf96Smrg mpr *bigr = XALLOC(mpr); 43835dfecf96Smrg 43845dfecf96Smrg mpi_init(&iop); 43855dfecf96Smrg mpi_set(&iop, RBI(real)); 43865dfecf96Smrg mpi_muli(&iop, &iop, den); 43875dfecf96Smrg 43885dfecf96Smrg mpr_init(bigr); 43895dfecf96Smrg mpr_seti(bigr, num, den); 43905dfecf96Smrg 43915dfecf96Smrg if (nop == NOP_ADD) 43925dfecf96Smrg mpi_add(mpr_num(bigr), &iop, mpr_num(bigr)); 43935dfecf96Smrg else 43945dfecf96Smrg mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr)); 43955dfecf96Smrg mpi_clear(&iop); 43965dfecf96Smrg 43975dfecf96Smrg RCLEAR_BI(real); 43985dfecf96Smrg RBR(real) = bigr; 43995dfecf96Smrg RTYPE(real) = N_BIGRATIO; 44005dfecf96Smrg rbr_canonicalize(real); 44015dfecf96Smrg} 44025dfecf96Smrg 44035dfecf96Smrgstatic INLINE void 44045dfecf96Smrgrop_bi_fr_md_xr(n_real *real, long num, long den, int nop) 44055dfecf96Smrg{ 44065dfecf96Smrg mpr *bigr = XALLOC(mpr); 44075dfecf96Smrg 44085dfecf96Smrg mpr_init(bigr); 44095dfecf96Smrg 44105dfecf96Smrg mpr_seti(bigr, num, den); 44115dfecf96Smrg 44125dfecf96Smrg if (nop == NOP_MUL) 44135dfecf96Smrg mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr)); 44145dfecf96Smrg else { 44155dfecf96Smrg mpi_mul(mpr_den(bigr), RBI(real), mpr_den(bigr)); 44165dfecf96Smrg mpr_inv(bigr, bigr); 44175dfecf96Smrg } 44185dfecf96Smrg 44195dfecf96Smrg RCLEAR_BI(real); 44205dfecf96Smrg RBR(real) = bigr; 44215dfecf96Smrg RTYPE(real) = N_BIGRATIO; 44225dfecf96Smrg rbr_canonicalize(real); 44235dfecf96Smrg} 44245dfecf96Smrg 44255dfecf96Smrgstatic INLINE void 44265dfecf96Smrgradd_bi_fr(n_real *real, long num, long den) 44275dfecf96Smrg{ 44285dfecf96Smrg rop_bi_fr_as_xr(real, num, den, NOP_ADD); 44295dfecf96Smrg} 44305dfecf96Smrg 44315dfecf96Smrgstatic INLINE void 44325dfecf96Smrgrsub_bi_fr(n_real *real, long num, long den) 44335dfecf96Smrg{ 44345dfecf96Smrg rop_bi_fr_as_xr(real, num, den, NOP_SUB); 44355dfecf96Smrg} 44365dfecf96Smrg 44375dfecf96Smrgstatic INLINE void 44385dfecf96Smrgrmul_bi_fr(n_real *real, long num, long den) 44395dfecf96Smrg{ 44405dfecf96Smrg rop_bi_fr_md_xr(real, num, den, NOP_MUL); 44415dfecf96Smrg} 44425dfecf96Smrg 44435dfecf96Smrgstatic INLINE void 44445dfecf96Smrgrdiv_bi_fr(n_real *real, long num, long den) 44455dfecf96Smrg{ 44465dfecf96Smrg rop_bi_fr_md_xr(real, num, den, NOP_DIV); 44475dfecf96Smrg} 44485dfecf96Smrg 44495dfecf96Smrgstatic int 44505dfecf96Smrgcmp_bi_fr(mpi *bignum, long num, long den) 44515dfecf96Smrg{ 44525dfecf96Smrg int cmp; 44535dfecf96Smrg mpr cmp1, cmp2; 44545dfecf96Smrg 44555dfecf96Smrg mpr_init(&cmp1); 44565dfecf96Smrg mpi_set(mpr_num(&cmp1), bignum); 44575dfecf96Smrg mpi_seti(mpr_den(&cmp1), 1); 44585dfecf96Smrg 44595dfecf96Smrg mpr_init(&cmp2); 44605dfecf96Smrg mpr_seti(&cmp2, num, den); 44615dfecf96Smrg 44625dfecf96Smrg cmp = mpr_cmp(&cmp1, &cmp2); 44635dfecf96Smrg mpr_clear(&cmp1); 44645dfecf96Smrg mpr_clear(&cmp2); 44655dfecf96Smrg 44665dfecf96Smrg return (cmp); 44675dfecf96Smrg} 44685dfecf96Smrg 44695dfecf96Smrg 44705dfecf96Smrg/************************************************************************ 44715dfecf96Smrg * BIGNUM BIGRATIO 44725dfecf96Smrg ************************************************************************/ 44735dfecf96Smrgstatic void 44745dfecf96Smrgrop_bi_br_as_xr(n_real *real, mpr *bigratio, int nop) 44755dfecf96Smrg{ 44765dfecf96Smrg mpi iop; 44775dfecf96Smrg mpr *bigr = XALLOC(mpr); 44785dfecf96Smrg 44795dfecf96Smrg mpi_init(&iop); 44805dfecf96Smrg mpi_set(&iop, RBI(real)); 44815dfecf96Smrg mpr_init(bigr); 44825dfecf96Smrg mpr_set(bigr, bigratio); 44835dfecf96Smrg 44845dfecf96Smrg mpi_mul(&iop, &iop, mpr_den(bigratio)); 44855dfecf96Smrg 44865dfecf96Smrg if (nop == NOP_ADD) 44875dfecf96Smrg mpi_add(mpr_num(bigr), &iop, mpr_num(bigr)); 44885dfecf96Smrg else 44895dfecf96Smrg mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr)); 44905dfecf96Smrg mpi_clear(&iop); 44915dfecf96Smrg 44925dfecf96Smrg RCLEAR_BI(real); 44935dfecf96Smrg RBR(real) = bigr; 44945dfecf96Smrg RTYPE(real) = N_BIGRATIO; 44955dfecf96Smrg rbr_canonicalize(real); 44965dfecf96Smrg} 44975dfecf96Smrg 44985dfecf96Smrgstatic void 44995dfecf96Smrgrop_bi_br_md_xr(n_real *real, mpr *bigratio, int nop) 45005dfecf96Smrg{ 45015dfecf96Smrg mpr *bigr = XALLOC(mpr); 45025dfecf96Smrg 45035dfecf96Smrg mpr_init(bigr); 45045dfecf96Smrg if (nop == NOP_MUL) 45055dfecf96Smrg mpr_set(bigr, bigratio); 45065dfecf96Smrg else 45075dfecf96Smrg mpr_inv(bigr, bigratio); 45085dfecf96Smrg 45095dfecf96Smrg mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr)); 45105dfecf96Smrg 45115dfecf96Smrg RCLEAR_BI(real); 45125dfecf96Smrg RBR(real) = bigr; 45135dfecf96Smrg RTYPE(real) = N_BIGRATIO; 45145dfecf96Smrg rbr_canonicalize(real); 45155dfecf96Smrg} 45165dfecf96Smrg 45175dfecf96Smrgstatic INLINE void 45185dfecf96Smrgradd_bi_br(n_real *real, mpr *bigratio) 45195dfecf96Smrg{ 45205dfecf96Smrg rop_bi_br_as_xr(real, bigratio, NOP_ADD); 45215dfecf96Smrg} 45225dfecf96Smrg 45235dfecf96Smrgstatic INLINE void 45245dfecf96Smrgrsub_bi_br(n_real *real, mpr *bigratio) 45255dfecf96Smrg{ 45265dfecf96Smrg rop_bi_br_as_xr(real, bigratio, NOP_SUB); 45275dfecf96Smrg} 45285dfecf96Smrg 45295dfecf96Smrgstatic INLINE void 45305dfecf96Smrgrmul_bi_br(n_real *real, mpr *bigratio) 45315dfecf96Smrg{ 45325dfecf96Smrg rop_bi_br_md_xr(real, bigratio, NOP_MUL); 45335dfecf96Smrg} 45345dfecf96Smrg 45355dfecf96Smrgstatic INLINE void 45365dfecf96Smrgrdiv_bi_br(n_real *real, mpr *bigratio) 45375dfecf96Smrg{ 45385dfecf96Smrg rop_bi_br_md_xr(real, bigratio, NOP_DIV); 45395dfecf96Smrg} 45405dfecf96Smrg 45415dfecf96Smrgstatic int 45425dfecf96Smrgcmp_bi_br(mpi *bignum, mpr *bigratio) 45435dfecf96Smrg{ 45445dfecf96Smrg int cmp; 45455dfecf96Smrg mpr cmp1; 45465dfecf96Smrg 45475dfecf96Smrg mpr_init(&cmp1); 45485dfecf96Smrg mpi_set(mpr_num(&cmp1), bignum); 45495dfecf96Smrg mpi_seti(mpr_den(&cmp1), 1); 45505dfecf96Smrg 45515dfecf96Smrg cmp = mpr_cmp(&cmp1, bigratio); 45525dfecf96Smrg mpr_clear(&cmp1); 45535dfecf96Smrg 45545dfecf96Smrg return (cmp); 45555dfecf96Smrg} 45565dfecf96Smrg 45575dfecf96Smrg 45585dfecf96Smrg/************************************************************************ 45595dfecf96Smrg * FIXRATIO FIXNUM 45605dfecf96Smrg ************************************************************************/ 45615dfecf96Smrgstatic void 45625dfecf96Smrgrop_fr_fi_as_xr(n_real *real, long op, int nop) 45635dfecf96Smrg{ 45645dfecf96Smrg int fit; 45655dfecf96Smrg long value = 0, num = RFRN(real), den = RFRD(real); 45665dfecf96Smrg 45675dfecf96Smrg fit = !fi_fi_mul_overflow(op, den); 45685dfecf96Smrg 45695dfecf96Smrg if (fit) { 45705dfecf96Smrg value = op * den; 45715dfecf96Smrg if (nop == NOP_ADD) 45725dfecf96Smrg fit = !fi_fi_add_overflow(value, num); 45735dfecf96Smrg else 45745dfecf96Smrg fit = !fi_fi_sub_overflow(value, num); 45755dfecf96Smrg } 45765dfecf96Smrg if (fit) { 45775dfecf96Smrg if (nop == NOP_ADD) 45785dfecf96Smrg RFRN(real) = num + value; 45795dfecf96Smrg else 45805dfecf96Smrg RFRN(real) = num - value; 45815dfecf96Smrg rfr_canonicalize(real); 45825dfecf96Smrg } 45835dfecf96Smrg else { 45845dfecf96Smrg mpi iop; 45855dfecf96Smrg mpr *bigr = XALLOC(mpr); 45865dfecf96Smrg 45875dfecf96Smrg mpr_init(bigr); 45885dfecf96Smrg mpr_seti(bigr, num, den); 45895dfecf96Smrg mpi_init(&iop); 45905dfecf96Smrg mpi_seti(&iop, op); 45915dfecf96Smrg mpi_muli(&iop, &iop, den); 45925dfecf96Smrg if (nop == NOP_ADD) 45935dfecf96Smrg mpi_add(mpr_num(bigr), mpr_num(bigr), &iop); 45945dfecf96Smrg else 45955dfecf96Smrg mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop); 45965dfecf96Smrg mpi_clear(&iop); 45975dfecf96Smrg RBR(real) = bigr; 45985dfecf96Smrg RTYPE(real) = N_BIGRATIO; 45995dfecf96Smrg rbr_canonicalize(real); 46005dfecf96Smrg } 46015dfecf96Smrg} 46025dfecf96Smrg 46035dfecf96Smrgstatic void 46045dfecf96Smrgrop_fr_fi_md_xr(n_real *real, long op, int nop) 46055dfecf96Smrg{ 46065dfecf96Smrg long num = RFRN(real), den = RFRD(real); 46075dfecf96Smrg 46085dfecf96Smrg if (nop == NOP_MUL) { 46095dfecf96Smrg if (!fi_fi_mul_overflow(op, num)) { 46105dfecf96Smrg RFRN(real) = op * num; 46115dfecf96Smrg rfr_canonicalize(real); 46125dfecf96Smrg return; 46135dfecf96Smrg } 46145dfecf96Smrg } 46155dfecf96Smrg else if (!fi_fi_mul_overflow(op, den)) { 46165dfecf96Smrg RFRD(real) = op * den; 46175dfecf96Smrg rfr_canonicalize(real); 46185dfecf96Smrg return; 46195dfecf96Smrg } 46205dfecf96Smrg 46215dfecf96Smrg { 46225dfecf96Smrg mpr *bigr = XALLOC(mpr); 46235dfecf96Smrg 46245dfecf96Smrg mpr_init(bigr); 46255dfecf96Smrg mpr_seti(bigr, num, den); 46265dfecf96Smrg if (nop == NOP_MUL) 46275dfecf96Smrg mpr_muli(bigr, bigr, op); 46285dfecf96Smrg else 46295dfecf96Smrg mpr_divi(bigr, bigr, op); 46305dfecf96Smrg RBR(real) = bigr; 46315dfecf96Smrg RTYPE(real) = N_BIGRATIO; 46325dfecf96Smrg rbr_canonicalize(real); 46335dfecf96Smrg } 46345dfecf96Smrg} 46355dfecf96Smrg 46365dfecf96Smrgstatic INLINE void 46375dfecf96Smrgradd_fr_fi(n_real *real, long op) 46385dfecf96Smrg{ 46395dfecf96Smrg rop_fr_fi_as_xr(real, op, NOP_ADD); 46405dfecf96Smrg} 46415dfecf96Smrg 46425dfecf96Smrgstatic INLINE void 46435dfecf96Smrgrsub_fr_fi(n_real *real, long op) 46445dfecf96Smrg{ 46455dfecf96Smrg rop_fr_fi_as_xr(real, op, NOP_SUB); 46465dfecf96Smrg} 46475dfecf96Smrg 46485dfecf96Smrgstatic INLINE void 46495dfecf96Smrgrmul_fr_fi(n_real *real, long op) 46505dfecf96Smrg{ 46515dfecf96Smrg rop_fr_fi_md_xr(real, op, NOP_MUL); 46525dfecf96Smrg} 46535dfecf96Smrg 46545dfecf96Smrgstatic INLINE void 46555dfecf96Smrgrdiv_fr_fi(n_real *real, long op) 46565dfecf96Smrg{ 46575dfecf96Smrg rop_fr_fi_md_xr(real, op, NOP_DIV); 46585dfecf96Smrg} 46595dfecf96Smrg 46605dfecf96Smrgstatic INLINE int 46615dfecf96Smrgcmp_fr_fi(long num, long den, long fixnum) 46625dfecf96Smrg{ 46635dfecf96Smrg return (cmp_flonum((double)num / (double)den, (double)fixnum)); 46645dfecf96Smrg} 46655dfecf96Smrg 46665dfecf96Smrg 46675dfecf96Smrg/************************************************************************ 46685dfecf96Smrg * FIXRATIO BIGNUM 46695dfecf96Smrg ************************************************************************/ 46705dfecf96Smrgstatic void 46715dfecf96Smrgrop_fr_bi_as_xr(n_real *real, mpi *bignum, int nop) 46725dfecf96Smrg{ 46735dfecf96Smrg mpi iop; 46745dfecf96Smrg mpr *bigr = XALLOC(mpr); 46755dfecf96Smrg 46765dfecf96Smrg mpr_init(bigr); 46775dfecf96Smrg mpr_seti(bigr, RFRN(real), RFRD(real)); 46785dfecf96Smrg 46795dfecf96Smrg mpi_init(&iop); 46805dfecf96Smrg mpi_set(&iop, bignum); 46815dfecf96Smrg mpi_muli(&iop, &iop, RFRD(real)); 46825dfecf96Smrg 46835dfecf96Smrg if (nop == NOP_ADD) 46845dfecf96Smrg mpi_add(mpr_num(bigr), mpr_num(bigr), &iop); 46855dfecf96Smrg else 46865dfecf96Smrg mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop); 46875dfecf96Smrg mpi_clear(&iop); 46885dfecf96Smrg 46895dfecf96Smrg RBR(real) = bigr; 46905dfecf96Smrg RTYPE(real) = N_BIGRATIO; 46915dfecf96Smrg rbr_canonicalize(real); 46925dfecf96Smrg} 46935dfecf96Smrg 46945dfecf96Smrgstatic void 46955dfecf96Smrgrop_fr_bi_md_xr(n_real *real, mpi *bignum, int nop) 46965dfecf96Smrg{ 46975dfecf96Smrg mpr *bigr = XALLOC(mpr); 46985dfecf96Smrg 46995dfecf96Smrg mpr_init(bigr); 47005dfecf96Smrg mpr_seti(bigr, RFRN(real), RFRD(real)); 47015dfecf96Smrg 47025dfecf96Smrg if (nop == NOP_MUL) 47035dfecf96Smrg mpi_mul(mpr_num(bigr), mpr_num(bigr), bignum); 47045dfecf96Smrg else 47055dfecf96Smrg mpi_mul(mpr_den(bigr), mpr_den(bigr), bignum); 47065dfecf96Smrg 47075dfecf96Smrg RBR(real) = bigr; 47085dfecf96Smrg RTYPE(real) = N_BIGRATIO; 47095dfecf96Smrg rbr_canonicalize(real); 47105dfecf96Smrg} 47115dfecf96Smrg 47125dfecf96Smrgstatic INLINE void 47135dfecf96Smrgradd_fr_bi(n_real *real, mpi *bignum) 47145dfecf96Smrg{ 47155dfecf96Smrg rop_fr_bi_as_xr(real, bignum, NOP_ADD); 47165dfecf96Smrg} 47175dfecf96Smrg 47185dfecf96Smrgstatic INLINE void 47195dfecf96Smrgrsub_fr_bi(n_real *real, mpi *bignum) 47205dfecf96Smrg{ 47215dfecf96Smrg rop_fr_bi_as_xr(real, bignum, NOP_SUB); 47225dfecf96Smrg} 47235dfecf96Smrg 47245dfecf96Smrgstatic INLINE void 47255dfecf96Smrgrmul_fr_bi(n_real *real, mpi *bignum) 47265dfecf96Smrg{ 47275dfecf96Smrg rop_fr_bi_md_xr(real, bignum, NOP_MUL); 47285dfecf96Smrg} 47295dfecf96Smrg 47305dfecf96Smrgstatic INLINE void 47315dfecf96Smrgrdiv_fr_bi(n_real *real, mpi *bignum) 47325dfecf96Smrg{ 47335dfecf96Smrg rop_fr_bi_md_xr(real, bignum, NOP_DIV); 47345dfecf96Smrg} 47355dfecf96Smrg 47365dfecf96Smrgstatic int 47375dfecf96Smrgcmp_fr_bi(long num, long den, mpi *bignum) 47385dfecf96Smrg{ 47395dfecf96Smrg int cmp; 47405dfecf96Smrg mpr cmp1, cmp2; 47415dfecf96Smrg 47425dfecf96Smrg mpr_init(&cmp1); 47435dfecf96Smrg mpr_seti(&cmp1, num, den); 47445dfecf96Smrg 47455dfecf96Smrg mpr_init(&cmp2); 47465dfecf96Smrg mpi_set(mpr_num(&cmp2), bignum); 47475dfecf96Smrg mpi_seti(mpr_den(&cmp2), 1); 47485dfecf96Smrg 47495dfecf96Smrg cmp = mpr_cmp(&cmp1, &cmp2); 47505dfecf96Smrg mpr_clear(&cmp1); 47515dfecf96Smrg mpr_clear(&cmp2); 47525dfecf96Smrg 47535dfecf96Smrg return (cmp); 47545dfecf96Smrg} 47555dfecf96Smrg 47565dfecf96Smrg 47575dfecf96Smrg/************************************************************************ 47585dfecf96Smrg * FIXRATIO FIXRATIO 47595dfecf96Smrg ************************************************************************/ 47605dfecf96Smrgstatic void 47615dfecf96Smrgrop_fr_fr_as_xr(n_real *real, long num2, long den2, int nop) 47625dfecf96Smrg{ 47635dfecf96Smrg int fit; 47645dfecf96Smrg long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0; 47655dfecf96Smrg 47665dfecf96Smrg fit = !fi_fi_mul_overflow(num1, den2); 47675dfecf96Smrg if (fit) { 47685dfecf96Smrg num = num1 * den2; 47695dfecf96Smrg fit = !fi_fi_mul_overflow(num2, den1); 47705dfecf96Smrg if (fit) { 47715dfecf96Smrg den = num2 * den1; 47725dfecf96Smrg if (nop == NOP_ADD) { 47735dfecf96Smrg if ((fit = !fi_fi_add_overflow(num, den)) != 0) 47745dfecf96Smrg num += den; 47755dfecf96Smrg } 47765dfecf96Smrg else if ((fit = !fi_fi_sub_overflow(num, den)) != 0) 47775dfecf96Smrg num -= den; 47785dfecf96Smrg if (fit) { 47795dfecf96Smrg fit = !fi_fi_mul_overflow(den1, den2); 47805dfecf96Smrg if (fit) 47815dfecf96Smrg den = den1 * den2; 47825dfecf96Smrg } 47835dfecf96Smrg } 47845dfecf96Smrg } 47855dfecf96Smrg if (fit) { 47865dfecf96Smrg RFRN(real) = num; 47875dfecf96Smrg RFRD(real) = den; 47885dfecf96Smrg rfr_canonicalize(real); 47895dfecf96Smrg } 47905dfecf96Smrg else { 47915dfecf96Smrg mpi iop; 47925dfecf96Smrg mpr *bigr = XALLOC(mpr); 47935dfecf96Smrg 47945dfecf96Smrg mpr_init(bigr); 47955dfecf96Smrg mpr_seti(bigr, num1, den1); 47965dfecf96Smrg mpi_muli(mpr_den(bigr), mpr_den(bigr), den2); 47975dfecf96Smrg mpi_init(&iop); 47985dfecf96Smrg mpi_seti(&iop, num2); 47995dfecf96Smrg mpi_muli(&iop, &iop, den1); 48005dfecf96Smrg mpi_muli(mpr_num(bigr), mpr_num(bigr), den2); 48015dfecf96Smrg if (nop == NOP_ADD) 48025dfecf96Smrg mpi_add(mpr_num(bigr), mpr_num(bigr), &iop); 48035dfecf96Smrg else 48045dfecf96Smrg mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop); 48055dfecf96Smrg mpi_clear(&iop); 48065dfecf96Smrg RBR(real) = bigr; 48075dfecf96Smrg RTYPE(real) = N_BIGRATIO; 48085dfecf96Smrg rbr_canonicalize(real); 48095dfecf96Smrg } 48105dfecf96Smrg} 48115dfecf96Smrg 48125dfecf96Smrgstatic void 48135dfecf96Smrgrop_fr_fr_md_xr(n_real *real, long num2, long den2, int nop) 48145dfecf96Smrg{ 48155dfecf96Smrg int fit; 48165dfecf96Smrg long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0; 48175dfecf96Smrg 48185dfecf96Smrg if (nop == NOP_MUL) { 48195dfecf96Smrg fit = !fi_fi_mul_overflow(num1, num2) && !fi_fi_mul_overflow(den1, den2); 48205dfecf96Smrg if (fit) { 48215dfecf96Smrg num = num1 * num2; 48225dfecf96Smrg den = den1 * den2; 48235dfecf96Smrg } 48245dfecf96Smrg } 48255dfecf96Smrg else { 48265dfecf96Smrg fit = !fi_fi_mul_overflow(num1, den2) && !fi_fi_mul_overflow(den1, num2); 48275dfecf96Smrg if (fit) { 48285dfecf96Smrg num = num1 * den2; 48295dfecf96Smrg den = den1 * num2; 48305dfecf96Smrg } 48315dfecf96Smrg } 48325dfecf96Smrg 48335dfecf96Smrg if (fit) { 48345dfecf96Smrg RFRN(real) = num; 48355dfecf96Smrg RFRD(real) = den; 48365dfecf96Smrg rfr_canonicalize(real); 48375dfecf96Smrg } 48385dfecf96Smrg else { 48395dfecf96Smrg mpr *bigr = XALLOC(mpr); 48405dfecf96Smrg 48415dfecf96Smrg mpr_init(bigr); 48425dfecf96Smrg 48435dfecf96Smrg if (nop == NOP_MUL) { 48445dfecf96Smrg mpr_seti(bigr, num1, den1); 48455dfecf96Smrg mpi_muli(mpr_num(bigr), mpr_num(bigr), num2); 48465dfecf96Smrg mpi_muli(mpr_den(bigr), mpr_den(bigr), den2); 48475dfecf96Smrg } 48485dfecf96Smrg else { 48495dfecf96Smrg mpr_seti(bigr, num1, num2); 48505dfecf96Smrg mpi_muli(mpr_num(bigr), mpr_num(bigr), den2); 48515dfecf96Smrg mpi_muli(mpr_den(bigr), mpr_den(bigr), den1); 48525dfecf96Smrg } 48535dfecf96Smrg 48545dfecf96Smrg RBR(real) = bigr; 48555dfecf96Smrg RTYPE(real) = N_BIGRATIO; 48565dfecf96Smrg rbr_canonicalize(real); 48575dfecf96Smrg } 48585dfecf96Smrg} 48595dfecf96Smrg 48605dfecf96Smrgstatic INLINE void 48615dfecf96Smrgradd_fr_fr(n_real *real, long num, long den) 48625dfecf96Smrg{ 48635dfecf96Smrg rop_fr_fr_as_xr(real, num, den, NOP_ADD); 48645dfecf96Smrg} 48655dfecf96Smrg 48665dfecf96Smrgstatic INLINE void 48675dfecf96Smrgrsub_fr_fr(n_real *real, long num, long den) 48685dfecf96Smrg{ 48695dfecf96Smrg rop_fr_fr_as_xr(real, num, den, NOP_SUB); 48705dfecf96Smrg} 48715dfecf96Smrg 48725dfecf96Smrgstatic INLINE void 48735dfecf96Smrgrmul_fr_fr(n_real *real, long num, long den) 48745dfecf96Smrg{ 48755dfecf96Smrg rop_fr_fr_md_xr(real, num, den, NOP_MUL); 48765dfecf96Smrg} 48775dfecf96Smrg 48785dfecf96Smrgstatic INLINE void 48795dfecf96Smrgrdiv_fr_fr(n_real *real, long num, long den) 48805dfecf96Smrg{ 48815dfecf96Smrg rop_fr_fr_md_xr(real, num, den, NOP_DIV); 48825dfecf96Smrg} 48835dfecf96Smrg 48845dfecf96Smrgstatic INLINE int 48855dfecf96Smrgcmp_fr_fr(long num1, long den1, long num2, long den2) 48865dfecf96Smrg{ 48875dfecf96Smrg return (cmp_flonum((double)num1 / (double)den1, 48885dfecf96Smrg (double)num2 / (double)den2)); 48895dfecf96Smrg} 48905dfecf96Smrg 48915dfecf96Smrg 48925dfecf96Smrg/************************************************************************ 48935dfecf96Smrg * FIXRATIO BIGRATIO 48945dfecf96Smrg ************************************************************************/ 48955dfecf96Smrgstatic void 48965dfecf96Smrgrop_fr_br_asmd_xr(n_real *real, mpr *bigratio, int nop) 48975dfecf96Smrg{ 48985dfecf96Smrg mpr *bigr = XALLOC(mpr); 48995dfecf96Smrg 49005dfecf96Smrg mpr_init(bigr); 49015dfecf96Smrg mpr_seti(bigr, RFRN(real), RFRD(real)); 49025dfecf96Smrg 49035dfecf96Smrg switch (nop) { 49045dfecf96Smrg case NOP_ADD: 49055dfecf96Smrg mpr_add(bigr, bigr, bigratio); 49065dfecf96Smrg break; 49075dfecf96Smrg case NOP_SUB: 49085dfecf96Smrg mpr_sub(bigr, bigr, bigratio); 49095dfecf96Smrg break; 49105dfecf96Smrg case NOP_MUL: 49115dfecf96Smrg mpr_mul(bigr, bigr, bigratio); 49125dfecf96Smrg break; 49135dfecf96Smrg default: 49145dfecf96Smrg mpr_div(bigr, bigr, bigratio); 49155dfecf96Smrg break; 49165dfecf96Smrg } 49175dfecf96Smrg 49185dfecf96Smrg RBR(real) = bigr; 49195dfecf96Smrg RTYPE(real) = N_BIGRATIO; 49205dfecf96Smrg rbr_canonicalize(real); 49215dfecf96Smrg} 49225dfecf96Smrg 49235dfecf96Smrgstatic INLINE void 49245dfecf96Smrgradd_fr_br(n_real *real, mpr *bigratio) 49255dfecf96Smrg{ 49265dfecf96Smrg rop_fr_br_asmd_xr(real, bigratio, NOP_ADD); 49275dfecf96Smrg} 49285dfecf96Smrg 49295dfecf96Smrgstatic INLINE void 49305dfecf96Smrgrsub_fr_br(n_real *real, mpr *bigratio) 49315dfecf96Smrg{ 49325dfecf96Smrg rop_fr_br_asmd_xr(real, bigratio, NOP_SUB); 49335dfecf96Smrg} 49345dfecf96Smrg 49355dfecf96Smrgstatic INLINE void 49365dfecf96Smrgrmul_fr_br(n_real *real, mpr *bigratio) 49375dfecf96Smrg{ 49385dfecf96Smrg rop_fr_br_asmd_xr(real, bigratio, NOP_MUL); 49395dfecf96Smrg} 49405dfecf96Smrg 49415dfecf96Smrgstatic INLINE void 49425dfecf96Smrgrdiv_fr_br(n_real *real, mpr *bigratio) 49435dfecf96Smrg{ 49445dfecf96Smrg rop_fr_br_asmd_xr(real, bigratio, NOP_DIV); 49455dfecf96Smrg} 49465dfecf96Smrg 49475dfecf96Smrgstatic int 49485dfecf96Smrgcmp_fr_br(long num, long den, mpr *bigratio) 49495dfecf96Smrg{ 49505dfecf96Smrg int cmp; 49515dfecf96Smrg mpr cmp1; 49525dfecf96Smrg 49535dfecf96Smrg mpr_init(&cmp1); 49545dfecf96Smrg mpr_seti(&cmp1, num, den); 49555dfecf96Smrg 49565dfecf96Smrg cmp = mpr_cmp(&cmp1, bigratio); 49575dfecf96Smrg mpr_clear(&cmp1); 49585dfecf96Smrg 49595dfecf96Smrg return (cmp); 49605dfecf96Smrg} 49615dfecf96Smrg 49625dfecf96Smrg 49635dfecf96Smrg/************************************************************************ 49645dfecf96Smrg * BIGRATIO FIXNUM 49655dfecf96Smrg ************************************************************************/ 49665dfecf96Smrgstatic void 49675dfecf96Smrgrop_br_fi_asmd_xr(n_real *real, long fixnum, int nop) 49685dfecf96Smrg{ 49695dfecf96Smrg mpr *bigratio = RBR(real); 49705dfecf96Smrg 49715dfecf96Smrg switch (nop) { 49725dfecf96Smrg case NOP_ADD: 49735dfecf96Smrg mpr_addi(bigratio, bigratio, fixnum); 49745dfecf96Smrg break; 49755dfecf96Smrg case NOP_SUB: 49765dfecf96Smrg mpr_subi(bigratio, bigratio, fixnum); 49775dfecf96Smrg break; 49785dfecf96Smrg case NOP_MUL: 49795dfecf96Smrg mpr_muli(bigratio, bigratio, fixnum); 49805dfecf96Smrg break; 49815dfecf96Smrg default: 49825dfecf96Smrg if (fixnum == 0) 49835dfecf96Smrg fatal_error(DIVIDE_BY_ZERO); 49845dfecf96Smrg mpr_divi(bigratio, bigratio, fixnum); 49855dfecf96Smrg break; 49865dfecf96Smrg } 49875dfecf96Smrg rbr_canonicalize(real); 49885dfecf96Smrg} 49895dfecf96Smrg 49905dfecf96Smrgstatic INLINE void 49915dfecf96Smrgradd_br_fi(n_real *real, long fixnum) 49925dfecf96Smrg{ 49935dfecf96Smrg rop_br_fi_asmd_xr(real, fixnum, NOP_ADD); 49945dfecf96Smrg} 49955dfecf96Smrg 49965dfecf96Smrgstatic INLINE void 49975dfecf96Smrgrsub_br_fi(n_real *real, long fixnum) 49985dfecf96Smrg{ 49995dfecf96Smrg rop_br_fi_asmd_xr(real, fixnum, NOP_SUB); 50005dfecf96Smrg} 50015dfecf96Smrg 50025dfecf96Smrgstatic INLINE void 50035dfecf96Smrgrmul_br_fi(n_real *real, long fixnum) 50045dfecf96Smrg{ 50055dfecf96Smrg rop_br_fi_asmd_xr(real, fixnum, NOP_MUL); 50065dfecf96Smrg} 50075dfecf96Smrg 50085dfecf96Smrgstatic INLINE void 50095dfecf96Smrgrdiv_br_fi(n_real *real, long fixnum) 50105dfecf96Smrg{ 50115dfecf96Smrg rop_br_fi_asmd_xr(real, fixnum, NOP_DIV); 50125dfecf96Smrg} 50135dfecf96Smrg 50145dfecf96Smrgstatic int 50155dfecf96Smrgcmp_br_fi(mpr *bigratio, long fixnum) 50165dfecf96Smrg{ 50175dfecf96Smrg int cmp; 50185dfecf96Smrg mpr cmp2; 50195dfecf96Smrg 50205dfecf96Smrg mpr_init(&cmp2); 50215dfecf96Smrg mpr_seti(&cmp2, fixnum, 1); 50225dfecf96Smrg cmp = mpr_cmp(bigratio, &cmp2); 50235dfecf96Smrg mpr_clear(&cmp2); 50245dfecf96Smrg 50255dfecf96Smrg return (cmp); 50265dfecf96Smrg} 50275dfecf96Smrg 50285dfecf96Smrg 50295dfecf96Smrg/************************************************************************ 50305dfecf96Smrg * BIGRATIO BIGNUM 50315dfecf96Smrg ************************************************************************/ 50325dfecf96Smrgstatic void 50335dfecf96Smrgrop_br_bi_as_xr(n_real *real, mpi *bignum, int nop) 50345dfecf96Smrg{ 50355dfecf96Smrg mpi iop; 50365dfecf96Smrg 50375dfecf96Smrg mpi_init(&iop); 50385dfecf96Smrg mpi_set(&iop, bignum); 50395dfecf96Smrg 50405dfecf96Smrg mpi_mul(&iop, &iop, RBRD(real)); 50415dfecf96Smrg if (nop == NOP_ADD) 50425dfecf96Smrg mpi_add(RBRN(real), RBRN(real), &iop); 50435dfecf96Smrg else 50445dfecf96Smrg mpi_sub(RBRN(real), RBRN(real), &iop); 50455dfecf96Smrg mpi_clear(&iop); 50465dfecf96Smrg rbr_canonicalize(real); 50475dfecf96Smrg} 50485dfecf96Smrg 50495dfecf96Smrgstatic INLINE void 50505dfecf96Smrgradd_br_bi(n_real *real, mpi *bignum) 50515dfecf96Smrg{ 50525dfecf96Smrg rop_br_bi_as_xr(real, bignum, NOP_ADD); 50535dfecf96Smrg} 50545dfecf96Smrg 50555dfecf96Smrgstatic INLINE void 50565dfecf96Smrgrsub_br_bi(n_real *real, mpi *bignum) 50575dfecf96Smrg{ 50585dfecf96Smrg rop_br_bi_as_xr(real, bignum, NOP_SUB); 50595dfecf96Smrg} 50605dfecf96Smrg 50615dfecf96Smrgstatic INLINE void 50625dfecf96Smrgrmul_br_bi(n_real *real, mpi *bignum) 50635dfecf96Smrg{ 50645dfecf96Smrg mpi_mul(RBRN(real), RBRN(real), bignum); 50655dfecf96Smrg rbr_canonicalize(real); 50665dfecf96Smrg} 50675dfecf96Smrg 50685dfecf96Smrgstatic INLINE void 50695dfecf96Smrgrdiv_br_bi(n_real *real, mpi *bignum) 50705dfecf96Smrg{ 50715dfecf96Smrg mpi_mul(RBRD(real), RBRD(real), bignum); 50725dfecf96Smrg rbr_canonicalize(real); 50735dfecf96Smrg} 50745dfecf96Smrg 50755dfecf96Smrgstatic int 50765dfecf96Smrgcmp_br_bi(mpr *bigratio, mpi *bignum) 50775dfecf96Smrg{ 50785dfecf96Smrg int cmp; 50795dfecf96Smrg mpr cmp1; 50805dfecf96Smrg 50815dfecf96Smrg mpr_init(&cmp1); 50825dfecf96Smrg mpi_set(mpr_num(&cmp1), bignum); 50835dfecf96Smrg mpi_seti(mpr_den(&cmp1), 1); 50845dfecf96Smrg 50855dfecf96Smrg cmp = mpr_cmp(bigratio, &cmp1); 50865dfecf96Smrg mpr_clear(&cmp1); 50875dfecf96Smrg 50885dfecf96Smrg return (cmp); 50895dfecf96Smrg} 50905dfecf96Smrg 50915dfecf96Smrg 50925dfecf96Smrg/************************************************************************ 50935dfecf96Smrg * BIGRATIO FIXRATIO 50945dfecf96Smrg ************************************************************************/ 50955dfecf96Smrgstatic void 50965dfecf96Smrgrop_br_fr_asmd_xr(n_real *real, long num, long den, int nop) 50975dfecf96Smrg{ 50985dfecf96Smrg mpr *bigratio = RBR(real), rop; 50995dfecf96Smrg 51005dfecf96Smrg mpr_init(&rop); 51015dfecf96Smrg mpr_seti(&rop, num, den); 51025dfecf96Smrg switch (nop) { 51035dfecf96Smrg case NOP_ADD: 51045dfecf96Smrg mpr_add(bigratio, bigratio, &rop); 51055dfecf96Smrg break; 51065dfecf96Smrg case NOP_SUB: 51075dfecf96Smrg mpr_sub(bigratio, bigratio, &rop); 51085dfecf96Smrg break; 51095dfecf96Smrg case NOP_MUL: 51105dfecf96Smrg mpr_mul(bigratio, bigratio, &rop); 51115dfecf96Smrg break; 51125dfecf96Smrg default: 51135dfecf96Smrg mpr_div(bigratio, bigratio, &rop); 51145dfecf96Smrg break; 51155dfecf96Smrg } 51165dfecf96Smrg mpr_clear(&rop); 51175dfecf96Smrg rbr_canonicalize(real); 51185dfecf96Smrg} 51195dfecf96Smrg 51205dfecf96Smrgstatic INLINE void 51215dfecf96Smrgradd_br_fr(n_real *real, long num, long den) 51225dfecf96Smrg{ 51235dfecf96Smrg rop_br_fr_asmd_xr(real, num, den, NOP_ADD); 51245dfecf96Smrg} 51255dfecf96Smrg 51265dfecf96Smrgstatic INLINE void 51275dfecf96Smrgrsub_br_fr(n_real *real, long num, long den) 51285dfecf96Smrg{ 51295dfecf96Smrg rop_br_fr_asmd_xr(real, num, den, NOP_SUB); 51305dfecf96Smrg} 51315dfecf96Smrg 51325dfecf96Smrgstatic INLINE void 51335dfecf96Smrgrmul_br_fr(n_real *real, long num, long den) 51345dfecf96Smrg{ 51355dfecf96Smrg rop_br_fr_asmd_xr(real, num, den, NOP_MUL); 51365dfecf96Smrg} 51375dfecf96Smrg 51385dfecf96Smrgstatic INLINE void 51395dfecf96Smrgrdiv_br_fr(n_real *real, long num, long den) 51405dfecf96Smrg{ 51415dfecf96Smrg rop_br_fr_asmd_xr(real, num, den, NOP_DIV); 51425dfecf96Smrg} 51435dfecf96Smrg 51445dfecf96Smrgstatic int 51455dfecf96Smrgcmp_br_fr(mpr *bigratio, long num, long den) 51465dfecf96Smrg{ 51475dfecf96Smrg int cmp; 51485dfecf96Smrg mpr cmp2; 51495dfecf96Smrg 51505dfecf96Smrg mpr_init(&cmp2); 51515dfecf96Smrg mpr_seti(&cmp2, num, den); 51525dfecf96Smrg cmp = mpr_cmp(bigratio, &cmp2); 51535dfecf96Smrg mpr_clear(&cmp2); 51545dfecf96Smrg 51555dfecf96Smrg return (cmp); 51565dfecf96Smrg} 51575dfecf96Smrg 51585dfecf96Smrg 51595dfecf96Smrg/************************************************************************ 51605dfecf96Smrg * BIGRATIO BIGRATIO 51615dfecf96Smrg ************************************************************************/ 51625dfecf96Smrgstatic INLINE void 51635dfecf96Smrgradd_br_br(n_real *real, mpr *bigratio) 51645dfecf96Smrg{ 51655dfecf96Smrg mpr_add(RBR(real), RBR(real), bigratio); 51665dfecf96Smrg rbr_canonicalize(real); 51675dfecf96Smrg} 51685dfecf96Smrg 51695dfecf96Smrgstatic INLINE void 51705dfecf96Smrgrsub_br_br(n_real *real, mpr *bigratio) 51715dfecf96Smrg{ 51725dfecf96Smrg mpr_sub(RBR(real), RBR(real), bigratio); 51735dfecf96Smrg rbr_canonicalize(real); 51745dfecf96Smrg} 51755dfecf96Smrg 51765dfecf96Smrgstatic INLINE void 51775dfecf96Smrgrmul_br_br(n_real *real, mpr *bigratio) 51785dfecf96Smrg{ 51795dfecf96Smrg mpr_mul(RBR(real), RBR(real), bigratio); 51805dfecf96Smrg rbr_canonicalize(real); 51815dfecf96Smrg} 51825dfecf96Smrg 51835dfecf96Smrgstatic INLINE void 51845dfecf96Smrgrdiv_br_br(n_real *real, mpr *bigratio) 51855dfecf96Smrg{ 51865dfecf96Smrg mpr_div(RBR(real), RBR(real), bigratio); 51875dfecf96Smrg rbr_canonicalize(real); 51885dfecf96Smrg} 51895dfecf96Smrg 51905dfecf96Smrgstatic INLINE int 51915dfecf96Smrgcmp_br_br(mpr *op1, mpr *op2) 51925dfecf96Smrg{ 51935dfecf96Smrg return (mpr_cmp(op1, op2)); 51945dfecf96Smrg} 5195