mathimp.c revision 5dfecf96 
1/*
2 * Copyright (c) 2002 by The XFree86 Project, Inc.
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a
5 * copy of this software and associated documentation files (the "Software"),
6 * to deal in the Software without restriction, including without limitation
7 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
8 * and/or sell copies of the Software, and to permit persons to whom the
9 * Software is furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
17 * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
18 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
19 * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
20 * SOFTWARE.
21 *
22 * Except as contained in this notice, the name of the XFree86 Project shall
23 * not be used in advertising or otherwise to promote the sale, use or other
24 * dealings in this Software without prior written authorization from the
25 * XFree86 Project.
26 *
27 * Author: Paulo César Pereira de Andrade
28 */
29
30/* $XFree86: xc/programs/xedit/lisp/mathimp.c,v 1.14tsi Exp $ */
31
32
33/*
34 * Defines
35 */
36#ifdef __GNUC__
37#define CONST			__attribute__ ((__const__))
38#else
39#define CONST			/**/
40#endif
41
42/* mask for checking overflow on long operations */
43#ifdef LONG64
44#define FI_MASK			0x4000000000000000L
45#define LONGSBITS		63
46#else
47#define FI_MASK			0x40000000L
48#define LONGSBITS		31
49#endif
50
51#define N_FIXNUM		1
52#define N_BIGNUM		2
53#define N_FLONUM		3
54#define N_FIXRATIO		4
55#define N_BIGRATIO		5
56
57#define NOP_ADD			1
58#define NOP_SUB			2
59#define NOP_MUL			3
60#define NOP_DIV			4
61
62#define NDIVIDE_CEIL		1
63#define NDIVIDE_FLOOR		2
64#define NDIVIDE_ROUND		3
65#define NDIVIDE_TRUNC		4
66
67/* real part from number */
68#define NREAL(num)		&((num)->real)
69#define NRTYPE(num)		(num)->real.type
70#define NRFI(num)		(num)->real.data.fixnum
71#define NRBI(num)		(num)->real.data.bignum
72#define NRFF(num)		(num)->real.data.flonum
73#define NRFRN(Num)		(Num)->real.data.fixratio.num
74#define NRFRD(num)		(num)->real.data.fixratio.den
75#define NRBR(num)		(num)->real.data.bigratio
76#define NRBRN(num)		mpr_num(NRBR(num))
77#define NRBRD(num)		mpr_den(NRBR(num))
78
79#define NRCLEAR_BI(num)		mpi_clear(NRBI(num)); XFREE(NRBI(num))
80#define NRCLEAR_BR(num)		mpr_clear(NRBR(num)); XFREE(NRBR(num))
81
82/* imag part from number */
83#define NIMAG(num)		&((num)->imag)
84#define NITYPE(num)		(num)->imag.type
85#define NIFI(num)		(num)->imag.data.fixnum
86#define NIBI(num)		(num)->imag.data.bignum
87#define NIFF(num)		(num)->imag.data.flonum
88#define NIFRN(Num)		(Num)->imag.data.fixratio.num
89#define NIFRD(num)		(num)->imag.data.fixratio.den
90#define NIBR(num)		(num)->imag.data.bigratio
91#define NIBRN(obj)		mpr_num(NIBR(obj))
92#define NIBRD(obj)		mpr_den(NIBR(obj))
93
94/* real number fields */
95#define RTYPE(real)		(real)->type
96#define RFI(real)		(real)->data.fixnum
97#define RBI(real)		(real)->data.bignum
98#define RFF(real)		(real)->data.flonum
99#define RFRN(real)		(real)->data.fixratio.num
100#define RFRD(real)		(real)->data.fixratio.den
101#define RBR(real)		(real)->data.bigratio
102#define RBRN(real)		mpr_num(RBR(real))
103#define RBRD(real)		mpr_den(RBR(real))
104
105#define RINTEGERP(real)				\
106    (RTYPE(real) == N_FIXNUM || RTYPE(real) == N_BIGNUM)
107
108#define RCLEAR_BI(real)		mpi_clear(RBI(real)); XFREE(RBI(real))
109#define RCLEAR_BR(real)		mpr_clear(RBR(real)); XFREE(RBR(real))
110
111/* numeric value from lisp object */
112#define OFI(object)		FIXNUM_VALUE(object)
113#define OII(object)		INT_VALUE(object)
114#define OBI(object)		(object)->data.mp.integer
115#define ODF(object)		DFLOAT_VALUE(object)
116#define OFRN(object)		(object)->data.ratio.numerator
117#define OFRD(object)		(object)->data.ratio.denominator
118#define OBR(object)		(object)->data.mp.ratio
119#define OBRN(object)		mpr_num(OBR(object))
120#define OBRD(object)		mpr_den(OBR(object))
121#define OCXR(object)		(object)->data.complex.real
122#define OCXI(object)		(object)->data.complex.imag
123
124#define XALLOC(type)		LispMalloc(sizeof(type))
125#define XFREE(ptr)		LispFree(ptr)
126
127
128/*
129 * Types
130 */
131typedef struct _n_real {
132    char type;
133    union {
134	long fixnum;
135	mpi *bignum;
136	double flonum;
137	struct {
138	    long num;
139	    long den;
140	} fixratio;
141	mpr *bigratio;
142    } data;
143} n_real;
144
145typedef struct _n_number {
146    char complex;
147    n_real real;
148    n_real imag;
149} n_number;
150
151
152/*
153 * Prototypes
154 */
155static void number_init(void);
156static LispObj *number_pi(void);
157
158static void set_real_real(n_real*, n_real*);
159static void set_real_object(n_real*, LispObj*);
160static void set_number_object(n_number*, LispObj*);
161static void clear_real(n_real*);
162static void clear_number(n_number*);
163
164static LispObj *make_real_object(n_real*);
165static LispObj *make_number_object(n_number*);
166
167static void fatal_error(int);
168static void fatal_object_error(LispObj*, int);
169static void fatal_builtin_object_error(LispBuiltin*, LispObj*, int);
170
171static double bi_getd(mpi*);
172static double br_getd(mpr*);
173
174/* add */
175static void add_real_object(n_real*, LispObj*);
176static void add_number_object(n_number*, LispObj*);
177
178/* sub */
179static void sub_real_object(n_real*, LispObj*);
180static void sub_number_object(n_number*, LispObj*);
181
182/* mul */
183static void mul_real_object(n_real*, LispObj*);
184static void mul_number_object(n_number*, LispObj*);
185
186/* div */
187static void div_real_object(n_real*, LispObj*);
188static void div_number_object(n_number*, LispObj*);
189
190/* compare */
191static int cmp_real_real(n_real*, n_real*);
192static int cmp_real_object(n_real*, LispObj*);
193#if 0	/* not used */
194static int cmp_number_object(n_number*, LispObj*);
195#endif
196static int cmp_object_object(LispObj*, LispObj*, int);
197
198/* fixnum */
199static INLINE int fi_fi_add_overflow(long, long) CONST;
200static INLINE int fi_fi_sub_overflow(long, long) CONST;
201static INLINE int fi_fi_mul_overflow(long, long) CONST;
202
203/* bignum */
204static void rbi_canonicalize(n_real*);
205
206/* ratio */
207static void rfr_canonicalize(n_real*);
208static void rbr_canonicalize(n_real*);
209
210/* complex */
211static void ncx_canonicalize(n_number*);
212
213/* abs */
214static void abs_real(n_real*);
215static void abs_number(n_number*);
216static void nabs_cx(n_number*);
217static INLINE void rabs_fi(n_real*);
218static INLINE void rabs_bi(n_real*);
219static INLINE void rabs_ff(n_real*);
220static INLINE void rabs_fr(n_real*);
221static INLINE void rabs_br(n_real*);
222
223/* neg */
224static void neg_real(n_real*);
225static void neg_number(n_number*);
226static void rneg_fi(n_real*);
227static INLINE void rneg_bi(n_real*);
228static INLINE void rneg_ff(n_real*);
229static INLINE void rneg_fr(n_real*);
230static INLINE void rneg_br(n_real*);
231
232/* sqrt */
233static void sqrt_real(n_real*);
234static void sqrt_number(n_number*);
235static void rsqrt_xi(n_real*);
236static void rsqrt_xr(n_real*);
237static void rsqrt_ff(n_real*);
238static void nsqrt_cx(n_number*);
239static void nsqrt_xi(n_number*);
240static void nsqrt_ff(n_number*);
241static void nsqrt_xr(n_number*);
242
243/* mod */
244static void mod_real_real(n_real*, n_real*);
245static void mod_real_object(n_real*, LispObj*);
246static void rmod_fi_fi(n_real*, long);
247static void rmod_fi_bi(n_real*, mpi*);
248static void rmod_bi_fi(n_real*, long);
249static void rmod_bi_bi(n_real*, mpi*);
250
251/* rem */
252static void rem_real_object(n_real*, LispObj*);
253static void rrem_fi_fi(n_real*, long);
254static void rrem_fi_bi(n_real*, mpi*);
255static void rrem_bi_fi(n_real*, long);
256static void rrem_bi_bi(n_real*, mpi*);
257
258/* gcd */
259static void gcd_real_object(n_real*, LispObj*);
260
261/* and */
262static void and_real_object(n_real*, LispObj*);
263
264/* eqv */
265static void eqv_real_object(n_real*, LispObj*);
266
267/* ior */
268static void ior_real_object(n_real*, LispObj*);
269
270/* not */
271static void not_real(n_real*);
272
273/* xor */
274static void xor_real_object(n_real*, LispObj*);
275
276/* divide */
277static void divide_number_object(n_number*, LispObj*, int, int);
278static void ndivide_xi_xi(n_number*, LispObj*, int, int);
279static void ndivide_flonum(n_number*, double, double, int, int);
280static void ndivide_xi_xr(n_number*, LispObj*, int, int);
281static void ndivide_xr_xi(n_number*, LispObj*, int, int);
282static void ndivide_xr_xr(n_number*, LispObj*, int, int);
283
284/* real complex */
285static void nadd_re_cx(n_number*, LispObj*);
286static void nsub_re_cx(n_number*, LispObj*);
287static void nmul_re_cx(n_number*, LispObj*);
288static void ndiv_re_cx(n_number*, LispObj*);
289
290/* complex real */
291static void nadd_cx_re(n_number*, LispObj*);
292static void nsub_cx_re(n_number*, LispObj*);
293static void nmul_cx_re(n_number*, LispObj*);
294static void ndiv_cx_re(n_number*, LispObj*);
295
296/* complex complex */
297static void nadd_cx_cx(n_number*, LispObj*);
298static void nsub_cx_cx(n_number*, LispObj*);
299static void nmul_cx_cx(n_number*, LispObj*);
300static void ndiv_cx_cx(n_number*, LispObj*);
301static int cmp_cx_cx(LispObj*, LispObj*);
302
303/* flonum flonum */
304static void radd_flonum(n_real*, double, double);
305static void rsub_flonum(n_real*, double, double);
306static void rmul_flonum(n_real*, double, double);
307static void rdiv_flonum(n_real*, double, double);
308static int cmp_flonum(double, double);
309
310/* fixnum fixnum */
311static void rop_fi_fi_bi(n_real*, long, int);
312static INLINE void radd_fi_fi(n_real*, long);
313static INLINE void rsub_fi_fi(n_real*, long);
314static INLINE void rmul_fi_fi(n_real*, long);
315static INLINE void rdiv_fi_fi(n_real*, long);
316static INLINE int cmp_fi_fi(long, long);
317static void ndivide_fi_fi(n_number*, long, int, int);
318
319/* fixnum bignum */
320static void rop_fi_bi_xi(n_real*, mpi*, int);
321static INLINE void radd_fi_bi(n_real*, mpi*);
322static INLINE void rsub_fi_bi(n_real*, mpi*);
323static INLINE void rmul_fi_bi(n_real*, mpi*);
324static void rdiv_fi_bi(n_real*, mpi*);
325static INLINE int cmp_fi_bi(long, mpi*);
326
327/* fixnum fixratio */
328static void rop_fi_fr_as_xr(n_real*, long, long, int);
329static void rop_fi_fr_md_xr(n_real*, long, long, int);
330static INLINE void radd_fi_fr(n_real*, long, long);
331static INLINE void rsub_fi_fr(n_real*, long, long);
332static INLINE void rmul_fi_fr(n_real*, long, long);
333static INLINE void rdiv_fi_fr(n_real*, long, long);
334static INLINE int cmp_fi_fr(long, long, long);
335
336/* fixnum bigratio */
337static void rop_fi_br_as_xr(n_real*, mpr*, int);
338static void rop_fi_br_md_xr(n_real*, mpr*, int);
339static INLINE void radd_fi_br(n_real*, mpr*);
340static INLINE void rsub_fi_br(n_real*, mpr*);
341static INLINE void rmul_fi_br(n_real*, mpr*);
342static INLINE void rdiv_fi_br(n_real*, mpr*);
343static INLINE int cmp_fi_br(long, mpr*);
344
345/* bignum fixnum */
346static INLINE void radd_bi_fi(n_real*, long);
347static INLINE void rsub_bi_fi(n_real*, long);
348static INLINE void rmul_bi_fi(n_real*, long);
349static void rdiv_bi_fi(n_real*, long);
350static INLINE int cmp_bi_fi(mpi*, long);
351
352/* bignum bignum */
353static INLINE void radd_bi_bi(n_real*, mpi*);
354static INLINE void rsub_bi_bi(n_real*, mpi*);
355static INLINE void rmul_bi_bi(n_real*, mpi*);
356static void rdiv_bi_bi(n_real*, mpi*);
357static INLINE int cmp_bi_bi(mpi*, mpi*);
358
359/* bignum fixratio */
360static void rop_bi_fr_as_xr(n_real*, long, long, int);
361static void rop_bi_fr_md_xr(n_real*, long, long, int);
362static INLINE void radd_bi_fr(n_real*, long, long);
363static INLINE void rsub_bi_fr(n_real*, long, long);
364static INLINE void rmul_bi_fr(n_real*, long, long);
365static INLINE void rdiv_bi_fr(n_real*, long, long);
366static int cmp_bi_fr(mpi*, long, long);
367
368/* bignum bigratio */
369static void rop_bi_br_as_xr(n_real*, mpr*, int);
370static void rop_bi_br_md_xr(n_real*, mpr*, int);
371static INLINE void radd_bi_br(n_real*, mpr*);
372static INLINE void rsub_bi_br(n_real*, mpr*);
373static INLINE void rmul_bi_br(n_real*, mpr*);
374static INLINE void rdiv_bi_br(n_real*, mpr*);
375static int cmp_bi_br(mpi*, mpr*);
376
377/* fixratio fixnum */
378static void rop_fr_fi_as_xr(n_real*, long, int);
379static void rop_fr_fi_md_xr(n_real*, long, int);
380static INLINE void radd_fr_fi(n_real*, long);
381static INLINE void rsub_fr_fi(n_real*, long);
382static INLINE void rmul_fr_fi(n_real*, long);
383static INLINE void rdiv_fr_fi(n_real*, long);
384static INLINE int cmp_fr_fi(long, long, long);
385
386/* fixratio bignum */
387static void rop_fr_bi_as_xr(n_real*, mpi*, int);
388static void rop_fr_bi_md_xr(n_real*, mpi*, int);
389static INLINE void radd_fr_bi(n_real*, mpi*);
390static INLINE void rsub_fr_bi(n_real*, mpi*);
391static INLINE void rmul_fr_bi(n_real*, mpi*);
392static INLINE void rdiv_fr_bi(n_real*, mpi*);
393static int cmp_fr_bi(long, long, mpi*);
394
395/* fixratio fixratio */
396static void rop_fr_fr_as_xr(n_real*, long, long, int);
397static void rop_fr_fr_md_xr(n_real*, long, long, int);
398static INLINE void radd_fr_fr(n_real*, long, long);
399static INLINE void rsub_fr_fr(n_real*, long, long);
400static INLINE void rmul_fr_fr(n_real*, long, long);
401static INLINE void rdiv_fr_fr(n_real*, long, long);
402static INLINE int cmp_fr_fr(long, long, long, long);
403
404/* fixratio bigratio */
405static void rop_fr_br_asmd_xr(n_real*, mpr*, int);
406static INLINE void radd_fr_br(n_real*, mpr*);
407static INLINE void rsub_fr_br(n_real*, mpr*);
408static INLINE void rmul_fr_br(n_real*, mpr*);
409static INLINE void rdiv_fr_br(n_real*, mpr*);
410static int cmp_fr_br(long, long, mpr*);
411
412/* bigratio fixnum */
413static void rop_br_fi_asmd_xr(n_real*, long, int);
414static INLINE void radd_br_fi(n_real*, long);
415static INLINE void rsub_br_fi(n_real*, long);
416static INLINE void rmul_br_fi(n_real*, long);
417static INLINE void rdiv_br_fi(n_real*, long);
418static int cmp_br_fi(mpr*, long);
419
420/* bigratio bignum */
421static void rop_br_bi_as_xr(n_real*, mpi*, int);
422static INLINE void radd_br_bi(n_real*, mpi*);
423static INLINE void rsub_br_bi(n_real*, mpi*);
424static INLINE void rmul_br_bi(n_real*, mpi*);
425static INLINE void rdiv_br_bi(n_real*, mpi*);
426static int cmp_br_bi(mpr*, mpi*);
427
428/* bigratio fixratio */
429static void rop_br_fr_asmd_xr(n_real*, long, long, int);
430static INLINE void radd_br_fr(n_real*, long, long);
431static INLINE void rsub_br_fr(n_real*, long, long);
432static INLINE void rmul_br_fr(n_real*, long, long);
433static INLINE void rdiv_br_fr(n_real*, long, long);
434static int cmp_br_fr(mpr*, long, long);
435
436/* bigratio bigratio */
437static INLINE void radd_br_br(n_real*, mpr*);
438static INLINE void rsub_br_br(n_real*, mpr*);
439static INLINE void rmul_br_br(n_real*, mpr*);
440static INLINE void rdiv_br_br(n_real*, mpr*);
441static INLINE int cmp_br_br(mpr*, mpr*);
442
443/*
444 * Initialization
445 */
446static n_real zero, one, two;
447
448static char *fatal_error_strings[] = {
449#define DIVIDE_BY_ZERO			0
450    "divide by zero",
451#define FLOATING_POINT_OVERFLOW		1
452    "floating point overflow",
453#define FLOATING_POINT_EXCEPTION	2
454    "floating point exception"
455};
456
457static char *fatal_object_error_strings[] = {
458#define NOT_A_NUMBER			0
459    "is not a number",
460#define NOT_A_REAL_NUMBER		1
461    "is not a real number",
462#define NOT_AN_INTEGER			2
463    "is not an integer"
464};
465
466/*
467 * Implementation
468 */
469static void
470fatal_error(int num)
471{
472    LispDestroy(fatal_error_strings[num]);
473}
474
475static void
476fatal_object_error(LispObj *obj, int num)
477{
478    LispDestroy("%s %s", STROBJ(obj), fatal_object_error_strings[num]);
479}
480
481static void
482fatal_builtin_object_error(LispBuiltin *builtin, LispObj *obj, int num)
483{
484    LispDestroy("%s: %s %s", STRFUN(builtin), STROBJ(obj),
485		fatal_object_error_strings[num]);
486}
487
488static void
489number_init(void)
490{
491    zero.type = one.type = two.type = N_FIXNUM;
492    zero.data.fixnum = 0;
493    one.data.fixnum = 1;
494    two.data.fixnum = 2;
495}
496
497static double
498bi_getd(mpi *bignum)
499{
500    double value = mpi_getd(bignum);
501
502    if (!finite(value))
503	fatal_error(FLOATING_POINT_EXCEPTION);
504
505    return (value);
506}
507
508static double
509br_getd(mpr *bigratio)
510{
511    double value = mpr_getd(bigratio);
512
513    if (!finite(value))
514	fatal_error(FLOATING_POINT_EXCEPTION);
515
516    return (value);
517}
518
519static LispObj *
520number_pi(void)
521{
522    LispObj *result;
523#ifndef M_PI
524#define M_PI 3.14159265358979323846
525#endif
526    result = DFLOAT(M_PI);
527
528    return (result);
529}
530
531static void
532set_real_real(n_real *real, n_real *val)
533{
534    switch (RTYPE(real) = RTYPE(val)) {
535	case N_FIXNUM:
536	    RFI(real) = RFI(val);
537	    break;
538	case N_BIGNUM:
539	    RBI(real) = XALLOC(mpi);
540	    mpi_init(RBI(real));
541	    mpi_set(RBI(real), RBI(val));
542	    break;
543	case N_FLONUM:
544	    RFF(real) = RFF(val);
545	    break;
546	case N_FIXRATIO:
547	    RFRN(real) = RFRN(val);
548	    RFRD(real) = RFRD(val);
549	    break;
550	case N_BIGRATIO:
551	    RBR(real) = XALLOC(mpr);
552	    mpr_init(RBR(real));
553	    mpr_set(RBR(real), RBR(val));
554	    break;
555    }
556}
557
558static void
559set_real_object(n_real *real, LispObj *obj)
560{
561    switch (OBJECT_TYPE(obj)) {
562	case LispFixnum_t:
563	    RTYPE(real) = N_FIXNUM;
564	    RFI(real) = OFI(obj);
565	    break;
566	case LispInteger_t:
567	    RTYPE(real) = N_FIXNUM;
568	    RFI(real) = OII(obj);
569	    break;
570	case LispBignum_t:
571	    RTYPE(real) = N_BIGNUM;
572	    RBI(real) = XALLOC(mpi);
573	    mpi_init(RBI(real));
574	    mpi_set(RBI(real), OBI(obj));
575	    break;
576	case LispDFloat_t:
577	    RTYPE(real) = N_FLONUM;
578	    RFF(real) = ODF(obj);
579	    break;
580	case LispRatio_t:
581	    RTYPE(real) = N_FIXRATIO;
582	    RFRN(real) = OFRN(obj);
583	    RFRD(real) = OFRD(obj);
584	    break;
585	case LispBigratio_t:
586	    RTYPE(real) = N_BIGRATIO;
587	    RBR(real) = XALLOC(mpr);
588	    mpr_init(RBR(real));
589	    mpr_set(RBR(real), OBR(obj));
590	    break;
591	default:
592	    fatal_object_error(obj, NOT_A_REAL_NUMBER);
593	    break;
594    }
595}
596
597static void
598set_number_object(n_number *num, LispObj *obj)
599{
600    switch (OBJECT_TYPE(obj)) {
601	case LispFixnum_t:
602	    num->complex = 0;
603	    NRTYPE(num) = N_FIXNUM;
604	    NRFI(num) = OFI(obj);
605	    break;
606	case LispInteger_t:
607	    num->complex = 0;
608	    NRTYPE(num) = N_FIXNUM;
609	    NRFI(num) = OII(obj);
610	    break;
611	case LispBignum_t:
612	    num->complex = 0;
613	    NRTYPE(num) = N_BIGNUM;
614	    NRBI(num) = XALLOC(mpi);
615	    mpi_init(NRBI(num));
616	    mpi_set(NRBI(num), OBI(obj));
617	    break;
618	case LispDFloat_t:
619	    num->complex = 0;
620	    NRTYPE(num) = N_FLONUM;
621	    NRFF(num) = ODF(obj);
622	    break;
623	case LispRatio_t:
624	    num->complex = 0;
625	    NRTYPE(num) = N_FIXRATIO;
626	    NRFRN(num) = OFRN(obj);
627	    NRFRD(num) = OFRD(obj);
628	    break;
629	case LispBigratio_t:
630	    num->complex = 0;
631	    NRTYPE(num) = N_BIGRATIO;
632	    NRBR(num) = XALLOC(mpr);
633	    mpr_init(NRBR(num));
634	    mpr_set(NRBR(num), OBR(obj));
635	    break;
636	case LispComplex_t:
637	    num->complex = 1;
638	    set_real_object(NREAL(num), OCXR(obj));
639	    set_real_object(NIMAG(num), OCXI(obj));
640	    break;
641	default:
642	    fatal_object_error(obj, NOT_A_NUMBER);
643	    break;
644    }
645}
646
647static void
648clear_real(n_real *real)
649{
650    if (RTYPE(real) == N_BIGNUM) {
651	mpi_clear(RBI(real));
652	XFREE(RBI(real));
653    }
654    else if (RTYPE(real) == N_BIGRATIO) {
655	mpr_clear(RBR(real));
656	XFREE(RBR(real));
657    }
658}
659
660static void
661clear_number(n_number *num)
662{
663    clear_real(NREAL(num));
664    if (num->complex)
665	clear_real(NIMAG(num));
666}
667
668static LispObj *
669make_real_object(n_real *real)
670{
671    LispObj *obj;
672
673    switch (RTYPE(real)) {
674	case N_FIXNUM:
675	    if (RFI(real) > MOST_POSITIVE_FIXNUM ||
676		RFI(real) < MOST_NEGATIVE_FIXNUM) {
677		obj = LispNew(NIL, NIL);
678		obj->type = LispInteger_t;
679		OII(obj) = RFI(real);
680	    }
681	    else
682		obj = FIXNUM(RFI(real));
683	    break;
684	case N_BIGNUM:
685	    obj = BIGNUM(RBI(real));
686	    break;
687	case N_FLONUM:
688	    obj = DFLOAT(RFF(real));
689	    break;
690	case N_FIXRATIO:
691	    obj = LispNew(NIL, NIL);
692	    obj->type = LispRatio_t;
693	    OFRN(obj) = RFRN(real);
694	    OFRD(obj) = RFRD(real);
695	    break;
696	case N_BIGRATIO:
697	    obj = BIGRATIO(RBR(real));
698	    break;
699	default:
700	    obj = NIL;
701	    break;
702    }
703
704    return (obj);
705}
706
707static LispObj *
708make_number_object(n_number *num)
709{
710    LispObj *obj;
711
712    if (num->complex) {
713	GC_ENTER();
714
715	obj = LispNew(NIL, NIL);
716	GC_PROTECT(obj);
717	OCXI(obj) = NIL;
718	obj->type = LispComplex_t;
719	OCXR(obj) = make_real_object(NREAL(num));
720	OCXI(obj) = make_real_object(NIMAG(num));
721	GC_LEAVE();
722    }
723    else {
724	switch (NRTYPE(num)) {
725	    case N_FIXNUM:
726		if (NRFI(num) > MOST_POSITIVE_FIXNUM ||
727		    NRFI(num) < MOST_NEGATIVE_FIXNUM) {
728		    obj = LispNew(NIL, NIL);
729		    obj->type = LispInteger_t;
730		    OII(obj) = NRFI(num);
731		}
732		else
733		    obj = FIXNUM(NRFI(num));
734		break;
735	    case N_BIGNUM:
736		obj = BIGNUM(NRBI(num));
737		break;
738	    case N_FLONUM:
739		obj = DFLOAT(NRFF(num));
740		break;
741	    case N_FIXRATIO:
742		obj = LispNew(NIL, NIL);
743		obj->type = LispRatio_t;
744		OFRN(obj) = NRFRN(num);
745		OFRD(obj) = NRFRD(num);
746		break;
747	    case N_BIGRATIO:
748		obj = BIGRATIO(NRBR(num));
749		break;
750	    default:
751		obj = NIL;
752		break;
753	}
754    }
755
756    return (obj);
757}
758
759#define DEFOP_REAL_REAL(OP)						\
760OP##_real_real(n_real *real, n_real *val)				\
761{									\
762    switch (RTYPE(real)) {						\
763	case N_FIXNUM:							\
764	    switch (RTYPE(val)) {					\
765		case N_FIXNUM:						\
766		    r##OP##_fi_fi(real, RFI(val));			\
767		    break;						\
768		case N_BIGNUM:						\
769		    r##OP##_fi_bi(real, RBI(val));			\
770		    break;						\
771		case N_FLONUM:						\
772		    r##OP##_flonum(real, (double)RFI(real), RFF(val));	\
773		    break;						\
774		case N_FIXRATIO:					\
775		    r##OP##_fi_fr(real, RFRN(val), RFRD(val));		\
776		    break;						\
777		case N_BIGRATIO:					\
778		    r##OP##_fi_br(real, RBR(val));			\
779		    break;						\
780	    }								\
781	    break;							\
782	case N_BIGNUM:							\
783	    switch (RTYPE(val)) {					\
784		case N_FIXNUM:						\
785		    r##OP##_bi_fi(real, RFI(val));			\
786		    break;						\
787		case N_BIGNUM:						\
788		    r##OP##_bi_bi(real, RBI(val));			\
789		    break;						\
790		case N_FLONUM:						\
791		    r##OP##_flonum(real, bi_getd(RBI(real)), RFF(val));	\
792		    break;						\
793		case N_FIXRATIO:					\
794		    r##OP##_bi_fr(real, RFRN(val), RFRD(val));		\
795		    break;						\
796		case N_BIGRATIO:					\
797		    r##OP##_bi_br(real, RBR(val));			\
798		    break;						\
799	    }								\
800	    break;							\
801	case N_FLONUM:							\
802	    switch (RTYPE(val)) {					\
803		case N_FIXNUM:						\
804		    r##OP##_flonum(real, RFF(real), (double)RFI(val));	\
805		    break;						\
806		case N_BIGNUM:						\
807		    r##OP##_flonum(real, RFF(real), bi_getd(RBI(val)));	\
808		    break;						\
809		case N_FLONUM:						\
810		    r##OP##_flonum(real, RFF(real), RFF(val));		\
811		    break;						\
812		case N_FIXRATIO:					\
813		    r##OP##_flonum(real, RFF(real),			\
814				 (double)RFRN(val) / (double)RFRD(val));\
815		    break;						\
816		case N_BIGRATIO:					\
817		    r##OP##_flonum(real, RFF(real), br_getd(RBR(val)));	\
818		    break;						\
819	    }								\
820	    break;							\
821	case N_FIXRATIO:						\
822	    switch (RTYPE(val)) {					\
823		case N_FIXNUM:						\
824		    r##OP##_fr_fi(real, RFI(val));			\
825		    break;						\
826		case N_BIGNUM:						\
827		    r##OP##_fr_bi(real, RBI(val));			\
828		    break;						\
829		case N_FLONUM:						\
830		    r##OP##_flonum(real,				\
831				(double)RFRN(real) / (double)RFRD(real),\
832				RFF(val));				\
833		    break;						\
834		case N_FIXRATIO:					\
835		    r##OP##_fr_fr(real, RFRN(val), RFRD(val));		\
836		    break;						\
837		case N_BIGRATIO:					\
838		    r##OP##_fr_br(real, RBR(val));			\
839		    break;						\
840	    }								\
841	    break;							\
842	case N_BIGRATIO:						\
843	    switch (RTYPE(val)) {					\
844		case N_FIXNUM:						\
845		    r##OP##_br_fi(real, RFI(val));			\
846		    break;						\
847		case N_BIGNUM:						\
848		    r##OP##_br_bi(real, RBI(val));			\
849		    break;						\
850		case N_FLONUM:						\
851		    r##OP##_flonum(real, br_getd(RBR(real)), RFF(val));	\
852		    break;						\
853		case N_FIXRATIO:					\
854		    r##OP##_br_fr(real, RFRN(val), RFRD(val));		\
855		    break;						\
856		case N_BIGRATIO:					\
857		    r##OP##_br_br(real, RBR(val));			\
858		    break;						\
859	    }								\
860	    break;							\
861    }									\
862}
863
864static void
865DEFOP_REAL_REAL(add)
866
867static void
868DEFOP_REAL_REAL(sub)
869
870static void
871DEFOP_REAL_REAL(div)
872
873static void
874DEFOP_REAL_REAL(mul)
875
876
877#define DEFOP_REAL_OBJECT(OP)						\
878OP##_real_object(n_real *real, LispObj *obj)				\
879{									\
880    switch (OBJECT_TYPE(obj)) {						\
881	case LispFixnum_t:						\
882	    switch (RTYPE(real)) {					\
883		case N_FIXNUM:						\
884		    r##OP##_fi_fi(real, OFI(obj));			\
885		    break;						\
886		case N_BIGNUM:						\
887		    r##OP##_bi_fi(real, OFI(obj));			\
888		    break;						\
889		case N_FLONUM:						\
890		    r##OP##_flonum(real, RFF(real), (double)OFI(obj));	\
891		    break;						\
892		case N_FIXRATIO:					\
893		    r##OP##_fr_fi(real, OFI(obj));			\
894		    break;						\
895		case N_BIGRATIO:					\
896		    r##OP##_br_fi(real, OFI(obj));			\
897		    break;						\
898	    }								\
899	    break;							\
900	case LispInteger_t:						\
901	    switch (RTYPE(real)) {					\
902		case N_FIXNUM:						\
903		    r##OP##_fi_fi(real, OII(obj));			\
904		    break;						\
905		case N_BIGNUM:						\
906		    r##OP##_bi_fi(real, OII(obj));			\
907		    break;						\
908		case N_FLONUM:						\
909		    r##OP##_flonum(real, RFF(real), (double)OII(obj));	\
910		    break;						\
911		case N_FIXRATIO:					\
912		    r##OP##_fr_fi(real, OII(obj));			\
913		    break;						\
914		case N_BIGRATIO:					\
915		    r##OP##_br_fi(real, OII(obj));			\
916		    break;						\
917	    }								\
918	    break;							\
919	case LispBignum_t:						\
920	    switch (RTYPE(real)) {					\
921		case N_FIXNUM:						\
922		    r##OP##_fi_bi(real, OBI(obj));			\
923		    break;						\
924		case N_BIGNUM:						\
925		    r##OP##_bi_bi(real, OBI(obj));			\
926		    break;						\
927		case N_FLONUM:						\
928		    r##OP##_flonum(real, RFF(real), bi_getd(OBI(obj)));	\
929		    break;						\
930		case N_FIXRATIO:					\
931		    r##OP##_fr_bi(real, OBI(obj));			\
932		    break;						\
933		case N_BIGRATIO:					\
934		    r##OP##_br_bi(real, OBI(obj));			\
935		    break;						\
936	    }								\
937	    break;							\
938	case LispDFloat_t:						\
939	    switch (RTYPE(real)) {					\
940		case N_FIXNUM:						\
941		    r##OP##_flonum(real, (double)RFI(real), ODF(obj));	\
942		    break;						\
943		case N_BIGNUM:						\
944		    r##OP##_flonum(real, bi_getd(RBI(real)), ODF(obj));	\
945		    break;						\
946		case N_FLONUM:						\
947		    r##OP##_flonum(real, RFF(real), ODF(obj));		\
948		    break;						\
949		case N_FIXRATIO:					\
950		    r##OP##_flonum(real,				\
951				(double)RFRN(real) / (double)RFRD(real),\
952				ODF(obj));				\
953		    break;						\
954		case N_BIGRATIO:					\
955		    r##OP##_flonum(real, br_getd(RBR(real)), ODF(obj));	\
956		    break;						\
957	    }								\
958	    break;							\
959	case LispRatio_t:						\
960	    switch (RTYPE(real)) {					\
961		case N_FIXNUM:						\
962		    r##OP##_fi_fr(real, OFRN(obj), OFRD(obj));		\
963		    break;						\
964		case N_BIGNUM:						\
965		    r##OP##_bi_fr(real, OFRN(obj), OFRD(obj));		\
966		    break;						\
967		case N_FLONUM:						\
968		    r##OP##_flonum(real, RFF(real),			\
969				(double)OFRN(obj) / (double)OFRD(obj));	\
970		    break;						\
971		case N_FIXRATIO:					\
972		    r##OP##_fr_fr(real, OFRN(obj), OFRD(obj));		\
973		    break;						\
974		case N_BIGRATIO:					\
975		    r##OP##_br_fr(real, OFRN(obj), OFRD(obj));		\
976		    break;						\
977	    }								\
978	    break;							\
979	case LispBigratio_t:						\
980	    switch (RTYPE(real)) {					\
981		case N_FIXNUM:						\
982		    r##OP##_fi_br(real, OBR(obj));			\
983		    break;						\
984		case N_BIGNUM:						\
985		    r##OP##_bi_br(real, OBR(obj));			\
986		    break;						\
987		case N_FLONUM:						\
988		    r##OP##_flonum(real, RFF(real), br_getd(OBR(obj)));	\
989		    break;						\
990		case N_FIXRATIO:					\
991		    r##OP##_fr_br(real, OBR(obj));			\
992		    break;						\
993		case N_BIGRATIO:					\
994		    r##OP##_br_br(real, OBR(obj));			\
995		    break;						\
996	    }								\
997	    break;							\
998	default:							\
999	    fatal_object_error(obj, NOT_A_REAL_NUMBER);			\
1000	    break;							\
1001    }									\
1002}
1003
1004static void
1005DEFOP_REAL_OBJECT(add)
1006
1007static void
1008DEFOP_REAL_OBJECT(sub)
1009
1010static void
1011DEFOP_REAL_OBJECT(div)
1012
1013static void
1014DEFOP_REAL_OBJECT(mul)
1015
1016
1017#define DEFOP_NUMBER_OBJECT(OP)						\
1018OP##_number_object(n_number *num, LispObj *obj)				\
1019{									\
1020    if (num->complex) {							\
1021	switch (OBJECT_TYPE(obj)) {					\
1022	    case LispFixnum_t:						\
1023	    case LispInteger_t:						\
1024	    case LispBignum_t:						\
1025	    case LispDFloat_t:						\
1026	    case LispRatio_t:						\
1027	    case LispBigratio_t:					\
1028		n##OP##_cx_re(num, obj);				\
1029		break;							\
1030	    case LispComplex_t:						\
1031		n##OP##_cx_cx(num, obj);				\
1032		break;							\
1033	    default:							\
1034		fatal_object_error(obj, NOT_A_NUMBER);			\
1035		break;							\
1036	}								\
1037    }									\
1038    else {								\
1039	switch (OBJECT_TYPE(obj)) {					\
1040	    case LispFixnum_t:						\
1041		switch (NRTYPE(num)) {					\
1042		    case N_FIXNUM:					\
1043			r##OP##_fi_fi(NREAL(num), OFI(obj));		\
1044			break;						\
1045		    case N_BIGNUM:					\
1046			r##OP##_bi_fi(NREAL(num), OFI(obj));		\
1047			break;						\
1048		    case N_FLONUM:					\
1049			r##OP##_flonum(NREAL(num), NRFF(num),		\
1050				    (double)OFI(obj));			\
1051			break;						\
1052		    case N_FIXRATIO:					\
1053			r##OP##_fr_fi(NREAL(num), OFI(obj));		\
1054			break;						\
1055		    case N_BIGRATIO:					\
1056			r##OP##_br_fi(NREAL(num), OFI(obj));		\
1057			break;						\
1058		}							\
1059		break;							\
1060	    case LispInteger_t:						\
1061		switch (NRTYPE(num)) {					\
1062		    case N_FIXNUM:					\
1063			r##OP##_fi_fi(NREAL(num), OII(obj));		\
1064			break;						\
1065		    case N_BIGNUM:					\
1066			r##OP##_bi_fi(NREAL(num), OII(obj));		\
1067			break;						\
1068		    case N_FLONUM:					\
1069			r##OP##_flonum(NREAL(num), NRFF(num),		\
1070				    (double)OII(obj));			\
1071			break;						\
1072		    case N_FIXRATIO:					\
1073			r##OP##_fr_fi(NREAL(num), OII(obj));		\
1074			break;						\
1075		    case N_BIGRATIO:					\
1076			r##OP##_br_fi(NREAL(num), OII(obj));		\
1077			break;						\
1078		}							\
1079		break;							\
1080	    case LispBignum_t:						\
1081		switch (NRTYPE(num)) {					\
1082		    case N_FIXNUM:					\
1083			r##OP##_fi_bi(NREAL(num), OBI(obj));		\
1084			break;						\
1085		    case N_BIGNUM:					\
1086			r##OP##_bi_bi(NREAL(num), OBI(obj));		\
1087			break;						\
1088		    case N_FLONUM:					\
1089			r##OP##_flonum(NREAL(num), NRFF(num),		\
1090				       bi_getd(OBI(obj)));		\
1091			break;						\
1092		    case N_FIXRATIO:					\
1093			r##OP##_fr_bi(NREAL(num), OBI(obj));		\
1094			break;						\
1095		    case N_BIGRATIO:					\
1096			r##OP##_br_bi(NREAL(num), OBI(obj));		\
1097			break;						\
1098		}							\
1099		break;							\
1100	    case LispDFloat_t:						\
1101		switch (NRTYPE(num)) {					\
1102		    case N_FIXNUM:					\
1103			r##OP##_flonum(NREAL(num), (double)NRFI(num),	\
1104				    ODF(obj));				\
1105			break;						\
1106		    case N_BIGNUM:					\
1107			r##OP##_flonum(NREAL(num), bi_getd(NRBI(num)),	\
1108				    ODF(obj));				\
1109			break;						\
1110		    case N_FLONUM:					\
1111			r##OP##_flonum(NREAL(num), NRFF(num), ODF(obj));\
1112			break;						\
1113		    case N_FIXRATIO:					\
1114			r##OP##_flonum(NREAL(num),			\
1115				    (double)NRFRN(num) /		\
1116				    (double)NRFRD(num),			\
1117				    ODF(obj));				\
1118			break;						\
1119		    case N_BIGRATIO:					\
1120			r##OP##_flonum(NREAL(num), br_getd(NRBR(num)),	\
1121				    ODF(obj));				\
1122			break;						\
1123		}							\
1124		break;							\
1125	    case LispRatio_t:						\
1126		switch (NRTYPE(num)) {					\
1127		    case N_FIXNUM:					\
1128			r##OP##_fi_fr(NREAL(num), OFRN(obj), OFRD(obj));\
1129			break;						\
1130		    case N_BIGNUM:					\
1131			r##OP##_bi_fr(NREAL(num), OFRN(obj), OFRD(obj));\
1132			break;						\
1133		    case N_FLONUM:					\
1134			r##OP##_flonum(NREAL(num), NRFF(num),		\
1135				    (double)OFRN(obj) /			\
1136				    (double)OFRD(obj));			\
1137			break;						\
1138		    case N_FIXRATIO:					\
1139			r##OP##_fr_fr(NREAL(num), OFRN(obj), OFRD(obj));\
1140			break;						\
1141		    case N_BIGRATIO:					\
1142			r##OP##_br_fr(NREAL(num), OFRN(obj), OFRD(obj));\
1143			break;						\
1144		}							\
1145		break;							\
1146	    case LispBigratio_t:					\
1147		switch (NRTYPE(num)) {					\
1148		    case N_FIXNUM:					\
1149			r##OP##_fi_br(NREAL(num), OBR(obj));		\
1150			break;						\
1151		    case N_BIGNUM:					\
1152			r##OP##_bi_br(NREAL(num), OBR(obj));		\
1153			break;						\
1154		    case N_FLONUM:					\
1155			r##OP##_flonum(NREAL(num), NRFF(num),		\
1156				    br_getd(OBR(obj)));		\
1157			break;						\
1158		    case N_FIXRATIO:					\
1159			r##OP##_fr_br(NREAL(num), OBR(obj));		\
1160			break;						\
1161		    case N_BIGRATIO:					\
1162			r##OP##_br_br(NREAL(num), OBR(obj));		\
1163			break;						\
1164		}							\
1165		break;							\
1166	    case LispComplex_t:						\
1167		n##OP##_re_cx(num, obj);				\
1168		break;							\
1169	    default:							\
1170		fatal_object_error(obj, NOT_A_NUMBER);			\
1171		break;							\
1172	}								\
1173    }									\
1174}
1175
1176static void
1177DEFOP_NUMBER_OBJECT(add)
1178
1179static void
1180DEFOP_NUMBER_OBJECT(sub)
1181
1182static void
1183DEFOP_NUMBER_OBJECT(div)
1184
1185static void
1186DEFOP_NUMBER_OBJECT(mul)
1187
1188
1189/************************************************************************
1190 * ABS
1191 ************************************************************************/
1192static void
1193abs_real(n_real *real)
1194{
1195    switch (RTYPE(real)) {
1196	case N_FIXNUM:		rabs_fi(real);	break;
1197	case N_BIGNUM:		rabs_bi(real);	break;
1198	case N_FLONUM:		rabs_ff(real);	break;
1199	case N_FIXRATIO:	rabs_fr(real);	break;
1200	case N_BIGRATIO:	rabs_br(real);	break;
1201    }
1202}
1203
1204static void
1205abs_number(n_number *num)
1206{
1207    if (num->complex)
1208	nabs_cx(num);
1209    else {
1210	switch (NRTYPE(num)) {
1211	    case N_FIXNUM:	rabs_fi(NREAL(num));	break;
1212	    case N_BIGNUM:	rabs_bi(NREAL(num));	break;
1213	    case N_FLONUM:	rabs_ff(NREAL(num));	break;
1214	    case N_FIXRATIO:	rabs_fr(NREAL(num));	break;
1215	    case N_BIGRATIO:	rabs_br(NREAL(num));	break;
1216	}
1217    }
1218}
1219
1220static void
1221nabs_cx(n_number *num)
1222{
1223    n_real temp;
1224
1225    abs_real(NREAL(num));
1226    abs_real(NIMAG(num));
1227
1228    if (cmp_real_real(NREAL(num), NIMAG(num)) < 0) {
1229	memcpy(&temp, NIMAG(num), sizeof(n_real));
1230	memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
1231	memcpy(NREAL(num), &temp, sizeof(n_real));
1232    }
1233
1234    if (cmp_real_real(NIMAG(num), &zero) == 0) {
1235	num->complex = 0;
1236	if (NITYPE(num) == N_FLONUM) {
1237	    /* change number type */
1238	    temp.type = N_FLONUM;
1239	    temp.data.flonum = 1.0;
1240	    mul_real_real(NREAL(num), &temp);
1241	}
1242	else
1243	    clear_real(NIMAG(num));
1244    }
1245    else {
1246	div_real_real(NIMAG(num), NREAL(num));
1247	set_real_real(&temp, NIMAG(num));
1248	mul_real_real(NIMAG(num), &temp);
1249	clear_real(&temp);
1250
1251	add_real_real(NIMAG(num), &one);
1252	sqrt_real(NIMAG(num));
1253
1254	mul_real_real(NIMAG(num), NREAL(num));
1255	clear_real(NREAL(num));
1256	memcpy(NREAL(num), NIMAG(num), sizeof(n_real));
1257	num->complex = 0;
1258    }
1259}
1260
1261static INLINE void
1262rabs_fi(n_real *real)
1263{
1264    if (RFI(real) < 0)
1265	rneg_fi(real);
1266}
1267
1268static INLINE void
1269rabs_bi(n_real *real)
1270{
1271    if (mpi_cmpi(RBI(real), 0) < 0)
1272	mpi_neg(RBI(real), RBI(real));
1273}
1274
1275static INLINE void
1276rabs_ff(n_real *real)
1277{
1278    if (RFF(real) < 0.0)
1279	RFF(real) = -RFF(real);
1280}
1281
1282static INLINE void
1283rabs_fr(n_real *real)
1284{
1285    if (RFRN(real) < 0)
1286	rneg_fr(real);
1287}
1288
1289static INLINE void
1290rabs_br(n_real *real)
1291{
1292    if (mpi_cmpi(RBRN(real), 0) < 0)
1293	mpi_neg(RBRN(real), RBRN(real));
1294}
1295
1296
1297/************************************************************************
1298 * NEG
1299 ************************************************************************/
1300static void
1301neg_real(n_real *real)
1302{
1303    switch (RTYPE(real)) {
1304	case N_FIXNUM:		rneg_fi(real);	break;
1305	case N_BIGNUM:		rneg_bi(real);	break;
1306	case N_FLONUM:		rneg_ff(real);	break;
1307	case N_FIXRATIO:	rneg_fr(real);	break;
1308	case N_BIGRATIO:	rneg_br(real);	break;
1309    }
1310}
1311
1312static void
1313neg_number(n_number *num)
1314{
1315    if (num->complex) {
1316	neg_real(NREAL(num));
1317	neg_real(NIMAG(num));
1318    }
1319    else {
1320	switch (NRTYPE(num)) {
1321	    case N_FIXNUM:	rneg_fi(NREAL(num));	break;
1322	    case N_BIGNUM:	rneg_bi(NREAL(num));	break;
1323	    case N_FLONUM:	rneg_ff(NREAL(num));	break;
1324	    case N_FIXRATIO:	rneg_fr(NREAL(num));	break;
1325	    case N_BIGRATIO:	rneg_br(NREAL(num));	break;
1326	}
1327    }
1328}
1329
1330static void
1331rneg_fi(n_real *real)
1332{
1333    if (RFI(real) == MINSLONG) {
1334	mpi *bigi = XALLOC(mpi);
1335
1336	mpi_init(bigi);
1337	mpi_seti(bigi, RFI(real));
1338	mpi_neg(bigi, bigi);
1339	RTYPE(real) = N_BIGNUM;
1340	RBI(real) = bigi;
1341    }
1342    else
1343	RFI(real) = -RFI(real);
1344}
1345
1346static INLINE void
1347rneg_bi(n_real *real)
1348{
1349    mpi_neg(RBI(real), RBI(real));
1350}
1351
1352static INLINE void
1353rneg_ff(n_real *real)
1354{
1355    RFF(real) = -RFF(real);
1356}
1357
1358static void
1359rneg_fr(n_real *real)
1360{
1361    if (RFRN(real) == MINSLONG) {
1362	mpr *bigr = XALLOC(mpr);
1363
1364	mpr_init(bigr);
1365	mpr_seti(bigr, RFRN(real), RFRD(real));
1366	mpi_neg(mpr_num(bigr), mpr_num(bigr));
1367	RTYPE(real) = N_BIGRATIO;
1368	RBR(real) = bigr;
1369    }
1370    else
1371	RFRN(real) = -RFRN(real);
1372}
1373
1374static INLINE void
1375rneg_br(n_real *real)
1376{
1377    mpi_neg(RBRN(real), RBRN(real));
1378}
1379
1380
1381/************************************************************************
1382 * SQRT
1383 ************************************************************************/
1384static void
1385sqrt_real(n_real *real)
1386{
1387    switch (RTYPE(real)) {
1388	case N_FIXNUM:
1389	case N_BIGNUM:
1390	    rsqrt_xi(real);
1391	    break;
1392	case N_FLONUM:
1393	    rsqrt_ff(real);
1394	    break;
1395	case N_FIXRATIO:
1396	case N_BIGRATIO:
1397	    rsqrt_xr(real);
1398	    break;
1399    }
1400}
1401
1402static void
1403sqrt_number(n_number *num)
1404{
1405    if (num->complex)
1406	nsqrt_cx(num);
1407    else {
1408	switch (NRTYPE(num)) {
1409	    case N_FIXNUM:
1410	    case N_BIGNUM:
1411		nsqrt_xi(num);
1412		break;
1413	    case N_FLONUM:
1414		nsqrt_ff(num);
1415		break;
1416	    case N_FIXRATIO:
1417	    case N_BIGRATIO:
1418		nsqrt_xr(num);
1419		break;
1420	}
1421    }
1422}
1423
1424static void
1425rsqrt_xi(n_real *real)
1426{
1427    int exact;
1428    mpi bignum;
1429
1430    if (cmp_real_real(real, &zero) < 0)
1431	fatal_error(FLOATING_POINT_EXCEPTION);
1432
1433    mpi_init(&bignum);
1434    if (RTYPE(real) == N_BIGNUM)
1435	exact = mpi_sqrt(&bignum, RBI(real));
1436    else {
1437	mpi tmp;
1438
1439	mpi_init(&tmp);
1440	mpi_seti(&tmp, RFI(real));
1441	exact = mpi_sqrt(&bignum, &tmp);
1442	mpi_clear(&tmp);
1443    }
1444    if (exact) {
1445	if (RTYPE(real) == N_BIGNUM) {
1446	    mpi_set(RBI(real), &bignum);
1447	    rbi_canonicalize(real);
1448	}
1449	else
1450	    RFI(real) = mpi_geti(&bignum);
1451    }
1452    else {
1453	double value;
1454
1455	if (RTYPE(real) == N_BIGNUM) {
1456	    value = bi_getd(RBI(real));
1457	    RCLEAR_BI(real);
1458	}
1459	else
1460	    value = (double)RFI(real);
1461
1462	value = sqrt(value);
1463	RTYPE(real) = N_FLONUM;
1464	RFF(real) = value;
1465    }
1466    mpi_clear(&bignum);
1467}
1468
1469static void
1470rsqrt_xr(n_real *real)
1471{
1472    n_real num, den;
1473
1474    if (cmp_real_real(real, &zero) < 0)
1475	fatal_error(FLOATING_POINT_EXCEPTION);
1476
1477    if (RTYPE(real) == N_FIXRATIO) {
1478	num.type = den.type = N_FIXNUM;
1479	num.data.fixnum = RFRN(real);
1480	den.data.fixnum = RFRD(real);
1481    }
1482    else {
1483	mpi *bignum;
1484
1485	if (mpi_fiti(RBRN(real))) {
1486	    num.type = N_FIXNUM;
1487	    num.data.fixnum = mpi_geti(RBRN(real));
1488	}
1489	else {
1490	    bignum = XALLOC(mpi);
1491	    mpi_init(bignum);
1492	    mpi_set(bignum, RBRN(real));
1493	    num.type = N_BIGNUM;
1494	    num.data.bignum = bignum;
1495	}
1496
1497	if (mpi_fiti(RBRD(real))) {
1498	    den.type = N_FIXNUM;
1499	    den.data.fixnum = mpi_geti(RBRD(real));
1500	}
1501	else {
1502	    bignum = XALLOC(mpi);
1503	    mpi_init(bignum);
1504	    mpi_set(bignum, RBRD(real));
1505	    den.type = N_BIGNUM;
1506	    den.data.bignum = bignum;
1507	}
1508    }
1509
1510    rsqrt_xi(&num);
1511    rsqrt_xi(&den);
1512
1513    clear_real(real);
1514    memcpy(real, &num, sizeof(n_real));
1515    div_real_real(real, &den);
1516    clear_real(&den);
1517}
1518
1519static void
1520rsqrt_ff(n_real *real)
1521{
1522    if (RFF(real) < 0.0)
1523	fatal_error(FLOATING_POINT_EXCEPTION);
1524    RFF(real) = sqrt(RFF(real));
1525}
1526
1527
1528static void
1529nsqrt_cx(n_number *num)
1530{
1531    n_number mag;
1532    n_real *real, *imag;
1533
1534    real = &(mag.real);
1535    imag = &(mag.imag);
1536    set_real_real(real, NREAL(num));
1537    set_real_real(imag, NIMAG(num));
1538    mag.complex = 1;
1539
1540    nabs_cx(&mag);	/* this will free the imag part data */
1541    if (cmp_real_real(real, &zero) == 0) {
1542	clear_number(num);
1543	memcpy(NREAL(num), real, sizeof(n_real));
1544	clear_real(real);
1545	num->complex = 0;
1546	return;
1547    }
1548    else if (cmp_real_real(NREAL(num), &zero) > 0) {
1549	/* R = sqrt((mag + Ra) / 2) */
1550	add_real_real(NREAL(num), real);
1551	clear_real(real);
1552	div_real_real(NREAL(num), &two);
1553	sqrt_real(NREAL(num));
1554
1555	/* I = Ia / R / 2 */
1556	div_real_real(NIMAG(num), NREAL(num));
1557	div_real_real(NIMAG(num), &two);
1558    }
1559    else {
1560	/* remember old imag part */
1561	memcpy(imag, NIMAG(num), sizeof(n_real));
1562
1563	/* I = sqrt((mag - Ra) / 2) */
1564	memcpy(NIMAG(num), real, sizeof(n_real));
1565	sub_real_real(NIMAG(num), NREAL(num));
1566	div_real_real(NIMAG(num), &two);
1567	sqrt_real(NIMAG(num));
1568	if (cmp_real_real(imag, &zero) < 0)
1569	    neg_real(NIMAG(num));
1570
1571	/* R = Ia / I / 2 */
1572	clear_real(NREAL(num));
1573	/* start with old imag part */
1574	memcpy(NREAL(num), imag, sizeof(n_real));
1575	div_real_real(NREAL(num), NIMAG(num));
1576	div_real_real(NREAL(num), &two);
1577    }
1578
1579    ncx_canonicalize(num);
1580}
1581
1582static void
1583nsqrt_xi(n_number *num)
1584{
1585    if (cmp_real_real(NREAL(num), &zero) < 0) {
1586	memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
1587	neg_real(NIMAG(num));
1588	rsqrt_xi(NIMAG(num));
1589	NRTYPE(num) = N_FIXNUM;
1590	NRFI(num) = 0;
1591	num->complex = 1;
1592    }
1593    else
1594	rsqrt_xi(NREAL(num));
1595}
1596
1597static void
1598nsqrt_ff(n_number *num)
1599{
1600    double value;
1601
1602    if (NRFF(num) < 0.0) {
1603	value = sqrt(-NRFF(num));
1604
1605	NITYPE(num) = N_FLONUM;
1606	NIFF(num) = value;
1607	NRTYPE(num) = N_FIXNUM;
1608	NRFI(num) = 0;
1609	num->complex = 1;
1610    }
1611    else {
1612	value = sqrt(NRFF(num));
1613	NRFF(num) = value;
1614    }
1615}
1616
1617static void
1618nsqrt_xr(n_number *num)
1619{
1620    if (cmp_real_real(NREAL(num), &zero) < 0) {
1621	memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
1622	neg_real(NIMAG(num));
1623	rsqrt_xr(NIMAG(num));
1624	NRTYPE(num) = N_FIXNUM;
1625	NRFI(num) = 0;
1626	num->complex = 1;
1627    }
1628    else
1629	rsqrt_xr(NREAL(num));
1630}
1631
1632
1633/************************************************************************
1634 * MOD
1635 ************************************************************************/
1636static void
1637mod_real_real(n_real *real, n_real *val)
1638{
1639    /* Assume both operands are integers */
1640    switch (RTYPE(real)) {
1641	case N_FIXNUM:
1642	    switch (RTYPE(val)) {
1643		case N_FIXNUM:
1644		    rmod_fi_fi(real, RFI(val));
1645		    break;
1646		case N_BIGNUM:
1647		    rmod_fi_bi(real, RBI(val));
1648		    break;
1649	    }
1650	    break;
1651	case N_BIGNUM:
1652	    switch (RTYPE(val)) {
1653		case N_FIXNUM:
1654		    rmod_bi_fi(real, RFI(val));
1655		    break;
1656		case N_BIGNUM:
1657		    rmod_bi_bi(real, RBI(val));
1658		    break;
1659	    }
1660	    break;
1661    }
1662}
1663
1664static void
1665mod_real_object(n_real *real, LispObj *obj)
1666{
1667    switch (RTYPE(real)) {
1668	case N_FIXNUM:
1669	    switch (OBJECT_TYPE(obj)) {
1670		case LispFixnum_t:
1671		    rmod_fi_fi(real, OFI(obj));
1672		    return;
1673		case LispInteger_t:
1674		    rmod_fi_fi(real, OII(obj));
1675		    return;
1676		case LispBignum_t:
1677		    rmod_fi_bi(real, OBI(obj));
1678		    return;
1679		default:
1680		    break;
1681	    }
1682	    break;
1683	case N_BIGNUM:
1684	    switch (OBJECT_TYPE(obj)) {
1685		case LispFixnum_t:
1686		    rmod_bi_fi(real, OFI(obj));
1687		    return;
1688		case LispInteger_t:
1689		    rmod_bi_fi(real, OII(obj));
1690		    return;
1691		case LispBignum_t:
1692		    rmod_bi_bi(real, OBI(obj));
1693		    return;
1694		default:
1695		    break;
1696	    }
1697	    break;
1698	/* Assume the n_real object is an integer */
1699    }
1700    fatal_object_error(obj, NOT_AN_INTEGER);
1701}
1702
1703static void
1704rmod_fi_fi(n_real *real, long fi)
1705{
1706    if (fi == 0)
1707	fatal_error(DIVIDE_BY_ZERO);
1708
1709    if ((RFI(real) < 0) ^ (fi < 0))
1710	RFI(real) = (RFI(real) % fi) + fi;
1711    else if (RFI(real) == MINSLONG || fi == MINSLONG) {
1712	mpi bignum;
1713
1714	mpi_init(&bignum);
1715	mpi_seti(&bignum, RFI(real));
1716	RFI(real) = mpi_modi(&bignum, fi);
1717	mpi_clear(&bignum);
1718    }
1719    else
1720	RFI(real) = RFI(real) % fi;
1721}
1722
1723static void
1724rmod_fi_bi(n_real *real, mpi *bignum)
1725{
1726    mpi *bigi;
1727
1728    if (mpi_cmpi(bignum, 0) == 0)
1729	fatal_error(DIVIDE_BY_ZERO);
1730
1731    bigi = XALLOC(mpi);
1732    mpi_init(bigi);
1733    mpi_seti(bigi, RFI(real));
1734    mpi_mod(bigi, bigi, bignum);
1735    RTYPE(real) = N_BIGNUM;
1736    RBI(real) = bigi;
1737    rbi_canonicalize(real);
1738}
1739
1740static void
1741rmod_bi_fi(n_real *real, long fi)
1742{
1743    mpi iop;
1744
1745    if (fi == 0)
1746	fatal_error(DIVIDE_BY_ZERO);
1747
1748    mpi_init(&iop);
1749    mpi_seti(&iop, fi);
1750    mpi_mod(RBI(real), RBI(real), &iop);
1751    mpi_clear(&iop);
1752    rbi_canonicalize(real);
1753}
1754
1755static void
1756rmod_bi_bi(n_real *real, mpi *bignum)
1757{
1758    if (mpi_cmpi(bignum, 0) == 0)
1759	fatal_error(DIVIDE_BY_ZERO);
1760
1761    mpi_mod(RBI(real), RBI(real), bignum);
1762    rbi_canonicalize(real);
1763}
1764
1765/************************************************************************
1766 * REM
1767 ************************************************************************/
1768static void
1769rem_real_object(n_real *real, LispObj *obj)
1770{
1771    switch (RTYPE(real)) {
1772	case N_FIXNUM:
1773	    switch (OBJECT_TYPE(obj)) {
1774		case LispFixnum_t:
1775		    rrem_fi_fi(real, OFI(obj));
1776		    return;
1777		case LispInteger_t:
1778		    rrem_fi_fi(real, OII(obj));
1779		    return;
1780		case LispBignum_t:
1781		    rrem_fi_bi(real, OBI(obj));
1782		    return;
1783		default:
1784		    break;
1785	    }
1786	    break;
1787	case N_BIGNUM:
1788	    switch (OBJECT_TYPE(obj)) {
1789		case LispFixnum_t:
1790		    rrem_bi_fi(real, OFI(obj));
1791		    return;
1792		case LispInteger_t:
1793		    rrem_bi_fi(real, OII(obj));
1794		    return;
1795		case LispBignum_t:
1796		    rrem_bi_bi(real, OBI(obj));
1797		    return;
1798		default:
1799		    break;
1800	    }
1801	    break;
1802	/* Assume the n_real object is an integer */
1803    }
1804    fatal_object_error(obj, NOT_AN_INTEGER);
1805}
1806
1807static void
1808rrem_fi_fi(n_real *real, long fi)
1809{
1810    if (fi == 0)
1811	fatal_error(DIVIDE_BY_ZERO);
1812
1813    if (RFI(real) == MINSLONG || fi == MINSLONG) {
1814	mpi bignum;
1815
1816	mpi_init(&bignum);
1817	mpi_seti(&bignum, RFI(real));
1818	RFI(real) = mpi_remi(&bignum, fi);
1819	mpi_clear(&bignum);
1820    }
1821    else
1822	RFI(real) = RFI(real) % fi;
1823}
1824
1825static void
1826rrem_fi_bi(n_real *real, mpi *bignum)
1827{
1828    mpi *bigi;
1829
1830    if (mpi_cmpi(bignum, 0) == 0)
1831	fatal_error(DIVIDE_BY_ZERO);
1832
1833    bigi = XALLOC(mpi);
1834    mpi_init(bigi);
1835    mpi_seti(bigi, RFI(real));
1836    mpi_rem(bigi, bigi, bignum);
1837    RTYPE(real) = N_BIGNUM;
1838    RBI(real) = bigi;
1839    rbi_canonicalize(real);
1840}
1841
1842static void
1843rrem_bi_fi(n_real *real, long fi)
1844{
1845    mpi iop;
1846
1847    if (fi == 0)
1848	fatal_error(DIVIDE_BY_ZERO);
1849
1850    mpi_init(&iop);
1851    mpi_seti(&iop, fi);
1852    mpi_rem(RBI(real), RBI(real), &iop);
1853    mpi_clear(&iop);
1854    rbi_canonicalize(real);
1855}
1856
1857static void
1858rrem_bi_bi(n_real *real, mpi *bignum)
1859{
1860    if (mpi_cmpi(bignum, 0) == 0)
1861	fatal_error(DIVIDE_BY_ZERO);
1862
1863    mpi_rem(RBI(real), RBI(real), bignum);
1864    rbi_canonicalize(real);
1865}
1866
1867
1868/************************************************************************
1869 * GCD
1870 ************************************************************************/
1871static void
1872gcd_real_object(n_real *real, LispObj *obj)
1873{
1874    if (!INTEGERP(obj))
1875	fatal_object_error(obj, NOT_AN_INTEGER);
1876
1877    /* check for zero operand */
1878    if (cmp_real_real(real, &zero) == 0)
1879	set_real_object(real, obj);
1880    else if (cmp_real_object(&zero, obj) != 0) {
1881	n_real rest, temp;
1882
1883	set_real_object(&rest, obj);
1884	for (;;) {
1885	    mod_real_real(&rest, real);
1886	    if (cmp_real_real(&rest, &zero) == 0)
1887		break;
1888	    memcpy(&temp, real, sizeof(n_real));
1889	    memcpy(real, &rest, sizeof(n_real));
1890	    memcpy(&rest, &temp, sizeof(n_real));
1891	}
1892	clear_real(&rest);
1893    }
1894}
1895
1896/************************************************************************
1897 * AND
1898 ************************************************************************/
1899static void
1900and_real_object(n_real *real, LispObj *obj)
1901{
1902    mpi *bigi, iop;
1903
1904    switch (OBJECT_TYPE(obj)) {
1905	case LispFixnum_t:
1906	    switch (RTYPE(real)) {
1907		case N_FIXNUM:
1908		    RFI(real) &= OFI(obj);
1909		    break;
1910		case N_BIGNUM:
1911		    mpi_init(&iop);
1912		    mpi_seti(&iop, OFI(obj));
1913		    mpi_and(RBI(real), RBI(real), &iop);
1914		    mpi_clear(&iop);
1915		    rbi_canonicalize(real);
1916		    break;
1917	    }
1918	    break;
1919	case LispInteger_t:
1920	    switch (RTYPE(real)) {
1921		case N_FIXNUM:
1922		    RFI(real) &= OII(obj);
1923		    break;
1924		case N_BIGNUM:
1925		    mpi_init(&iop);
1926		    mpi_seti(&iop, OII(obj));
1927		    mpi_and(RBI(real), RBI(real), &iop);
1928		    mpi_clear(&iop);
1929		    rbi_canonicalize(real);
1930		    break;
1931	    }
1932	    break;
1933	case LispBignum_t:
1934	    switch (RTYPE(real)) {
1935		case N_FIXNUM:
1936		    bigi = XALLOC(mpi);
1937		    mpi_init(bigi);
1938		    mpi_seti(bigi, RFI(real));
1939		    mpi_and(bigi, bigi, OBI(obj));
1940		    RTYPE(real) = N_BIGNUM;
1941		    RBI(real) = bigi;
1942		    rbi_canonicalize(real);
1943		    break;
1944		case N_BIGNUM:
1945		    mpi_and(RBI(real), RBI(real), OBI(obj));
1946		    rbi_canonicalize(real);
1947		    break;
1948	    }
1949	    break;
1950	default:
1951	    fatal_object_error(obj, NOT_AN_INTEGER);
1952	    break;
1953    }
1954}
1955
1956
1957/************************************************************************
1958 * EQV
1959 ************************************************************************/
1960static void
1961eqv_real_object(n_real *real, LispObj *obj)
1962{
1963    mpi *bigi, iop;
1964
1965    switch (OBJECT_TYPE(obj)) {
1966	case LispFixnum_t:
1967	    switch (RTYPE(real)) {
1968		case N_FIXNUM:
1969		    RFI(real) ^= ~OFI(obj);
1970		    break;
1971		case N_BIGNUM:
1972		    mpi_init(&iop);
1973		    mpi_seti(&iop, OFI(obj));
1974		    mpi_com(&iop, &iop);
1975		    mpi_xor(RBI(real), RBI(real), &iop);
1976		    mpi_clear(&iop);
1977		    rbi_canonicalize(real);
1978		    break;
1979	    }
1980	    break;
1981	case LispInteger_t:
1982	    switch (RTYPE(real)) {
1983		case N_FIXNUM:
1984		    RFI(real) ^= ~OII(obj);
1985		    break;
1986		case N_BIGNUM:
1987		    mpi_init(&iop);
1988		    mpi_seti(&iop, OII(obj));
1989		    mpi_com(&iop, &iop);
1990		    mpi_xor(RBI(real), RBI(real), &iop);
1991		    mpi_clear(&iop);
1992		    rbi_canonicalize(real);
1993		    break;
1994	    }
1995	    break;
1996	case LispBignum_t:
1997	    switch (RTYPE(real)) {
1998		case N_FIXNUM:
1999		    bigi = XALLOC(mpi);
2000		    mpi_init(bigi);
2001		    mpi_seti(bigi, RFI(real));
2002		    mpi_com(bigi, bigi);
2003		    mpi_xor(bigi, bigi, OBI(obj));
2004		    RTYPE(real) = N_BIGNUM;
2005		    RBI(real) = bigi;
2006		    rbi_canonicalize(real);
2007		    break;
2008		case N_BIGNUM:
2009		    mpi_com(RBI(real), RBI(real));
2010		    mpi_xor(RBI(real), RBI(real), OBI(obj));
2011		    rbi_canonicalize(real);
2012		    break;
2013	    }
2014	    break;
2015	default:
2016	    fatal_object_error(obj, NOT_AN_INTEGER);
2017	    break;
2018    }
2019}
2020
2021
2022/************************************************************************
2023 * IOR
2024 ************************************************************************/
2025static void
2026ior_real_object(n_real *real, LispObj *obj)
2027{
2028    mpi *bigi, iop;
2029
2030    switch (OBJECT_TYPE(obj)) {
2031	case LispFixnum_t:
2032	    switch (RTYPE(real)) {
2033		case N_FIXNUM:
2034		    RFI(real) |= OFI(obj);
2035		    break;
2036		case N_BIGNUM:
2037		    mpi_init(&iop);
2038		    mpi_seti(&iop, OFI(obj));
2039		    mpi_ior(RBI(real), RBI(real), &iop);
2040		    mpi_clear(&iop);
2041		    rbi_canonicalize(real);
2042		    break;
2043	    }
2044	    break;
2045	case LispInteger_t:
2046	    switch (RTYPE(real)) {
2047		case N_FIXNUM:
2048		    RFI(real) |= OII(obj);
2049		    break;
2050		case N_BIGNUM:
2051		    mpi_init(&iop);
2052		    mpi_seti(&iop, OII(obj));
2053		    mpi_ior(RBI(real), RBI(real), &iop);
2054		    mpi_clear(&iop);
2055		    rbi_canonicalize(real);
2056		    break;
2057	    }
2058	    break;
2059	case LispBignum_t:
2060	    switch (RTYPE(real)) {
2061		case N_FIXNUM:
2062		    bigi = XALLOC(mpi);
2063		    mpi_init(bigi);
2064		    mpi_seti(bigi, RFI(real));
2065		    mpi_ior(bigi, bigi, OBI(obj));
2066		    RTYPE(real) = N_BIGNUM;
2067		    RBI(real) = bigi;
2068		    rbi_canonicalize(real);
2069		    break;
2070		case N_BIGNUM:
2071		    mpi_ior(RBI(real), RBI(real), OBI(obj));
2072		    rbi_canonicalize(real);
2073		    break;
2074	    }
2075	    break;
2076	default:
2077	    fatal_object_error(obj, NOT_AN_INTEGER);
2078	    break;
2079    }
2080}
2081
2082
2083/************************************************************************
2084 * NOT
2085 ************************************************************************/
2086static void
2087not_real(n_real *real)
2088{
2089    if (RTYPE(real) == N_FIXNUM)
2090	RFI(real) = ~RFI(real);
2091    else {
2092	mpi_com(RBI(real), RBI(real));
2093	rbi_canonicalize(real);
2094    }
2095}
2096
2097/************************************************************************
2098 * XOR
2099 ************************************************************************/
2100static void
2101xor_real_object(n_real *real, LispObj *obj)
2102{
2103    mpi *bigi, iop;
2104
2105    switch (OBJECT_TYPE(obj)) {
2106	case LispFixnum_t:
2107	    switch (RTYPE(real)) {
2108		case N_FIXNUM:
2109		    RFI(real) ^= OFI(obj);
2110		    break;
2111		case N_BIGNUM:
2112		    mpi_init(&iop);
2113		    mpi_seti(&iop, OFI(obj));
2114		    mpi_xor(RBI(real), RBI(real), &iop);
2115		    mpi_clear(&iop);
2116		    rbi_canonicalize(real);
2117		    break;
2118	    }
2119	    break;
2120	case LispInteger_t:
2121	    switch (RTYPE(real)) {
2122		case N_FIXNUM:
2123		    RFI(real) ^= OII(obj);
2124		    break;
2125		case N_BIGNUM:
2126		    mpi_init(&iop);
2127		    mpi_seti(&iop, OII(obj));
2128		    mpi_xor(RBI(real), RBI(real), &iop);
2129		    mpi_clear(&iop);
2130		    rbi_canonicalize(real);
2131		    break;
2132	    }
2133	    break;
2134	case LispBignum_t:
2135	    switch (RTYPE(real)) {
2136		case N_FIXNUM:
2137		    bigi = XALLOC(mpi);
2138		    mpi_init(bigi);
2139		    mpi_seti(bigi, RFI(real));
2140		    mpi_xor(bigi, bigi, OBI(obj));
2141		    RTYPE(real) = N_BIGNUM;
2142		    RBI(real) = bigi;
2143		    rbi_canonicalize(real);
2144		    break;
2145		case N_BIGNUM:
2146		    mpi_xor(RBI(real), RBI(real), OBI(obj));
2147		    rbi_canonicalize(real);
2148		    break;
2149	    }
2150	    break;
2151	default:
2152	    fatal_object_error(obj, NOT_AN_INTEGER);
2153	    break;
2154    }
2155}
2156
2157
2158/************************************************************************
2159 * DIVIDE
2160 ************************************************************************/
2161static void
2162divide_number_object(n_number *num, LispObj *obj, int fun, int flo)
2163{
2164    switch (OBJECT_TYPE(obj)) {
2165	case LispFixnum_t:
2166	    switch (NRTYPE(num)) {
2167		case N_FIXNUM:
2168		    ndivide_fi_fi(num, OFI(obj), fun, flo);
2169		    break;
2170		case N_BIGNUM:
2171		    ndivide_xi_xi(num, obj, fun, flo);
2172		    break;
2173		case N_FLONUM:
2174		    ndivide_flonum(num, NRFF(num), (double)OFI(obj), fun, flo);
2175		    break;
2176		case N_FIXRATIO:
2177		case N_BIGRATIO:
2178		    ndivide_xr_xi(num, obj, fun, flo);
2179		    break;
2180	    }
2181	    break;
2182	case LispInteger_t:
2183	    switch (NRTYPE(num)) {
2184		case N_FIXNUM:
2185		    ndivide_fi_fi(num, OII(obj), fun, flo);
2186		    break;
2187		case N_BIGNUM:
2188		    ndivide_xi_xi(num, obj, fun, flo);
2189		    break;
2190		case N_FLONUM:
2191		    ndivide_flonum(num, NRFF(num), (double)OII(obj), fun, flo);
2192		    break;
2193		case N_FIXRATIO:
2194		case N_BIGRATIO:
2195		    ndivide_xr_xi(num, obj, fun, flo);
2196		    break;
2197	    }
2198	    break;
2199	case LispBignum_t:
2200	    switch (NRTYPE(num)) {
2201		case N_FIXNUM:
2202		case N_BIGNUM:
2203		    ndivide_xi_xi(num, obj, fun, flo);
2204		    break;
2205		case N_FLONUM:
2206		    ndivide_flonum(num, NRFF(num), bi_getd(OBI(obj)),
2207				   fun, flo);
2208		    break;
2209		case N_FIXRATIO:
2210		case N_BIGRATIO:
2211		    ndivide_xr_xi(num, obj, fun, flo);
2212		    break;
2213	    }
2214	    break;
2215	case LispDFloat_t:
2216	    switch (NRTYPE(num)) {
2217		case N_FIXNUM:
2218		    ndivide_flonum(num, (double)NRFI(num), ODF(obj),
2219				   fun, flo);
2220		    break;
2221		case N_BIGNUM:
2222		    ndivide_flonum(num, bi_getd(NRBI(num)), ODF(obj),
2223				   fun, flo);
2224		    break;
2225		case N_FLONUM:
2226		    ndivide_flonum(num, NRFF(num), ODF(obj), fun, flo);
2227		    break;
2228		case N_FIXRATIO:
2229		    ndivide_flonum(num,
2230				   (double)NRFRN(num) / (double)NRFRD(num),
2231				   ODF(obj), fun, flo);
2232		    break;
2233		case N_BIGRATIO:
2234		    ndivide_flonum(num, br_getd(NRBR(num)), ODF(obj),
2235				   fun, flo);
2236		    break;
2237	    }
2238	    break;
2239	case LispRatio_t:
2240	    switch (NRTYPE(num)) {
2241		case N_FIXNUM:
2242		case N_BIGNUM:
2243		    ndivide_xi_xr(num, obj, fun, flo);
2244		    break;
2245		case N_FLONUM:
2246		    ndivide_flonum(num, NRFF(num),
2247				   (double)OFRN(obj) / (double)OFRD(obj),
2248				   fun, flo);
2249		    break;
2250		case N_FIXRATIO:
2251		case N_BIGRATIO:
2252		    ndivide_xr_xr(num, obj, fun, flo);
2253		    break;
2254	    }
2255	    break;
2256	case LispBigratio_t:
2257	    switch (NRTYPE(num)) {
2258		case N_FIXNUM:
2259		case N_BIGNUM:
2260		    ndivide_xi_xr(num, obj, fun, flo);
2261		    break;
2262		case N_FLONUM:
2263		    ndivide_flonum(num, NRFF(num), br_getd(OBR(obj)),
2264				   fun, flo);
2265		    break;
2266		case N_FIXRATIO:
2267		case N_BIGRATIO:
2268		    ndivide_xr_xr(num, obj, fun, flo);
2269		    break;
2270	    }
2271	    break;
2272	default:
2273	    fatal_object_error(obj, NOT_A_REAL_NUMBER);
2274	    break;
2275    }
2276}
2277
2278
2279/************************************************************************
2280 * COMPARE
2281 ************************************************************************/
2282static int
2283cmp_real_real(n_real *op1, n_real *op2)
2284{
2285    switch (RTYPE(op1)) {
2286	case N_FIXNUM:
2287	    switch (RTYPE(op2)) {
2288		case N_FIXNUM:
2289		    return (cmp_fi_fi(RFI(op1), RFI(op2)));
2290		case N_BIGNUM:
2291		    return (cmp_fi_bi(RFI(op1), RBI(op2)));
2292		case N_FLONUM:
2293		    return (cmp_flonum((double)RFI(op1), RFF(op2)));
2294		case N_FIXRATIO:
2295		    return (cmp_fi_fr(RFI(op1), RFRN(op2), RFRD(op2)));
2296		case N_BIGRATIO:
2297		    return (cmp_fi_br(RFI(op1), RBR(op2)));
2298	    }
2299	    break;
2300	case N_BIGNUM:
2301	    switch (RTYPE(op2)) {
2302		case N_FIXNUM:
2303		    return (cmp_bi_fi(RBI(op1), RFI(op2)));
2304		case N_BIGNUM:
2305		    return (cmp_bi_bi(RBI(op1), RBI(op2)));
2306		case N_FLONUM:
2307		    return (cmp_flonum(bi_getd(RBI(op1)), RFF(op2)));
2308		case N_FIXRATIO:
2309		    return (cmp_bi_fr(RBI(op1), RFRN(op2), RFRD(op2)));
2310		case N_BIGRATIO:
2311		    return (cmp_bi_br(RBI(op1), RBR(op2)));
2312	    }
2313	    break;
2314	case N_FLONUM:
2315	    switch (RTYPE(op2)) {
2316		case N_FIXNUM:
2317		    return (cmp_flonum(RFF(op1), (double)RFI(op2)));
2318		case N_BIGNUM:
2319		    return (cmp_flonum(RFF(op1), bi_getd(RBI(op2))));
2320		case N_FLONUM:
2321		    return (cmp_flonum(RFF(op1), RFF(op2)));
2322		case N_FIXRATIO:
2323		    return (cmp_flonum(RFF(op1),
2324				       (double)RFRN(op2) / (double)RFRD(op2)));
2325		case N_BIGRATIO:
2326		    return (cmp_flonum(RFF(op1), br_getd(RBR(op2))));
2327	    }
2328	    break;
2329	case N_FIXRATIO:
2330	    switch (RTYPE(op2)) {
2331		case N_FIXNUM:
2332		    return (cmp_fr_fi(RFRN(op1), RFRD(op1), RFI(op2)));
2333		case N_BIGNUM:
2334		    return (cmp_fr_bi(RFRN(op1), RFRD(op1), RBI(op2)));
2335		case N_FLONUM:
2336		    return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1),
2337				       RFF(op2)));
2338		case N_FIXRATIO:
2339		    return (cmp_fr_fr(RFRN(op1), RFRD(op1),
2340				      RFRN(op2), RFRD(op2)));
2341		case N_BIGRATIO:
2342		    return (cmp_fr_br(RFRN(op1), RFRD(op1), RBR(op2)));
2343	    }
2344	    break;
2345	case N_BIGRATIO:
2346	    switch (RTYPE(op2)) {
2347		case N_FIXNUM:
2348		    return (cmp_br_fi(RBR(op1), RFI(op2)));
2349		case N_BIGNUM:
2350		    return (cmp_br_bi(RBR(op1), RBI(op2)));
2351		case N_FLONUM:
2352		    return (cmp_flonum(br_getd(RBR(op1)), RFF(op2)));
2353		case N_FIXRATIO:
2354		    return (cmp_br_fr(RBR(op1), RFRN(op2), RFRD(op2)));
2355		case N_BIGRATIO:
2356		    return (cmp_br_br(RBR(op1), RBR(op2)));
2357	    }
2358    }
2359
2360    return (0);
2361}
2362
2363static int
2364cmp_real_object(n_real *op1, LispObj *op2)
2365{
2366    switch (OBJECT_TYPE(op2)) {
2367	case LispFixnum_t:
2368	    switch (RTYPE(op1)) {
2369		case N_FIXNUM:
2370		    return (cmp_fi_fi(RFI(op1), OFI(op2)));
2371		case N_BIGNUM:
2372		    return (cmp_bi_fi(RBI(op1), OFI(op2)));
2373		case N_FLONUM:
2374		    return (cmp_flonum(RFF(op1), (double)OFI(op2)));
2375		case N_FIXRATIO:
2376		    return (cmp_fr_fi(RFRD(op1), RFRN(op1), OFI(op2)));
2377		case N_BIGRATIO:
2378		    return (cmp_br_fi(RBR(op1), OFI(op2)));
2379	    }
2380	    break;
2381	case LispInteger_t:
2382	    switch (RTYPE(op1)) {
2383		case N_FIXNUM:
2384		    return (cmp_fi_fi(RFI(op1), OII(op2)));
2385		case N_BIGNUM:
2386		    return (cmp_bi_fi(RBI(op1), OII(op2)));
2387		case N_FLONUM:
2388		    return (cmp_flonum(RFF(op1), (double)OII(op2)));
2389		case N_FIXRATIO:
2390		    return (cmp_fr_fi(RFRD(op1), RFRN(op1), OII(op2)));
2391		case N_BIGRATIO:
2392		    return (cmp_br_fi(RBR(op1), OII(op2)));
2393	    }
2394	    break;
2395	case LispBignum_t:
2396	    switch (RTYPE(op1)) {
2397		case N_FIXNUM:
2398		    return (cmp_fi_bi(RFI(op1), OBI(op2)));
2399		case N_BIGNUM:
2400		    return (cmp_bi_bi(RBI(op1), OBI(op2)));
2401		case N_FLONUM:
2402		    return (cmp_flonum(RFF(op1), bi_getd(OBI(op2))));
2403		case N_FIXRATIO:
2404		    return (cmp_fr_bi(RFRD(op1), RFRN(op1), OBI(op2)));
2405		case N_BIGRATIO:
2406		    return (cmp_br_bi(RBR(op1), OBI(op2)));
2407	    }
2408	    break;
2409	case LispDFloat_t:
2410	    switch (RTYPE(op1)) {
2411		case N_FIXNUM:
2412		    return (cmp_flonum((double)RFI(op1), ODF(op2)));
2413		case N_BIGNUM:
2414		    return (cmp_flonum(bi_getd(RBI(op1)), ODF(op2)));
2415		case N_FLONUM:
2416		    return (cmp_flonum(RFF(op1), ODF(op2)));
2417		case N_FIXRATIO:
2418		    return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1),
2419				       ODF(op2)));
2420		case N_BIGRATIO:
2421		    return (cmp_flonum(br_getd(RBR(op1)), ODF(op2)));
2422	    }
2423	    break;
2424	case LispRatio_t:
2425	    switch (RTYPE(op1)) {
2426		case N_FIXNUM:
2427		    return (cmp_fi_fr(RFI(op1), OFRN(op2), OFRD(op2)));
2428		case N_BIGNUM:
2429		    return (cmp_bi_fr(RBI(op1), OFRN(op2), OFRD(op2)));
2430		case N_FLONUM:
2431		    return (cmp_flonum(RFF(op1),
2432				       (double)OFRN(op2) / (double)OFRD(op2)));
2433		case N_FIXRATIO:
2434		    return (cmp_fr_fr(RFRN(op1), RFRD(op1),
2435				      OFRN(op2), OFRD(op2)));
2436		case N_BIGRATIO:
2437		    return (cmp_br_fr(RBR(op1), OFRN(op2), OFRD(op2)));
2438	    }
2439	    break;
2440	case LispBigratio_t:
2441	    switch (RTYPE(op1)) {
2442		case N_FIXNUM:
2443		    return (cmp_fi_br(RFI(op1), OBR(op2)));
2444		case N_BIGNUM:
2445		    return (cmp_bi_br(RBI(op1), OBR(op2)));
2446		case N_FLONUM:
2447		    return (cmp_flonum(RFF(op1), br_getd(OBR(op2))));
2448		case N_FIXRATIO:
2449		    return (cmp_fr_br(RFRN(op1), RFRD(op1), OBR(op2)));
2450		case N_BIGRATIO:
2451		    return (cmp_br_br(RBR(op1), OBR(op2)));
2452	    }
2453	    break;
2454	default:
2455	    fatal_object_error(op2, NOT_A_REAL_NUMBER);
2456	    break;
2457    }
2458
2459    return (0);
2460}
2461
2462#if 0		/* not used */
2463static int
2464cmp_number_object(n_number *op1, LispObj *op2)
2465{
2466    if (op1->complex) {
2467	if (OBJECT_TYPE(op2) == LispComplex_t) {
2468	    if (cmp_real_object(NREAL(op1), OCXR(op2)) == 0)
2469		return (cmp_real_object(NIMAG(op1), OCXI(op2)));
2470	    return (1);
2471	}
2472	else if (cmp_real_real(NIMAG(op1), &zero) == 0)
2473	    return (cmp_real_object(NREAL(op1), op2));
2474	else
2475	    return (1);
2476    }
2477    else {
2478	switch (OBJECT_TYPE(op2)) {
2479	    case LispFixnum_t:
2480		switch (NRTYPE(op1)) {
2481		    case N_FIXNUM:
2482			return (cmp_fi_fi(NRFI(op1), OFI(op2)));
2483		    case N_BIGNUM:
2484			return (cmp_bi_fi(NRBI(op1), OFI(op2)));
2485		    case N_FLONUM:
2486			return (cmp_flonum(NRFF(op1), (double)OFI(op2)));
2487		    case N_FIXRATIO:
2488			return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OFI(op2)));
2489		    case N_BIGRATIO:
2490			return (cmp_br_fi(NRBR(op1), OFI(op2)));
2491		}
2492		break;
2493	    case LispInteger_t:
2494		switch (NRTYPE(op1)) {
2495		    case N_FIXNUM:
2496			return (cmp_fi_fi(NRFI(op1), OII(op2)));
2497		    case N_BIGNUM:
2498			return (cmp_bi_fi(NRBI(op1), OII(op2)));
2499		    case N_FLONUM:
2500			return (cmp_flonum(NRFF(op1), (double)OII(op2)));
2501		    case N_FIXRATIO:
2502			return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OII(op2)));
2503		    case N_BIGRATIO:
2504			return (cmp_br_fi(NRBR(op1), OII(op2)));
2505		}
2506		break;
2507	    case LispBignum_t:
2508		switch (NRTYPE(op1)) {
2509		    case N_FIXNUM:
2510			return (cmp_fi_bi(NRFI(op1), OBI(op2)));
2511		    case N_BIGNUM:
2512			return (cmp_bi_bi(NRBI(op1), OBI(op2)));
2513		    case N_FLONUM:
2514			return (cmp_flonum(NRFF(op1), bi_getd(OBI(op2))));
2515		    case N_FIXRATIO:
2516			return (cmp_fr_bi(NRFRD(op1), NRFRN(op1), OBI(op2)));
2517		    case N_BIGRATIO:
2518			return (cmp_br_bi(NRBR(op1), OBI(op2)));
2519		}
2520		break;
2521	    case LispDFloat_t:
2522		switch (NRTYPE(op1)) {
2523		    case N_FIXNUM:
2524			return (cmp_flonum((double)NRFI(op1), ODF(op2)));
2525		    case N_BIGNUM:
2526			return (cmp_flonum(bi_getd(NRBI(op1)), ODF(op2)));
2527		    case N_FLONUM:
2528			return (cmp_flonum(NRFF(op1), ODF(op2)));
2529		    case N_FIXRATIO:
2530			return (cmp_flonum((double)NRFRN(op1) /
2531					   (double)NRFRD(op1),
2532					   ODF(op2)));
2533		    case N_BIGRATIO:
2534			return (cmp_flonum(br_getd(NRBR(op1)), ODF(op2)));
2535		}
2536		break;
2537	    case LispRatio_t:
2538		switch (NRTYPE(op1)) {
2539		    case N_FIXNUM:
2540			return (cmp_fi_fr(NRFI(op1), OFRN(op2), OFRD(op2)));
2541		    case N_BIGNUM:
2542			return (cmp_bi_fr(NRBI(op1), OFRN(op2), OFRD(op2)));
2543		    case N_FLONUM:
2544			return (cmp_flonum(NRFF(op1),
2545					   (double)OFRN(op2) / (double)OFRD(op2)));
2546		    case N_FIXRATIO:
2547			return (cmp_fr_fr(NRFRN(op1), NRFRD(op1),
2548					  OFRN(op2), OFRD(op2)));
2549		    case N_BIGRATIO:
2550			return (cmp_br_fr(NRBR(op1), OFRN(op2), OFRD(op2)));
2551		}
2552		break;
2553	    case LispBigratio_t:
2554		switch (NRTYPE(op1)) {
2555		    case N_FIXNUM:
2556			return (cmp_fi_br(NRFI(op1), OBR(op2)));
2557		    case N_BIGNUM:
2558			return (cmp_bi_br(NRBI(op1), OBR(op2)));
2559		    case N_FLONUM:
2560			return (cmp_flonum(NRFF(op1), br_getd(OBR(op2))));
2561		    case N_FIXRATIO:
2562			return (cmp_fr_br(NRFRN(op1), NRFRD(op1), OBR(op2)));
2563		    case N_BIGRATIO:
2564			return (cmp_br_br(NRBR(op1), OBR(op2)));
2565		}
2566		break;
2567	    case LispComplex_t:
2568		if (cmp_real_object(&zero, OCXI(op2)) == 0)
2569		    return (cmp_real_object(NREAL(op1), OCXR(op2)));
2570		return (1);
2571	    default:
2572		fatal_object_error(op2, NOT_A_NUMBER);
2573		break;
2574	}
2575    }
2576
2577    return (0);
2578}
2579#endif
2580
2581static int
2582cmp_object_object(LispObj *op1, LispObj *op2, int real)
2583{
2584    if (OBJECT_TYPE(op1) == LispComplex_t) {
2585	if (real)
2586	    fatal_object_error(op1, NOT_A_REAL_NUMBER);
2587	if (OBJECT_TYPE(op2) == LispComplex_t)
2588	    return (cmp_cx_cx(op1, op2));
2589	else if (cmp_real_object(&zero, OCXI(op1)) == 0)
2590	    return (cmp_object_object(OCXR(op1), op2, real));
2591	return (1);
2592    }
2593    else if (OBJECT_TYPE(op2) == LispComplex_t) {
2594	if (real)
2595	    fatal_object_error(op1, NOT_A_REAL_NUMBER);
2596	if (cmp_real_object(&zero, OCXI(op2)) == 0)
2597	    return (cmp_object_object(op1, OCXR(op2), real));
2598	return (1);
2599    }
2600    else {
2601	switch (OBJECT_TYPE(op1)) {
2602	    case LispFixnum_t:
2603		switch (OBJECT_TYPE(op2)) {
2604		    case LispFixnum_t:
2605			return (cmp_fi_fi(OFI(op1), OFI(op2)));
2606		    case LispInteger_t:
2607			return (cmp_fi_fi(OFI(op1), OII(op2)));
2608		    case LispBignum_t:
2609			return (cmp_fi_bi(OFI(op1), OBI(op2)));
2610		    case LispDFloat_t:
2611			return (cmp_flonum((double)OFI(op1), ODF(op2)));
2612		    case LispRatio_t:
2613			return (cmp_fi_fr(OFI(op1),
2614					  OFRN(op2), OFRD(op2)));
2615		    case LispBigratio_t:
2616			return (cmp_fi_br(OFI(op1), OBR(op2)));
2617		    default:
2618			break;
2619		}
2620		break;
2621	    case LispInteger_t:
2622		switch (OBJECT_TYPE(op2)) {
2623		    case LispFixnum_t:
2624			return (cmp_fi_fi(OII(op1), OFI(op2)));
2625		    case LispInteger_t:
2626			return (cmp_fi_fi(OII(op1), OII(op2)));
2627		    case LispBignum_t:
2628			return (cmp_fi_bi(OII(op1), OBI(op2)));
2629		    case LispDFloat_t:
2630			return (cmp_flonum((double)OII(op1), ODF(op2)));
2631		    case LispRatio_t:
2632			return (cmp_fi_fr(OII(op1),
2633					  OFRN(op2), OFRD(op2)));
2634		    case LispBigratio_t:
2635			return (cmp_fi_br(OII(op1), OBR(op2)));
2636		    default:
2637			break;
2638		}
2639		break;
2640	    case LispBignum_t:
2641		switch (OBJECT_TYPE(op2)) {
2642		    case LispFixnum_t:
2643			return (cmp_bi_fi(OBI(op1), OFI(op2)));
2644		    case LispInteger_t:
2645			return (cmp_bi_fi(OBI(op1), OII(op2)));
2646		    case LispBignum_t:
2647			return (cmp_bi_bi(OBI(op1), OBI(op2)));
2648		    case LispDFloat_t:
2649			return (cmp_flonum(bi_getd(OBI(op1)), ODF(op2)));
2650		    case LispRatio_t:
2651			return (cmp_bi_fr(OBI(op1),
2652					  OFRN(op2), OFRD(op2)));
2653		    case LispBigratio_t:
2654			return (cmp_bi_br(OBI(op1), OBR(op2)));
2655		    default:
2656			break;
2657		}
2658		break;
2659	    case LispDFloat_t:
2660		switch (OBJECT_TYPE(op2)) {
2661		    case LispFixnum_t:
2662			return (cmp_flonum(ODF(op1), (double)OFI(op2)));
2663		    case LispInteger_t:
2664			return (cmp_flonum(ODF(op1), (double)OII(op2)));
2665		    case LispBignum_t:
2666			return (cmp_flonum(ODF(op1), bi_getd(OBI(op2))));
2667		    case LispDFloat_t:
2668			return (cmp_flonum(ODF(op1), ODF(op2)));
2669			break;
2670		    case LispRatio_t:
2671			return (cmp_flonum(ODF(op1),
2672					   (double)OFRN(op2) /
2673					   (double)OFRD(op2)));
2674		    case LispBigratio_t:
2675			return (cmp_flonum(ODF(op1), br_getd(OBR(op2))));
2676		    default:
2677			break;
2678		}
2679		break;
2680	    case LispRatio_t:
2681		switch (OBJECT_TYPE(op2)) {
2682		    case LispFixnum_t:
2683			return (cmp_fr_fi(OFRN(op1), OFRD(op1), OFI(op2)));
2684		    case LispInteger_t:
2685			return (cmp_fr_fi(OFRN(op1), OFRD(op1), OII(op2)));
2686		    case LispBignum_t:
2687			return (cmp_fr_bi(OFRN(op1), OFRD(op1), OBI(op2)));
2688		    case LispDFloat_t:
2689			return (cmp_flonum((double)OFRN(op1) /
2690					   (double)OFRD(op1),
2691					   ODF(op2)));
2692		    case LispRatio_t:
2693			return (cmp_fr_fr(OFRN(op1), OFRD(op1),
2694					  OFRN(op2), OFRD(op2)));
2695		    case LispBigratio_t:
2696			return (cmp_fr_br(OFRN(op1), OFRD(op1), OBR(op2)));
2697		    default:
2698			break;
2699		}
2700		break;
2701	    case LispBigratio_t:
2702		switch (OBJECT_TYPE(op2)) {
2703		    case LispFixnum_t:
2704			return (cmp_br_fi(OBR(op1), OFI(op2)));
2705		    case LispInteger_t:
2706			return (cmp_br_fi(OBR(op1), OII(op2)));
2707		    case LispBignum_t:
2708			return (cmp_br_bi(OBR(op1), OBI(op2)));
2709		    case LispDFloat_t:
2710			return (cmp_flonum(br_getd(OBR(op1)), ODF(op2)));
2711		    case LispRatio_t:
2712			return (cmp_br_fr(OBR(op1), OFRN(op2), OFRD(op2)));
2713		    case LispBigratio_t:
2714			return (cmp_br_br(OBR(op1), OBR(op2)));
2715		    default:
2716			break;
2717		}
2718		break;
2719	    default:
2720		fatal_object_error(op1, NOT_A_NUMBER);
2721		break;
2722	}
2723    }
2724
2725    fatal_object_error(op2, NOT_A_NUMBER);
2726    return (0);
2727}
2728
2729
2730/************************************************************************
2731 * FIXNUM
2732 ************************************************************************/
2733/*
2734 * check if op1 + op2 will overflow
2735 */
2736static INLINE int
2737fi_fi_add_overflow(long op1, long op2)
2738{
2739    long op = op1 + op2;
2740
2741    return (op1 > 0 ? op2 > op : op2 < op);
2742}
2743
2744/*
2745 * check if op1 - op2 will overflow
2746 */
2747static INLINE int
2748fi_fi_sub_overflow(long op1, long op2)
2749{
2750    long op = op1 - op2;
2751
2752    return (((op1 < 0) ^ (op2 < 0)) && ((op < 0) ^ (op1 < 0)));
2753}
2754
2755/*
2756 * check if op1 * op2 will overflow
2757 */
2758static INLINE int
2759fi_fi_mul_overflow(long op1, long op2)
2760{
2761#ifndef LONG64
2762    double op = (double)op1 * (double)op2;
2763
2764    return (op > 2147483647.0 || op < -2147483648.0);
2765#else
2766    int shift;
2767    long mask;
2768
2769    if (op1 == 0 || op1 == 1 || op2 == 0 || op2 == 1)
2770	return (0);
2771
2772    if (op1 == MINSLONG || op2 == MINSLONG)
2773	return (1);
2774
2775    if (op1 < 0)
2776	op1 = -op1;
2777    if (op2 < 0)
2778	op2 = -op2;
2779
2780    for (shift = 0, mask = FI_MASK; shift < LONGSBITS; shift++, mask >>= 1)
2781	if (op1 & mask)
2782	    break;
2783    ++shift;
2784    for (mask = FI_MASK; shift < LONGSBITS; shift++, mask >>= 1)
2785	if (op2 & mask)
2786	    break;
2787
2788    return (shift < LONGSBITS);
2789#endif
2790}
2791
2792
2793/************************************************************************
2794 * BIGNUM
2795 ************************************************************************/
2796static void
2797rbi_canonicalize(n_real *real)
2798{
2799    if (mpi_fiti(RBI(real))) {
2800	long fi = mpi_geti(RBI(real));
2801
2802	RTYPE(real) = N_FIXNUM;
2803	mpi_clear(RBI(real));
2804	XFREE(RBI(real));
2805	RFI(real) = fi;
2806    }
2807}
2808
2809
2810/************************************************************************
2811 * RATIO
2812 ************************************************************************/
2813static void
2814rfr_canonicalize(n_real *real)
2815{
2816    long num, numerator, den, denominator, rest;
2817
2818    num = numerator = RFRN(real);
2819    den = denominator = RFRD(real);
2820    if (denominator == 0)
2821	fatal_error(DIVIDE_BY_ZERO);
2822
2823    if (num == MINSLONG || den == MINSLONG) {
2824	mpr *bigratio = XALLOC(mpr);
2825
2826	mpr_init(bigratio);
2827	mpr_seti(bigratio, num, den);
2828	RTYPE(real) = N_BIGRATIO;
2829	RBR(real) = bigratio;
2830	rbr_canonicalize(real);
2831	return;
2832    }
2833
2834    if (num < 0)
2835	num = -num;
2836    else if (num == 0) {
2837	RFI(real) = 0;
2838	RTYPE(real) = N_FIXNUM;
2839	return;
2840    }
2841    for (;;) {
2842	if ((rest = den % num) == 0)
2843	    break;
2844	den = num;
2845	num = rest;
2846    }
2847    if (den != 1) {
2848	denominator /= num;
2849	numerator /= num;
2850    }
2851    if (denominator < 0) {
2852	numerator = -numerator;
2853	denominator = -denominator;
2854    }
2855    if (denominator == 1) {
2856	RTYPE(real) = N_FIXNUM;
2857	RFI(real) = numerator;
2858    }
2859    else {
2860	RFRN(real) = numerator;
2861	RFRD(real) = denominator;
2862    }
2863}
2864
2865static void
2866rbr_canonicalize(n_real *real)
2867{
2868    int fitnum, fitden;
2869    long numerator, denominator;
2870
2871    mpr_canonicalize(RBR(real));
2872    fitnum = mpi_fiti(RBRN(real));
2873    fitden = mpi_fiti(RBRD(real));
2874    if (fitnum && fitden) {
2875	numerator = mpi_geti(RBRN(real));
2876	denominator = mpi_geti(RBRD(real));
2877	mpr_clear(RBR(real));
2878	XFREE(RBR(real));
2879	if (numerator == 0) {
2880	    RFI(real) = 0;
2881	    RTYPE(real) = N_FIXNUM;
2882	}
2883	else if (denominator == 1) {
2884	    RTYPE(real) = N_FIXNUM;
2885	    RFI(real) = numerator;
2886	}
2887	else {
2888	    RTYPE(real) = N_FIXRATIO;
2889	    RFRN(real) = numerator;
2890	    RFRD(real) = denominator;
2891	}
2892    }
2893    else if (fitden) {
2894	denominator = mpi_geti(RBRD(real));
2895	if (denominator == 1) {
2896	    mpi *bigi = XALLOC(mpi);
2897
2898	    mpi_init(bigi);
2899	    mpi_set(bigi, RBRN(real));
2900	    mpr_clear(RBR(real));
2901	    XFREE(RBR(real));
2902	    RTYPE(real) = N_BIGNUM;
2903	    RBI(real) = bigi;
2904	}
2905	else if (denominator == 0)
2906	    fatal_error(DIVIDE_BY_ZERO);
2907    }
2908}
2909
2910
2911/************************************************************************
2912 * COMPLEX
2913 ************************************************************************/
2914static void
2915ncx_canonicalize(n_number *num)
2916{
2917    if (NITYPE(num) == N_FIXNUM && NIFI(num) == 0)
2918	num->complex = 0;
2919}
2920
2921
2922/************************************************************************
2923 * DIVIDE
2924 ************************************************************************/
2925#define NDIVIDE_NOP	0
2926#define NDIVIDE_ADD	1
2927#define NDIVIDE_SUB	2
2928static void
2929ndivide_fi_fi(n_number *num, long div, int fun, int flo)
2930{
2931    long quo, rem;
2932
2933    if (NRFI(num) == MINSLONG || div == MINSLONG) {
2934	LispObj integer;
2935	mpi *bignum = XALLOC(mpi);
2936
2937	mpi_init(bignum);
2938	mpi_seti(bignum, NRFI(num));
2939	NRBI(num) = bignum;
2940	NRTYPE(num) = N_BIGNUM;
2941	integer.type = LispInteger_t;
2942	integer.data.integer = div;
2943	ndivide_xi_xi(num, &integer, fun, flo);
2944	return;
2945    }
2946    else {
2947	quo = NRFI(num) / div;
2948	rem = NRFI(num) % div;
2949    }
2950
2951    switch (fun) {
2952	case NDIVIDE_CEIL:
2953	    if ((rem < 0 && div < 0) || (rem > 0 && div > 0)) {
2954		++quo;
2955		rem -= div;
2956	    }
2957	    break;
2958	case NDIVIDE_FLOOR:
2959	    if ((rem < 0 && div > 0) || (rem > 0 && div < 0)) {
2960		--quo;
2961		rem += div;
2962	    }
2963	    break;
2964	case NDIVIDE_ROUND:
2965	    if (div > 0) {
2966		if (rem > 0) {
2967		    if (rem >= (div + 1) / 2) {
2968			++quo;
2969			rem -= div;
2970		    }
2971		}
2972		else {
2973		    if (rem <= (-div - 1) / 2) {
2974			--quo;
2975			rem += div;
2976		    }
2977		}
2978	    }
2979	    else {
2980		if (rem > 0) {
2981		    if (rem >= (-div + 1) / 2) {
2982			--quo;
2983			rem += div;
2984		    }
2985		}
2986		else {
2987		    if (rem <= (div - 1) / 2) {
2988			++quo;
2989			rem -= div;
2990		    }
2991		}
2992	    }
2993	    break;
2994    }
2995
2996    NITYPE(num) = N_FIXNUM;
2997    NIFI(num) = rem;
2998    if (flo) {
2999	NRTYPE(num) = N_FLONUM;
3000	NRFF(num) = (double)quo;
3001    }
3002    else
3003	NRFI(num) = quo;
3004}
3005
3006static void
3007ndivide_xi_xi(n_number *num, LispObj *div, int fun, int flo)
3008{
3009    LispType type = OBJECT_TYPE(div);
3010    int state = NDIVIDE_NOP, dsign, rsign;
3011    mpi *quo, *rem;
3012
3013    quo = XALLOC(mpi);
3014    mpi_init(quo);
3015    if (NRTYPE(num) == N_FIXNUM)
3016	mpi_seti(quo, NRFI(num));
3017    else
3018	mpi_set(quo, NRBI(num));
3019
3020    rem = XALLOC(mpi);
3021    mpi_init(rem);
3022
3023    switch (type) {
3024	case LispFixnum_t:
3025	    mpi_seti(rem, OFI(div));
3026	    break;
3027	case LispInteger_t:
3028	    mpi_seti(rem, OII(div));
3029	    break;
3030	default:
3031	    mpi_set(rem, OBI(div));
3032    }
3033
3034    dsign = mpi_sgn(rem);
3035
3036    mpi_divqr(quo, rem, quo, rem);
3037    rsign = mpi_sgn(rem);
3038
3039    switch (fun) {
3040	case NDIVIDE_CEIL:
3041	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
3042		state = NDIVIDE_ADD;
3043	    break;
3044	case NDIVIDE_FLOOR:
3045	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
3046		state = NDIVIDE_SUB;
3047	    break;
3048	case NDIVIDE_ROUND: {
3049	    mpi test;
3050
3051	    mpi_init(&test);
3052	    switch (type) {
3053		case LispFixnum_t:
3054		    mpi_seti(&test, OFI(div));
3055		    break;
3056		case LispInteger_t:
3057		    mpi_seti(&test, OII(div));
3058		    break;
3059		default:
3060		    mpi_set(&test, OBI(div));
3061	    }
3062	    if (dsign > 0) {
3063		if (rsign > 0) {
3064		    mpi_addi(&test, &test, 1);
3065		    mpi_divi(&test, &test, 2);
3066		    if (mpi_cmp(rem, &test) >= 0)
3067			state = NDIVIDE_ADD;
3068		}
3069		else {
3070		    mpi_neg(&test, &test);
3071		    mpi_subi(&test, &test, 1);
3072		    mpi_divi(&test, &test, 2);
3073		    if (mpi_cmp(rem, &test) <= 0)
3074			state = NDIVIDE_SUB;
3075		}
3076	    }
3077	    else {
3078		if (rsign > 0) {
3079		    mpi_neg(&test, &test);
3080		    mpi_addi(&test, &test, 1);
3081		    mpi_divi(&test, &test, 2);
3082		    if (mpi_cmp(rem, &test) >= 0)
3083			state = NDIVIDE_SUB;
3084		}
3085		else {
3086		    mpi_subi(&test, &test, 1);
3087		    mpi_divi(&test, &test, 2);
3088		    if (mpi_cmp(rem, &test) <= 0)
3089			state = NDIVIDE_ADD;
3090		}
3091	    }
3092	    mpi_clear(&test);
3093	}   break;
3094    }
3095
3096    if (state == NDIVIDE_ADD) {
3097	mpi_addi(quo, quo, 1);
3098	switch (type) {
3099	    case LispFixnum_t:
3100		mpi_subi(rem, rem, OFI(div));
3101		break;
3102	    case LispInteger_t:
3103		mpi_subi(rem, rem, OII(div));
3104		break;
3105	    default:
3106		mpi_sub(rem, rem, OBI(div));
3107	}
3108    }
3109    else if (state == NDIVIDE_SUB) {
3110	mpi_subi(quo, quo, 1);
3111	switch (type) {
3112	    case LispFixnum_t:
3113		mpi_addi(rem, rem, OFI(div));
3114		break;
3115	    case LispInteger_t:
3116		mpi_addi(rem, rem, OII(div));
3117		break;
3118	    default:
3119		mpi_add(rem, rem, OBI(div));
3120	}
3121    }
3122
3123    if (mpi_fiti(rem)) {
3124	NITYPE(num) = N_FIXNUM;
3125	NIFI(num) = mpi_geti(rem);
3126	mpi_clear(rem);
3127	XFREE(rem);
3128    }
3129    else {
3130	NITYPE(num) = N_BIGNUM;
3131	NIBI(num) = rem;
3132    }
3133
3134    clear_real(NREAL(num));
3135
3136    if (flo) {
3137	double dval = bi_getd(quo);
3138
3139	mpi_clear(quo);
3140	XFREE(quo);
3141	NRTYPE(num) = N_FLONUM;
3142	NRFF(num) = dval;
3143    }
3144    else {
3145	NRTYPE(num) = N_BIGNUM;
3146	NRBI(num) = quo;
3147	rbi_canonicalize(NREAL(num));
3148    }
3149}
3150
3151static void
3152ndivide_flonum(n_number *number, double num, double div, int fun, int flo)
3153{
3154    double quo, rem, modp, tmp;
3155
3156    modp = modf(num / div, &quo);
3157    rem = num - quo * div;
3158
3159    switch (fun) {
3160	case NDIVIDE_CEIL:
3161	    if ((rem < 0.0 && div < 0.0) || (rem > 0.0 && div > 0.0)) {
3162		quo += 1.0;
3163		rem -= div;
3164	    }
3165	    break;
3166	case NDIVIDE_FLOOR:
3167	    if ((rem < 0.0 && div > 0.0) || (rem > 0.0 && div < 0.0)) {
3168		quo -= 1.0;
3169		rem += div;
3170	    }
3171	    break;
3172	case NDIVIDE_ROUND:
3173	    if (fabs(modp) != 0.5 || modf(quo * 0.5, &tmp) != 0.0) {
3174		if (div > 0.0) {
3175		    if (rem > 0.0) {
3176			if (rem >= div * 0.5) {
3177			    quo += 1.0;
3178			    rem -= div;
3179			}
3180		    }
3181		    else {
3182			if (rem <= div * -0.5) {
3183			    quo -= 1.0;
3184			    rem += div;
3185			}
3186		    }
3187		}
3188		else {
3189		    if (rem > 0.0) {
3190			if (rem >= div * -0.5) {
3191			    quo -= 1.0;
3192			    rem += div;
3193			}
3194		    }
3195		    else {
3196			if (rem <= div * 0.5) {
3197			    quo += 1.0;
3198			    rem -= div;
3199			}
3200		    }
3201		}
3202	    }
3203	    break;
3204    }
3205    if (!finite(quo) || !finite(rem))
3206	fatal_error(FLOATING_POINT_OVERFLOW);
3207
3208    NITYPE(number) = N_FLONUM;
3209    NIFF(number) = rem;
3210
3211    clear_real(NREAL(number));
3212
3213    if (flo) {
3214	NRTYPE(number) = N_FLONUM;
3215	NRFF(number) = quo;
3216    }
3217    else {
3218	if ((long)quo == quo) {
3219	    NRTYPE(number) = N_FIXNUM;
3220	    NRFI(number) = (long)quo;
3221	}
3222	else {
3223	    mpi *bigi = XALLOC(mpi);
3224
3225	    mpi_init(bigi);
3226	    mpi_setd(bigi, quo);
3227	    NRBI(number) = bigi;
3228	    NRTYPE(number) = N_BIGNUM;
3229	}
3230    }
3231}
3232
3233static void
3234ndivide_xi_xr(n_number *num, LispObj *div, int fun, int flo)
3235{
3236    int state = NDIVIDE_NOP, dsign, rsign;
3237    mpi *quo;
3238    mpr *rem;
3239
3240    quo = XALLOC(mpi);
3241    mpi_init(quo);
3242    if (NRTYPE(num) == N_FIXNUM)
3243	mpi_seti(quo, NRFI(num));
3244    else
3245	mpi_set(quo, NRBI(num));
3246
3247    rem = XALLOC(mpr);
3248    mpr_init(rem);
3249
3250    if (XOBJECT_TYPE(div) == LispRatio_t)
3251	mpr_seti(rem, OFRN(div), OFRD(div));
3252    else
3253	mpr_set(rem, OBR(div));
3254    dsign = mpi_sgn(mpr_num(rem));
3255    mpi_mul(quo, quo, mpr_den(rem));
3256
3257    mpi_divqr(quo, mpr_num(rem), quo, mpr_num(rem));
3258    mpr_canonicalize(rem);
3259
3260    rsign = mpi_sgn(mpr_num(rem));
3261    if (mpr_fiti(rem)) {
3262	if (mpi_geti(mpr_den(rem)) == 1) {
3263	    NITYPE(num) = N_FIXNUM;
3264	    NIFI(num) = mpi_geti(mpr_num(rem));
3265	}
3266	else {
3267	    NITYPE(num) = N_FIXRATIO;
3268	    NIFRN(num) = mpi_geti(mpr_num(rem));
3269	    NIFRD(num) = mpi_geti(mpr_den(rem));
3270	}
3271	mpr_clear(rem);
3272	XFREE(rem);
3273    }
3274    else {
3275	if (mpi_fiti(mpr_den(rem)) && mpi_geti(mpr_den(rem)) == 1) {
3276	    NITYPE(num) = N_BIGNUM;
3277	    NIBI(num) = mpr_num(rem);
3278	    mpi_clear(mpr_den(rem));
3279	    XFREE(rem);
3280	}
3281	else {
3282	    NITYPE(num) = N_BIGRATIO;
3283	    NIBR(num) = rem;
3284	}
3285    }
3286
3287    switch (fun) {
3288	case NDIVIDE_CEIL:
3289	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
3290		state = NDIVIDE_ADD;
3291	    break;
3292	case NDIVIDE_FLOOR:
3293	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
3294		state = NDIVIDE_SUB;
3295	    break;
3296	case NDIVIDE_ROUND: {
3297	    n_real cmp;
3298
3299	    set_real_object(&cmp, div);
3300	    div_real_real(&cmp, &two);
3301	    if (dsign > 0) {
3302		if (rsign > 0) {
3303		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
3304			state = NDIVIDE_ADD;
3305		}
3306		else {
3307		    neg_real(&cmp);
3308		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
3309			state = NDIVIDE_SUB;
3310		}
3311	    }
3312	    else {
3313		if (rsign > 0) {
3314		    neg_real(&cmp);
3315		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
3316			state = NDIVIDE_SUB;
3317		}
3318		else {
3319		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
3320			state = NDIVIDE_ADD;
3321		}
3322	    }
3323	    clear_real(&cmp);
3324	}   break;
3325    }
3326
3327    if (state == NDIVIDE_ADD) {
3328	mpi_addi(quo, quo, 1);
3329	sub_real_object(NIMAG(num), div);
3330    }
3331    else if (state == NDIVIDE_SUB) {
3332	mpi_subi(quo, quo, 1);
3333	add_real_object(NIMAG(num), div);
3334    }
3335
3336    clear_real(NREAL(num));
3337
3338    if (flo) {
3339	double dval = bi_getd(quo);
3340
3341	mpi_clear(quo);
3342	XFREE(quo);
3343	NRTYPE(num) = N_FLONUM;
3344	NRFF(num) = dval;
3345    }
3346    else {
3347	NRBI(num)  = quo;
3348	NRTYPE(num) = N_BIGNUM;
3349	rbi_canonicalize(NREAL(num));
3350    }
3351}
3352
3353static void
3354ndivide_xr_xi(n_number *num, LispObj *div, int fun, int flo)
3355{
3356    LispType type = OBJECT_TYPE(div);
3357    int state = NDIVIDE_NOP, dsign, rsign;
3358    mpi *quo;
3359    mpr *rem;
3360
3361    quo = XALLOC(mpi);
3362    mpi_init(quo);
3363    switch (type) {
3364	case LispFixnum_t:
3365	    dsign = OFI(div) < 0 ? -1 : OFI(div) > 0 ? 1 : 0;
3366	    mpi_seti(quo, OFI(div));
3367	    break;
3368	case LispInteger_t:
3369	    dsign = OII(div) < 0 ? -1 : OII(div) > 0 ? 1 : 0;
3370	    mpi_seti(quo, OII(div));
3371	    break;
3372	default:
3373	    dsign = mpi_sgn(OBI(div));
3374	    mpi_set(quo, OBI(div));
3375	    break;
3376    }
3377
3378    rem = XALLOC(mpr);
3379    mpr_init(rem);
3380    if (NRTYPE(num) == N_FIXRATIO) {
3381	mpr_seti(rem, NRFRN(num), NRFRD(num));
3382	mpi_muli(quo, quo, NRFRD(num));
3383    }
3384    else {
3385	mpr_set(rem, NRBR(num));
3386	mpi_mul(quo, quo, NRBRD(num));
3387    }
3388    mpi_divqr(quo, mpr_num(rem), mpr_num(rem), quo);
3389    mpr_canonicalize(rem);
3390
3391    rsign = mpi_sgn(mpr_num(rem));
3392    if (mpr_fiti(rem)) {
3393	NITYPE(num) = N_FIXRATIO;
3394	NIFRN(num) = mpi_geti(mpr_num(rem));
3395	NIFRD(num) = mpi_geti(mpr_den(rem));
3396	mpr_clear(rem);
3397	XFREE(rem);
3398    }
3399    else {
3400	NITYPE(num) = N_BIGRATIO;
3401	NIBR(num) = rem;
3402    }
3403
3404    switch (fun) {
3405	case NDIVIDE_CEIL:
3406	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
3407		state = NDIVIDE_ADD;
3408	    break;
3409	case NDIVIDE_FLOOR:
3410	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
3411		state = NDIVIDE_SUB;
3412	    break;
3413	case NDIVIDE_ROUND: {
3414	    n_real cmp;
3415
3416	    set_real_object(&cmp, div);
3417	    div_real_real(&cmp, &two);
3418	    if (dsign > 0) {
3419		if (rsign > 0) {
3420		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
3421			state = NDIVIDE_ADD;
3422		}
3423		else {
3424		    neg_real(&cmp);
3425		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
3426			state = NDIVIDE_SUB;
3427		}
3428	    }
3429	    else {
3430		if (rsign > 0) {
3431		    neg_real(&cmp);
3432		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
3433			state = NDIVIDE_SUB;
3434		}
3435		else {
3436		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
3437			state = NDIVIDE_ADD;
3438		}
3439	    }
3440	    clear_real(&cmp);
3441	}   break;
3442    }
3443
3444    if (state == NDIVIDE_ADD) {
3445	mpi_addi(quo, quo, 1);
3446	sub_real_object(NIMAG(num), div);
3447    }
3448    else if (state == NDIVIDE_SUB) {
3449	mpi_subi(quo, quo, 1);
3450	add_real_object(NIMAG(num), div);
3451    }
3452
3453    clear_real(NREAL(num));
3454
3455    if (flo) {
3456	double dval = bi_getd(quo);
3457
3458	mpi_clear(quo);
3459	XFREE(quo);
3460	NRTYPE(num) = N_FLONUM;
3461	NRFF(num) = dval;
3462    }
3463    else {
3464	NRBI(num) = quo;
3465	NRTYPE(num) = N_BIGNUM;
3466	rbi_canonicalize(NREAL(num));
3467    }
3468}
3469
3470static void
3471ndivide_xr_xr(n_number *num, LispObj *div, int fun, int flo)
3472{
3473    int state = NDIVIDE_NOP, dsign, rsign, modp;
3474    mpr *bigr;
3475    mpi *bigi;
3476
3477    bigr = XALLOC(mpr);
3478    mpr_init(bigr);
3479    if (NRTYPE(num) == N_FIXRATIO)
3480	mpr_seti(bigr, NRFRN(num), NRFRD(num));
3481    else
3482	mpr_set(bigr, NRBR(num));
3483
3484    NITYPE(num) = N_BIGRATIO;
3485    NIBR(num) = bigr;
3486
3487    if (OBJECT_TYPE(div) == LispRatio_t) {
3488	dsign = OFRN(div) < 0 ? -1 : OFRN(div) > 0 ? 1 : 0;
3489	mpi_muli(mpr_num(bigr), mpr_num(bigr), OFRD(div));
3490	mpi_muli(mpr_den(bigr), mpr_den(bigr), OFRN(div));
3491    }
3492    else {
3493	dsign = mpi_sgn(OBRN(div));
3494	mpr_div(bigr, bigr, OBR(div));
3495    }
3496    modp = mpi_fiti(mpr_den(bigr)) && mpi_geti(mpr_den(bigr)) == 2;
3497
3498    bigi = XALLOC(mpi);
3499    mpi_init(bigi);
3500    mpi_divqr(bigi, mpr_num(bigr), mpr_num(bigr), mpr_den(bigr));
3501
3502    if (OBJECT_TYPE(div) == LispRatio_t)
3503	mpi_seti(mpr_den(bigr), OFRD(div));
3504    else
3505	mpi_set(mpr_den(bigr), OBRD(div));
3506    if (NRTYPE(num) == N_FIXRATIO)
3507	mpi_muli(mpr_den(bigr), mpr_den(bigr), NRFRD(num));
3508    else
3509	mpi_mul(mpr_den(bigr), mpr_den(bigr), NRBRD(num));
3510
3511    clear_real(NREAL(num));
3512    NRTYPE(num) = N_BIGNUM;
3513    NRBI(num) = bigi;
3514
3515    rbr_canonicalize(NIMAG(num));
3516    rsign = cmp_real_real(NIMAG(num), &zero);
3517
3518    switch (fun) {
3519	case NDIVIDE_CEIL:
3520	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
3521		state = NDIVIDE_ADD;
3522	    break;
3523	case NDIVIDE_FLOOR:
3524	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
3525		state = NDIVIDE_SUB;
3526	    break;
3527	case NDIVIDE_ROUND:
3528	    if (!modp || (bigi->digs[0] & 1) == 1) {
3529		n_real cmp;
3530
3531		set_real_object(&cmp, div);
3532		div_real_real(&cmp, &two);
3533		if (dsign > 0) {
3534		    if (rsign > 0) {
3535			if (cmp_real_real(NIMAG(num), &cmp) >= 0)
3536			    state = NDIVIDE_ADD;
3537		    }
3538		    else {
3539			neg_real(&cmp);
3540			if (cmp_real_real(NIMAG(num), &cmp) <= 0)
3541			    state = NDIVIDE_SUB;
3542		    }
3543		}
3544		else {
3545		    if (rsign > 0) {
3546			neg_real(&cmp);
3547			if (cmp_real_real(NIMAG(num), &cmp) >= 0)
3548			    state = NDIVIDE_SUB;
3549		    }
3550		    else {
3551			if (cmp_real_real(NIMAG(num), &cmp) <= 0)
3552			    state = NDIVIDE_ADD;
3553		    }
3554		}
3555		clear_real(&cmp);
3556	    }
3557	    break;
3558    }
3559
3560    if (state == NDIVIDE_ADD) {
3561	add_real_real(NREAL(num), &one);
3562	sub_real_object(NIMAG(num), div);
3563    }
3564    else if (state == NDIVIDE_SUB) {
3565	sub_real_real(NREAL(num), &one);
3566	add_real_object(NIMAG(num), div);
3567    }
3568
3569    if (NRTYPE(num) == N_BIGNUM) {
3570	if (flo) {
3571	    double dval = bi_getd(bigi);
3572
3573	    mpi_clear(bigi);
3574	    XFREE(bigi);
3575	    NRTYPE(num) = N_FLONUM;
3576	    NRFF(num) = dval;
3577	}
3578	else
3579	    rbi_canonicalize(NREAL(num));
3580    }
3581    else if (flo) {
3582	NRTYPE(num) = N_FLONUM;
3583	NRFF(num) = (double)NRFI(num);
3584    }
3585}
3586
3587
3588/************************************************************************
3589 * REAL COMPLEX
3590 ************************************************************************/
3591static void
3592nadd_re_cx(n_number *num, LispObj *comp)
3593{
3594/*
3595	Ra+Rb Ib
3596 */
3597    /* Ra+Rb */
3598    add_real_object(NREAL(num), OCXR(comp));
3599
3600    /* Ib */
3601    set_real_object(NIMAG(num), OCXI(comp));
3602
3603    num->complex = 1;
3604
3605    ncx_canonicalize(num);
3606}
3607
3608static void
3609nsub_re_cx(n_number *num, LispObj *comp)
3610{
3611/*
3612	Ra-Rb -Ib
3613 */
3614    /* Ra-Rb */
3615    sub_real_object(NREAL(num), OCXR(comp));
3616
3617    /* -Ib */
3618    NITYPE(num) = N_FIXNUM;
3619    NIFI(num) = -1;
3620    mul_real_object(NIMAG(num), OCXI(comp));
3621
3622    num->complex = 1;
3623
3624    ncx_canonicalize(num);
3625}
3626
3627static void
3628nmul_re_cx(n_number *num, LispObj *comp)
3629{
3630/*
3631	Ra*Rb Ra*Ib
3632 */
3633    /* copy before change */
3634    set_real_real(NIMAG(num), NREAL(num));
3635
3636    /* Ra*Rb */
3637    mul_real_object(NREAL(num), OCXR(comp));
3638
3639    /* Ra*Ib */
3640    mul_real_object(NIMAG(num), OCXI(comp));
3641
3642    num->complex = 1;
3643
3644    ncx_canonicalize(num);
3645}
3646
3647static void
3648ndiv_re_cx(n_number *num, LispObj *comp)
3649{
3650/*
3651	Ra*Rb        -Ib*Ra
3652	-----------  -----------
3653	Rb*Rb+Ib*Ib  Rb*Rb+Ib*Ib
3654 */
3655    n_real div, temp;
3656
3657    /* Rb*Rb */
3658    set_real_object(&div, OCXR(comp));
3659    mul_real_object(&div, OCXR(comp));
3660
3661    /* Ib*Ib */
3662    set_real_object(&temp, OCXI(comp));
3663    mul_real_object(&temp, OCXI(comp));
3664
3665    /* Rb*Rb+Ib*Ib */
3666    add_real_real(&div, &temp);
3667    clear_real(&temp);
3668
3669    /* -Ib*Ra */
3670    NITYPE(num) = N_FIXNUM;
3671    NIFI(num) = -1;
3672    mul_real_object(NIMAG(num), OCXI(comp));
3673    mul_real_real(NIMAG(num), NREAL(num));
3674
3675    /* Ra*Rb */
3676    mul_real_object(NREAL(num), OCXR(comp));
3677
3678    div_real_real(NREAL(num), &div);
3679    div_real_real(NIMAG(num), &div);
3680    clear_real(&div);
3681
3682    num->complex = 1;
3683
3684    ncx_canonicalize(num);
3685}
3686
3687
3688/************************************************************************
3689 * COMPLEX REAL
3690 ************************************************************************/
3691static void
3692nadd_cx_re(n_number *num, LispObj *re)
3693{
3694/*
3695	Ra+Rb Ia
3696 */
3697    add_real_object(NREAL(num), re);
3698
3699    ncx_canonicalize(num);
3700}
3701
3702static void
3703nsub_cx_re(n_number *num, LispObj *re)
3704{
3705/*
3706	Ra-Rb Ia
3707 */
3708    sub_real_object(NREAL(num), re);
3709
3710    ncx_canonicalize(num);
3711}
3712
3713static void
3714nmul_cx_re(n_number *num, LispObj *re)
3715{
3716/*
3717	Ra*Rb Ia*Rb
3718 */
3719    mul_real_object(NREAL(num), re);
3720    mul_real_object(NIMAG(num), re);
3721
3722    ncx_canonicalize(num);
3723}
3724
3725static void
3726ndiv_cx_re(n_number *num, LispObj *re)
3727{
3728/*
3729	Ra/Rb Ia/Rb
3730 */
3731    div_real_object(NREAL(num), re);
3732    div_real_object(NIMAG(num), re);
3733
3734    ncx_canonicalize(num);
3735}
3736
3737
3738/************************************************************************
3739 * COMPLEX COMPLEX
3740 ************************************************************************/
3741static void
3742nadd_cx_cx(n_number *num, LispObj *comp)
3743{
3744/*
3745	Ra+Rb Ia+Ib
3746 */
3747    add_real_object(NREAL(num), OCXR(comp));
3748    add_real_object(NIMAG(num), OCXI(comp));
3749
3750    ncx_canonicalize(num);
3751}
3752
3753static void
3754nsub_cx_cx(n_number *num, LispObj *comp)
3755{
3756/*
3757	Ra-Rb Ia-Ib
3758 */
3759    sub_real_object(NREAL(num), OCXR(comp));
3760    sub_real_object(NIMAG(num), OCXI(comp));
3761
3762    ncx_canonicalize(num);
3763}
3764
3765static void
3766nmul_cx_cx(n_number *num, LispObj *comp)
3767{
3768/*
3769	Ra*Rb-Ia*Ib Ra*Ib+Ia*Rb
3770 */
3771    n_real IaIb, RaIb;
3772
3773    set_real_real(&IaIb, NIMAG(num));
3774    mul_real_object(&IaIb, OCXI(comp));
3775
3776    set_real_real(&RaIb, NREAL(num));
3777    mul_real_object(&RaIb, OCXI(comp));
3778
3779    /* Ra*Rb-Ia*Ib */
3780    mul_real_object(NREAL(num), OCXR(comp));
3781    sub_real_real(NREAL(num), &IaIb);
3782    clear_real(&IaIb);
3783
3784    /* Ra*Ib+Ia*Rb */
3785    mul_real_object(NIMAG(num), OCXR(comp));
3786    add_real_real(NIMAG(num), &RaIb);
3787    clear_real(&RaIb);
3788
3789    ncx_canonicalize(num);
3790}
3791
3792static void
3793ndiv_cx_cx(n_number *num, LispObj *comp)
3794{
3795/*
3796	Ra*Rb+Ia*Ib  Ia*Rb-Ib*Ra
3797	-----------  -----------
3798	Rb*Rb+Ib*Ib  Rb*Rb+Ib*Ib
3799 */
3800    n_real temp1, temp2;
3801
3802    /* IaIb */
3803    set_real_real(&temp1, NIMAG(num));
3804    mul_real_object(&temp1, OCXI(comp));
3805
3806    /* IbRa */
3807    set_real_real(&temp2, NREAL(num));
3808    mul_real_object(&temp2, OCXI(comp));
3809
3810    /* Ra*Rb+Ia*Ib */
3811    mul_real_object(NREAL(num), OCXR(comp));
3812    add_real_real(NREAL(num), &temp1);
3813    clear_real(&temp1);
3814
3815    /* Ia*Rb-Ib*Ra */
3816    mul_real_object(NIMAG(num), OCXR(comp));
3817    sub_real_real(NIMAG(num), &temp2);
3818    clear_real(&temp2);
3819
3820
3821    /* Rb*Rb */
3822    set_real_object(&temp1, OCXR(comp));
3823    mul_real_object(&temp1, OCXR(comp));
3824
3825    /* Ib*Ib */
3826    set_real_object(&temp2, OCXI(comp));
3827    mul_real_object(&temp2, OCXI(comp));
3828
3829    /* Rb*Rb+Ib*Ib */
3830    add_real_real(&temp1, &temp2);
3831    clear_real(&temp2);
3832
3833    div_real_real(NREAL(num), &temp1);
3834    div_real_real(NIMAG(num), &temp1);
3835    clear_real(&temp1);
3836
3837    ncx_canonicalize(num);
3838}
3839
3840static int
3841cmp_cx_cx(LispObj *op1, LispObj *op2)
3842{
3843    int cmp;
3844
3845    cmp = cmp_object_object(OCXR(op1), OCXR(op2), 1);
3846    if (cmp == 0)
3847	cmp = cmp_object_object(OCXI(op1), OCXI(op2), 1);
3848
3849    return (cmp);
3850}
3851
3852
3853/************************************************************************
3854 * FLONUM FLONUM
3855 ************************************************************************/
3856static void
3857radd_flonum(n_real *real, double op1, double op2)
3858{
3859    double value = op1 + op2;
3860
3861    if (!finite(value))
3862	fatal_error(FLOATING_POINT_OVERFLOW);
3863    switch (RTYPE(real)) {
3864	case N_FIXNUM:
3865	case N_FIXRATIO:
3866	    RTYPE(real) = N_FLONUM;
3867	    break;
3868	case N_BIGNUM:
3869	    RCLEAR_BI(real);
3870	    RTYPE(real) = N_FLONUM;
3871	    break;
3872	case N_BIGRATIO:
3873	    RCLEAR_BR(real);
3874	    RTYPE(real) = N_FLONUM;
3875	    break;
3876    }
3877    RFF(real) = value;
3878}
3879
3880static void
3881rsub_flonum(n_real *real, double op1, double op2)
3882{
3883    double value = op1 - op2;
3884
3885    if (!finite(value))
3886	fatal_error(FLOATING_POINT_OVERFLOW);
3887    switch (RTYPE(real)) {
3888	case N_FIXNUM:
3889	case N_FIXRATIO:
3890	    RTYPE(real) = N_FLONUM;
3891	    break;
3892	case N_BIGNUM:
3893	    RCLEAR_BI(real);
3894	    RTYPE(real) = N_FLONUM;
3895	    break;
3896	case N_BIGRATIO:
3897	    RCLEAR_BR(real);
3898	    RTYPE(real) = N_FLONUM;
3899	    break;
3900    }
3901    RFF(real) = value;
3902}
3903
3904static void
3905rmul_flonum(n_real *real, double op1, double op2)
3906{
3907    double value = op1 * op2;
3908
3909    if (!finite(value))
3910	fatal_error(FLOATING_POINT_OVERFLOW);
3911    switch (RTYPE(real)) {
3912	case N_FIXNUM:
3913	case N_FIXRATIO:
3914	    RTYPE(real) = N_FLONUM;
3915	    break;
3916	case N_BIGNUM:
3917	    RCLEAR_BI(real);
3918	    RTYPE(real) = N_FLONUM;
3919	    break;
3920	case N_BIGRATIO:
3921	    RCLEAR_BR(real);
3922	    RTYPE(real) = N_FLONUM;
3923	    break;
3924    }
3925    RFF(real) = value;
3926}
3927
3928static void
3929rdiv_flonum(n_real *real, double op1, double op2)
3930{
3931    double value;
3932
3933    if (op2 == 0.0)
3934	fatal_error(DIVIDE_BY_ZERO);
3935    value = op1 / op2;
3936    if (!finite(value))
3937	fatal_error(FLOATING_POINT_OVERFLOW);
3938    switch (RTYPE(real)) {
3939	case N_FIXNUM:
3940	case N_FIXRATIO:
3941	    RTYPE(real) = N_FLONUM;
3942	    break;
3943	case N_BIGNUM:
3944	    RCLEAR_BI(real);
3945	    RTYPE(real) = N_FLONUM;
3946	    break;
3947	case N_BIGRATIO:
3948	    RCLEAR_BR(real);
3949	    RTYPE(real) = N_FLONUM;
3950	    break;
3951    }
3952    RFF(real) = value;
3953}
3954
3955static int
3956cmp_flonum(double op1, double op2)
3957{
3958    double value = op1 - op2;
3959
3960    if (!finite(value))
3961	fatal_error(FLOATING_POINT_OVERFLOW);
3962
3963    return (value > 0.0 ? 1 : value < 0.0 ? -1 : 0);
3964}
3965
3966
3967/************************************************************************
3968 * FIXNUM FIXNUM
3969 ************************************************************************/
3970static void
3971rop_fi_fi_bi(n_real *real, long fi, int op)
3972{
3973    mpi *bigi = XALLOC(mpi);
3974
3975    mpi_init(bigi);
3976    mpi_seti(bigi, RFI(real));
3977    if (op == NOP_ADD)
3978	mpi_addi(bigi, bigi, fi);
3979    else if (op == NOP_SUB)
3980	mpi_subi(bigi, bigi, fi);
3981    else
3982	mpi_muli(bigi, bigi, fi);
3983    RBI(real) = bigi;
3984    RTYPE(real) = N_BIGNUM;
3985}
3986
3987static INLINE void
3988radd_fi_fi(n_real *real, long fi)
3989{
3990    if (!fi_fi_add_overflow(RFI(real), fi))
3991	RFI(real) += fi;
3992    else
3993	rop_fi_fi_bi(real, fi, NOP_ADD);
3994}
3995
3996static INLINE void
3997rsub_fi_fi(n_real *real, long fi)
3998{
3999    if (!fi_fi_sub_overflow(RFI(real), fi))
4000	RFI(real) -= fi;
4001    else
4002	rop_fi_fi_bi(real, fi, NOP_SUB);
4003}
4004
4005static INLINE void
4006rmul_fi_fi(n_real *real, long fi)
4007{
4008    if (!fi_fi_mul_overflow(RFI(real), fi))
4009	RFI(real) *= fi;
4010    else
4011	rop_fi_fi_bi(real, fi, NOP_MUL);
4012}
4013
4014static INLINE void
4015rdiv_fi_fi(n_real *real, long fi)
4016{
4017    RTYPE(real) = N_FIXRATIO;
4018    RFRN(real) = RFI(real);
4019    RFRD(real) = fi;
4020    rfr_canonicalize(real);
4021}
4022
4023static INLINE int
4024cmp_fi_fi(long op1, long op2)
4025{
4026    if (op1 > op2)
4027	return (1);
4028    else if (op1 < op2)
4029	return (-1);
4030
4031    return (0);
4032}
4033
4034
4035/************************************************************************
4036 * FIXNUM BIGNUM
4037 ************************************************************************/
4038static void
4039rop_fi_bi_xi(n_real *real, mpi *bi, int nop)
4040{
4041    mpi *bigi = XALLOC(mpi);
4042
4043    mpi_init(bigi);
4044    mpi_seti(bigi, RFI(real));
4045    if (nop == NOP_ADD)
4046	mpi_add(bigi, bigi, bi);
4047    else if (nop == NOP_SUB)
4048	mpi_sub(bigi, bigi, bi);
4049    else
4050	mpi_mul(bigi, bigi, bi);
4051
4052    if (mpi_fiti(bigi)) {
4053	RFI(real) = mpi_geti(bigi);
4054	mpi_clear(bigi);
4055	XFREE(bigi);
4056    }
4057    else {
4058	RBI(real) = bigi;
4059	RTYPE(real) = N_BIGNUM;
4060    }
4061}
4062
4063static INLINE void
4064radd_fi_bi(n_real *real, mpi *bi)
4065{
4066    rop_fi_bi_xi(real, bi, NOP_ADD);
4067}
4068
4069static INLINE void
4070rsub_fi_bi(n_real *real, mpi *bi)
4071{
4072    rop_fi_bi_xi(real, bi, NOP_SUB);
4073}
4074
4075static INLINE void
4076rmul_fi_bi(n_real *real, mpi *bi)
4077{
4078    rop_fi_bi_xi(real, bi, NOP_MUL);
4079}
4080
4081static void
4082rdiv_fi_bi(n_real *real, mpi *bi)
4083{
4084    mpr *bigr;
4085
4086    if (mpi_cmpi(bi, 0) == 0)
4087	fatal_error(DIVIDE_BY_ZERO);
4088
4089    bigr = XALLOC(mpr);
4090    mpr_init(bigr);
4091    mpi_seti(mpr_num(bigr), RFI(real));
4092    mpi_set(mpr_den(bigr), bi);
4093    RBR(real) = bigr;
4094    RTYPE(real) = N_BIGRATIO;
4095    rbr_canonicalize(real);
4096}
4097
4098static INLINE int
4099cmp_fi_bi(long fixnum, mpi *bignum)
4100{
4101    return (-mpi_cmpi(bignum, fixnum));
4102}
4103
4104
4105/************************************************************************
4106 * FIXNUM FIXRATIO
4107 ************************************************************************/
4108static void
4109rop_fi_fr_as_xr(n_real *real, long num, long den, int nop)
4110{
4111    int fit;
4112    long value = 0, op = RFI(real);
4113
4114    fit = !fi_fi_mul_overflow(op, den);
4115    if (fit) {
4116	value = op * den;
4117	if (nop == NOP_ADD)
4118	    fit = !fi_fi_add_overflow(value, num);
4119	else
4120	    fit = !fi_fi_sub_overflow(value, num);
4121    }
4122    if (fit) {
4123	if (nop == NOP_ADD)
4124	    RFRN(real) = value + num;
4125	else
4126	    RFRN(real) = value - num;
4127	RFRD(real) = den;
4128	RTYPE(real) = N_FIXRATIO;
4129	rfr_canonicalize(real);
4130    }
4131    else {
4132	mpi iop;
4133	mpr *bigr = XALLOC(mpr);
4134
4135	mpi_init(&iop);
4136	mpi_seti(&iop, op);
4137	mpi_muli(&iop, &iop, den);
4138
4139	mpr_init(bigr);
4140	mpr_seti(bigr, num, den);
4141	if (nop == NOP_ADD)
4142	    mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
4143	else
4144	    mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
4145	mpi_clear(&iop);
4146	RBR(real) = bigr;
4147	RTYPE(real) = N_BIGRATIO;
4148	rbr_canonicalize(real);
4149    }
4150}
4151
4152static void
4153rop_fi_fr_md_xr(n_real *real, long num, long den, int nop)
4154{
4155    int fit;
4156    long op = RFI(real);
4157
4158    if (nop == NOP_MUL)
4159	fit = !fi_fi_mul_overflow(op, num);
4160    else
4161	fit = !fi_fi_mul_overflow(op, den);
4162    if (fit) {
4163	if (nop == NOP_MUL) {
4164	    RFRN(real) = op * num;
4165	    RFRD(real) = den;
4166	}
4167	else {
4168	    RFRN(real) = op * den;
4169	    RFRD(real) = num;
4170	}
4171	RTYPE(real) = N_FIXRATIO;
4172	rfr_canonicalize(real);
4173    }
4174    else {
4175	mpi iop;
4176	mpr *bigr = XALLOC(mpr);
4177
4178	mpi_init(&iop);
4179	mpi_seti(&iop, op);
4180
4181	mpr_init(bigr);
4182	if (nop == NOP_MUL)
4183	    mpr_seti(bigr, num, den);
4184	else
4185	    mpr_seti(bigr, den, num);
4186	mpi_mul(mpr_num(bigr), mpr_num(bigr), &iop);
4187	mpi_clear(&iop);
4188	RBR(real) = bigr;
4189	RTYPE(real) = N_BIGRATIO;
4190	rbr_canonicalize(real);
4191    }
4192}
4193
4194static INLINE void
4195radd_fi_fr(n_real *real, long num, long den)
4196{
4197    rop_fi_fr_as_xr(real, num, den, NOP_ADD);
4198}
4199
4200static INLINE void
4201rsub_fi_fr(n_real *real, long num, long den)
4202{
4203    rop_fi_fr_as_xr(real, num, den, NOP_SUB);
4204}
4205
4206static INLINE void
4207rmul_fi_fr(n_real *real, long num, long den)
4208{
4209    rop_fi_fr_md_xr(real, num, den, NOP_MUL);
4210}
4211
4212static INLINE void
4213rdiv_fi_fr(n_real *real, long num, long den)
4214{
4215    rop_fi_fr_md_xr(real, num, den, NOP_DIV);
4216}
4217
4218static INLINE int
4219cmp_fi_fr(long fi, long num, long den)
4220{
4221    return (cmp_flonum((double)fi, (double)num / (double)den));
4222}
4223
4224
4225/************************************************************************
4226 * FIXNUM BIGRATIO
4227 ************************************************************************/
4228static void
4229rop_fi_br_as_xr(n_real *real, mpr *ratio, int nop)
4230{
4231    mpi iop;
4232    mpr *bigr = XALLOC(mpr);
4233
4234    mpi_init(&iop);
4235    mpi_seti(&iop, RFI(real));
4236
4237    mpr_init(bigr);
4238    mpr_set(bigr, ratio);
4239
4240    mpi_mul(&iop, &iop, mpr_den(ratio));
4241    if (nop == NOP_ADD)
4242	mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
4243    else
4244	mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
4245
4246    mpi_clear(&iop);
4247    RBR(real) = bigr;
4248    RTYPE(real) = N_BIGRATIO;
4249    rbr_canonicalize(real);
4250}
4251
4252static void
4253rop_fi_br_md_xr(n_real *real, mpr *ratio, int nop)
4254{
4255    mpi iop;
4256    mpr *bigr = XALLOC(mpr);
4257
4258    mpi_init(&iop);
4259    mpi_seti(&iop, RFI(real));
4260
4261    mpr_init(bigr);
4262    if (nop == NOP_MUL)
4263	mpr_set(bigr, ratio);
4264    else
4265	mpr_inv(bigr, ratio);
4266
4267    mpi_mul(mpr_num(bigr), &iop, mpr_num(bigr));
4268
4269    mpi_clear(&iop);
4270    RBR(real) = bigr;
4271    RTYPE(real) = N_BIGRATIO;
4272    rbr_canonicalize(real);
4273}
4274
4275static INLINE void
4276radd_fi_br(n_real *real, mpr *ratio)
4277{
4278    rop_fi_br_as_xr(real, ratio, NOP_ADD);
4279}
4280
4281static INLINE void
4282rsub_fi_br(n_real *real, mpr *ratio)
4283{
4284    rop_fi_br_as_xr(real, ratio, NOP_SUB);
4285}
4286
4287static INLINE void
4288rmul_fi_br(n_real *real, mpr *ratio)
4289{
4290    rop_fi_br_md_xr(real, ratio, NOP_MUL);
4291}
4292
4293static INLINE void
4294rdiv_fi_br(n_real *real, mpr *ratio)
4295{
4296    rop_fi_br_md_xr(real, ratio, NOP_DIV);
4297}
4298
4299static INLINE int
4300cmp_fi_br(long op1, mpr *op2)
4301{
4302    return (-mpr_cmpi(op2, op1));
4303}
4304
4305
4306/************************************************************************
4307 * BIGNUM FIXNUM
4308 ************************************************************************/
4309static INLINE void
4310radd_bi_fi(n_real *real, long fi)
4311{
4312    mpi_addi(RBI(real), RBI(real), fi);
4313    rbi_canonicalize(real);
4314}
4315
4316static INLINE void
4317rsub_bi_fi(n_real *real, long fi)
4318{
4319    mpi_subi(RBI(real), RBI(real), fi);
4320    rbi_canonicalize(real);
4321}
4322
4323static INLINE void
4324rmul_bi_fi(n_real *real, long fi)
4325{
4326    mpi_muli(RBI(real), RBI(real), fi);
4327    rbi_canonicalize(real);
4328}
4329
4330static void
4331rdiv_bi_fi(n_real *real, long fi)
4332{
4333    mpr *bigr;
4334
4335    if (RFI(real) == 0)
4336	fatal_error(DIVIDE_BY_ZERO);
4337
4338    bigr = XALLOC(mpr);
4339    mpr_init(bigr);
4340    mpi_set(mpr_num(bigr), RBI(real));
4341    mpi_seti(mpr_den(bigr), fi);
4342    RCLEAR_BI(real);
4343    RBR(real) = bigr;
4344    RTYPE(real) = N_BIGRATIO;
4345    rbr_canonicalize(real);
4346}
4347
4348static INLINE int
4349cmp_bi_fi(mpi *bignum, long fi)
4350{
4351    return (mpi_cmpi(bignum, fi));
4352}
4353
4354
4355/************************************************************************
4356 * BIGNUM BIGNUM
4357 ************************************************************************/
4358static INLINE void
4359radd_bi_bi(n_real *real, mpi *bignum)
4360{
4361    mpi_add(RBI(real), RBI(real), bignum);
4362    rbi_canonicalize(real);
4363}
4364
4365static INLINE void
4366rsub_bi_bi(n_real *real, mpi *bignum)
4367{
4368    mpi_sub(RBI(real), RBI(real), bignum);
4369    rbi_canonicalize(real);
4370}
4371
4372static INLINE void
4373rmul_bi_bi(n_real *real, mpi *bignum)
4374{
4375    mpi_mul(RBI(real), RBI(real), bignum);
4376    rbi_canonicalize(real);
4377}
4378
4379static void
4380rdiv_bi_bi(n_real *real, mpi *bignum)
4381{
4382    mpr *bigr;
4383
4384    if (mpi_cmpi(bignum, 0) == 0)
4385	fatal_error(DIVIDE_BY_ZERO);
4386
4387    bigr = XALLOC(mpr);
4388    mpr_init(bigr);
4389    mpi_set(mpr_num(bigr), RBI(real));
4390    mpi_set(mpr_den(bigr), bignum);
4391    RCLEAR_BI(real);
4392    RBR(real) = bigr;
4393    RTYPE(real) = N_BIGRATIO;
4394    rbr_canonicalize(real);
4395}
4396
4397static INLINE int
4398cmp_bi_bi(mpi *op1, mpi *op2)
4399{
4400    return (mpi_cmp(op1, op2));
4401}
4402
4403
4404/************************************************************************
4405 * BIGNUM FIXRATIO
4406 ************************************************************************/
4407static void
4408rop_bi_fr_as_xr(n_real *real, long num, long den, int nop)
4409{
4410    mpi iop;
4411    mpr *bigr = XALLOC(mpr);
4412
4413    mpi_init(&iop);
4414    mpi_set(&iop, RBI(real));
4415    mpi_muli(&iop, &iop, den);
4416
4417    mpr_init(bigr);
4418    mpr_seti(bigr, num, den);
4419
4420    if (nop == NOP_ADD)
4421	mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
4422    else
4423	mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
4424    mpi_clear(&iop);
4425
4426    RCLEAR_BI(real);
4427    RBR(real) = bigr;
4428    RTYPE(real) = N_BIGRATIO;
4429    rbr_canonicalize(real);
4430}
4431
4432static INLINE void
4433rop_bi_fr_md_xr(n_real *real, long num, long den, int nop)
4434{
4435    mpr *bigr = XALLOC(mpr);
4436
4437    mpr_init(bigr);
4438
4439    mpr_seti(bigr, num, den);
4440
4441    if (nop == NOP_MUL)
4442	mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr));
4443    else {
4444	mpi_mul(mpr_den(bigr), RBI(real), mpr_den(bigr));
4445	mpr_inv(bigr, bigr);
4446    }
4447
4448    RCLEAR_BI(real);
4449    RBR(real) = bigr;
4450    RTYPE(real) = N_BIGRATIO;
4451    rbr_canonicalize(real);
4452}
4453
4454static INLINE void
4455radd_bi_fr(n_real *real, long num, long den)
4456{
4457    rop_bi_fr_as_xr(real, num, den, NOP_ADD);
4458}
4459
4460static INLINE void
4461rsub_bi_fr(n_real *real, long num, long den)
4462{
4463    rop_bi_fr_as_xr(real, num, den, NOP_SUB);
4464}
4465
4466static INLINE void
4467rmul_bi_fr(n_real *real, long num, long den)
4468{
4469    rop_bi_fr_md_xr(real, num, den, NOP_MUL);
4470}
4471
4472static INLINE void
4473rdiv_bi_fr(n_real *real, long num, long den)
4474{
4475    rop_bi_fr_md_xr(real, num, den, NOP_DIV);
4476}
4477
4478static int
4479cmp_bi_fr(mpi *bignum, long num, long den)
4480{
4481    int cmp;
4482    mpr cmp1, cmp2;
4483
4484    mpr_init(&cmp1);
4485    mpi_set(mpr_num(&cmp1), bignum);
4486    mpi_seti(mpr_den(&cmp1), 1);
4487
4488    mpr_init(&cmp2);
4489    mpr_seti(&cmp2, num, den);
4490
4491    cmp = mpr_cmp(&cmp1, &cmp2);
4492    mpr_clear(&cmp1);
4493    mpr_clear(&cmp2);
4494
4495    return (cmp);
4496}
4497
4498
4499/************************************************************************
4500 * BIGNUM BIGRATIO
4501 ************************************************************************/
4502static void
4503rop_bi_br_as_xr(n_real *real, mpr *bigratio, int nop)
4504{
4505    mpi iop;
4506    mpr *bigr = XALLOC(mpr);
4507
4508    mpi_init(&iop);
4509    mpi_set(&iop, RBI(real));
4510    mpr_init(bigr);
4511    mpr_set(bigr, bigratio);
4512
4513    mpi_mul(&iop, &iop, mpr_den(bigratio));
4514
4515    if (nop == NOP_ADD)
4516	mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
4517    else
4518	mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
4519    mpi_clear(&iop);
4520
4521    RCLEAR_BI(real);
4522    RBR(real) = bigr;
4523    RTYPE(real) = N_BIGRATIO;
4524    rbr_canonicalize(real);
4525}
4526
4527static void
4528rop_bi_br_md_xr(n_real *real, mpr *bigratio, int nop)
4529{
4530    mpr *bigr = XALLOC(mpr);
4531
4532    mpr_init(bigr);
4533    if (nop == NOP_MUL)
4534	mpr_set(bigr, bigratio);
4535    else
4536	mpr_inv(bigr, bigratio);
4537
4538    mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr));
4539
4540    RCLEAR_BI(real);
4541    RBR(real) = bigr;
4542    RTYPE(real) = N_BIGRATIO;
4543    rbr_canonicalize(real);
4544}
4545
4546static INLINE void
4547radd_bi_br(n_real *real, mpr *bigratio)
4548{
4549    rop_bi_br_as_xr(real, bigratio, NOP_ADD);
4550}
4551
4552static INLINE void
4553rsub_bi_br(n_real *real, mpr *bigratio)
4554{
4555    rop_bi_br_as_xr(real, bigratio, NOP_SUB);
4556}
4557
4558static INLINE void
4559rmul_bi_br(n_real *real, mpr *bigratio)
4560{
4561    rop_bi_br_md_xr(real, bigratio, NOP_MUL);
4562}
4563
4564static INLINE void
4565rdiv_bi_br(n_real *real, mpr *bigratio)
4566{
4567    rop_bi_br_md_xr(real, bigratio, NOP_DIV);
4568}
4569
4570static int
4571cmp_bi_br(mpi *bignum, mpr *bigratio)
4572{
4573    int cmp;
4574    mpr cmp1;
4575
4576    mpr_init(&cmp1);
4577    mpi_set(mpr_num(&cmp1), bignum);
4578    mpi_seti(mpr_den(&cmp1), 1);
4579
4580    cmp = mpr_cmp(&cmp1, bigratio);
4581    mpr_clear(&cmp1);
4582
4583    return (cmp);
4584}
4585
4586
4587/************************************************************************
4588 * FIXRATIO FIXNUM
4589 ************************************************************************/
4590static void
4591rop_fr_fi_as_xr(n_real *real, long op, int nop)
4592{
4593    int fit;
4594    long value = 0, num = RFRN(real), den = RFRD(real);
4595
4596    fit = !fi_fi_mul_overflow(op, den);
4597
4598    if (fit) {
4599	value = op * den;
4600	if (nop == NOP_ADD)
4601	    fit = !fi_fi_add_overflow(value, num);
4602	else
4603	    fit = !fi_fi_sub_overflow(value, num);
4604    }
4605    if (fit) {
4606	if (nop == NOP_ADD)
4607	    RFRN(real) = num + value;
4608	else
4609	    RFRN(real) = num - value;
4610	rfr_canonicalize(real);
4611    }
4612    else {
4613	mpi iop;
4614	mpr *bigr = XALLOC(mpr);
4615
4616	mpr_init(bigr);
4617	mpr_seti(bigr, num, den);
4618	mpi_init(&iop);
4619	mpi_seti(&iop, op);
4620	mpi_muli(&iop, &iop, den);
4621	if (nop == NOP_ADD)
4622	    mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
4623	else
4624	    mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
4625	mpi_clear(&iop);
4626	RBR(real) = bigr;
4627	RTYPE(real) = N_BIGRATIO;
4628	rbr_canonicalize(real);
4629    }
4630}
4631
4632static void
4633rop_fr_fi_md_xr(n_real *real, long op, int nop)
4634{
4635    long num = RFRN(real), den = RFRD(real);
4636
4637    if (nop == NOP_MUL) {
4638	if (!fi_fi_mul_overflow(op, num)) {
4639	    RFRN(real) = op * num;
4640	    rfr_canonicalize(real);
4641	    return;
4642	}
4643    }
4644    else if (!fi_fi_mul_overflow(op, den)) {
4645	RFRD(real) = op * den;
4646	rfr_canonicalize(real);
4647	return;
4648    }
4649
4650    {
4651	mpr *bigr = XALLOC(mpr);
4652
4653	mpr_init(bigr);
4654	mpr_seti(bigr, num, den);
4655	if (nop == NOP_MUL)
4656	    mpr_muli(bigr, bigr, op);
4657	else
4658	    mpr_divi(bigr, bigr, op);
4659	RBR(real) = bigr;
4660	RTYPE(real) = N_BIGRATIO;
4661	rbr_canonicalize(real);
4662    }
4663}
4664
4665static INLINE void
4666radd_fr_fi(n_real *real, long op)
4667{
4668    rop_fr_fi_as_xr(real, op, NOP_ADD);
4669}
4670
4671static INLINE void
4672rsub_fr_fi(n_real *real, long op)
4673{
4674    rop_fr_fi_as_xr(real, op, NOP_SUB);
4675}
4676
4677static INLINE void
4678rmul_fr_fi(n_real *real, long op)
4679{
4680    rop_fr_fi_md_xr(real, op, NOP_MUL);
4681}
4682
4683static INLINE void
4684rdiv_fr_fi(n_real *real, long op)
4685{
4686    rop_fr_fi_md_xr(real, op, NOP_DIV);
4687}
4688
4689static INLINE int
4690cmp_fr_fi(long num, long den, long fixnum)
4691{
4692    return (cmp_flonum((double)num / (double)den, (double)fixnum));
4693}
4694
4695
4696/************************************************************************
4697 * FIXRATIO BIGNUM
4698 ************************************************************************/
4699static void
4700rop_fr_bi_as_xr(n_real *real, mpi *bignum, int nop)
4701{
4702    mpi iop;
4703    mpr *bigr = XALLOC(mpr);
4704
4705    mpr_init(bigr);
4706    mpr_seti(bigr, RFRN(real), RFRD(real));
4707
4708    mpi_init(&iop);
4709    mpi_set(&iop, bignum);
4710    mpi_muli(&iop, &iop, RFRD(real));
4711
4712    if (nop == NOP_ADD)
4713	mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
4714    else
4715	mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
4716    mpi_clear(&iop);
4717
4718    RBR(real) = bigr;
4719    RTYPE(real) = N_BIGRATIO;
4720    rbr_canonicalize(real);
4721}
4722
4723static void
4724rop_fr_bi_md_xr(n_real *real, mpi *bignum, int nop)
4725{
4726    mpr *bigr = XALLOC(mpr);
4727
4728    mpr_init(bigr);
4729    mpr_seti(bigr, RFRN(real), RFRD(real));
4730
4731    if (nop == NOP_MUL)
4732	mpi_mul(mpr_num(bigr), mpr_num(bigr), bignum);
4733    else
4734	mpi_mul(mpr_den(bigr), mpr_den(bigr), bignum);
4735
4736    RBR(real) = bigr;
4737    RTYPE(real) = N_BIGRATIO;
4738    rbr_canonicalize(real);
4739}
4740
4741static INLINE void
4742radd_fr_bi(n_real *real, mpi *bignum)
4743{
4744    rop_fr_bi_as_xr(real, bignum, NOP_ADD);
4745}
4746
4747static INLINE void
4748rsub_fr_bi(n_real *real, mpi *bignum)
4749{
4750    rop_fr_bi_as_xr(real, bignum, NOP_SUB);
4751}
4752
4753static INLINE void
4754rmul_fr_bi(n_real *real, mpi *bignum)
4755{
4756    rop_fr_bi_md_xr(real, bignum, NOP_MUL);
4757}
4758
4759static INLINE void
4760rdiv_fr_bi(n_real *real, mpi *bignum)
4761{
4762    rop_fr_bi_md_xr(real, bignum, NOP_DIV);
4763}
4764
4765static int
4766cmp_fr_bi(long num, long den, mpi *bignum)
4767{
4768    int cmp;
4769    mpr cmp1, cmp2;
4770
4771    mpr_init(&cmp1);
4772    mpr_seti(&cmp1, num, den);
4773
4774    mpr_init(&cmp2);
4775    mpi_set(mpr_num(&cmp2), bignum);
4776    mpi_seti(mpr_den(&cmp2), 1);
4777
4778    cmp = mpr_cmp(&cmp1, &cmp2);
4779    mpr_clear(&cmp1);
4780    mpr_clear(&cmp2);
4781
4782    return (cmp);
4783}
4784
4785
4786/************************************************************************
4787 * FIXRATIO FIXRATIO
4788 ************************************************************************/
4789static void
4790rop_fr_fr_as_xr(n_real *real, long num2, long den2, int nop)
4791{
4792    int fit;
4793    long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0;
4794
4795    fit = !fi_fi_mul_overflow(num1, den2);
4796    if (fit) {
4797	num = num1 * den2;
4798	fit = !fi_fi_mul_overflow(num2, den1);
4799	if (fit) {
4800	    den = num2 * den1;
4801	    if (nop == NOP_ADD) {
4802		if ((fit = !fi_fi_add_overflow(num, den)) != 0)
4803		    num += den;
4804	    }
4805	    else if ((fit = !fi_fi_sub_overflow(num, den)) != 0)
4806		num -= den;
4807	    if (fit) {
4808		fit = !fi_fi_mul_overflow(den1, den2);
4809		if (fit)
4810		    den = den1 * den2;
4811	    }
4812	}
4813    }
4814    if (fit) {
4815	RFRN(real) = num;
4816	RFRD(real) = den;
4817	rfr_canonicalize(real);
4818    }
4819    else {
4820	mpi iop;
4821	mpr *bigr = XALLOC(mpr);
4822
4823	mpr_init(bigr);
4824	mpr_seti(bigr, num1, den1);
4825	mpi_muli(mpr_den(bigr), mpr_den(bigr), den2);
4826	mpi_init(&iop);
4827	mpi_seti(&iop, num2);
4828	mpi_muli(&iop, &iop, den1);
4829	mpi_muli(mpr_num(bigr), mpr_num(bigr), den2);
4830	if (nop == NOP_ADD)
4831	    mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
4832	else
4833	    mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
4834	mpi_clear(&iop);
4835	RBR(real) = bigr;
4836	RTYPE(real) = N_BIGRATIO;
4837	rbr_canonicalize(real);
4838    }
4839}
4840
4841static void
4842rop_fr_fr_md_xr(n_real *real, long num2, long den2, int nop)
4843{
4844    int fit;
4845    long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0;
4846
4847    if (nop == NOP_MUL) {
4848	fit = !fi_fi_mul_overflow(num1, num2) && !fi_fi_mul_overflow(den1, den2);
4849	if (fit) {
4850	    num = num1 * num2;
4851	    den = den1 * den2;
4852	}
4853    }
4854    else {
4855	fit = !fi_fi_mul_overflow(num1, den2) && !fi_fi_mul_overflow(den1, num2);
4856	if (fit) {
4857	    num = num1 * den2;
4858	    den = den1 * num2;
4859	}
4860    }
4861
4862    if (fit) {
4863	RFRN(real) = num;
4864	RFRD(real) = den;
4865	rfr_canonicalize(real);
4866    }
4867    else {
4868	mpr *bigr = XALLOC(mpr);
4869
4870	mpr_init(bigr);
4871
4872	if (nop == NOP_MUL) {
4873	    mpr_seti(bigr, num1, den1);
4874	    mpi_muli(mpr_num(bigr), mpr_num(bigr), num2);
4875	    mpi_muli(mpr_den(bigr), mpr_den(bigr), den2);
4876	}
4877	else {
4878	    mpr_seti(bigr, num1, num2);
4879	    mpi_muli(mpr_num(bigr), mpr_num(bigr), den2);
4880	    mpi_muli(mpr_den(bigr), mpr_den(bigr), den1);
4881	}
4882
4883	RBR(real) = bigr;
4884	RTYPE(real) = N_BIGRATIO;
4885	rbr_canonicalize(real);
4886    }
4887}
4888
4889static INLINE void
4890radd_fr_fr(n_real *real, long num, long den)
4891{
4892    rop_fr_fr_as_xr(real, num, den, NOP_ADD);
4893}
4894
4895static INLINE void
4896rsub_fr_fr(n_real *real, long num, long den)
4897{
4898    rop_fr_fr_as_xr(real, num, den, NOP_SUB);
4899}
4900
4901static INLINE void
4902rmul_fr_fr(n_real *real, long num, long den)
4903{
4904    rop_fr_fr_md_xr(real, num, den, NOP_MUL);
4905}
4906
4907static INLINE void
4908rdiv_fr_fr(n_real *real, long num, long den)
4909{
4910    rop_fr_fr_md_xr(real, num, den, NOP_DIV);
4911}
4912
4913static INLINE int
4914cmp_fr_fr(long num1, long den1, long num2, long den2)
4915{
4916    return (cmp_flonum((double)num1 / (double)den1,
4917		       (double)num2 / (double)den2));
4918}
4919
4920
4921/************************************************************************
4922 * FIXRATIO BIGRATIO
4923 ************************************************************************/
4924static void
4925rop_fr_br_asmd_xr(n_real *real, mpr *bigratio, int nop)
4926{
4927    mpr *bigr = XALLOC(mpr);
4928
4929    mpr_init(bigr);
4930    mpr_seti(bigr, RFRN(real), RFRD(real));
4931
4932    switch (nop) {
4933	case NOP_ADD:
4934	    mpr_add(bigr, bigr, bigratio);
4935	    break;
4936	case NOP_SUB:
4937	    mpr_sub(bigr, bigr, bigratio);
4938	    break;
4939	case NOP_MUL:
4940	    mpr_mul(bigr, bigr, bigratio);
4941	    break;
4942	default:
4943	    mpr_div(bigr, bigr, bigratio);
4944	    break;
4945    }
4946
4947    RBR(real) = bigr;
4948    RTYPE(real) = N_BIGRATIO;
4949    rbr_canonicalize(real);
4950}
4951
4952static INLINE void
4953radd_fr_br(n_real *real, mpr *bigratio)
4954{
4955    rop_fr_br_asmd_xr(real, bigratio, NOP_ADD);
4956}
4957
4958static INLINE void
4959rsub_fr_br(n_real *real, mpr *bigratio)
4960{
4961    rop_fr_br_asmd_xr(real, bigratio, NOP_SUB);
4962}
4963
4964static INLINE void
4965rmul_fr_br(n_real *real, mpr *bigratio)
4966{
4967    rop_fr_br_asmd_xr(real, bigratio, NOP_MUL);
4968}
4969
4970static INLINE void
4971rdiv_fr_br(n_real *real, mpr *bigratio)
4972{
4973    rop_fr_br_asmd_xr(real, bigratio, NOP_DIV);
4974}
4975
4976static int
4977cmp_fr_br(long num, long den, mpr *bigratio)
4978{
4979    int cmp;
4980    mpr cmp1;
4981
4982    mpr_init(&cmp1);
4983    mpr_seti(&cmp1, num, den);
4984
4985    cmp = mpr_cmp(&cmp1, bigratio);
4986    mpr_clear(&cmp1);
4987
4988    return (cmp);
4989}
4990
4991
4992/************************************************************************
4993 * BIGRATIO FIXNUM
4994 ************************************************************************/
4995static void
4996rop_br_fi_asmd_xr(n_real *real, long fixnum, int nop)
4997{
4998    mpr *bigratio = RBR(real);
4999
5000    switch (nop) {
5001	case NOP_ADD:
5002	    mpr_addi(bigratio, bigratio, fixnum);
5003	    break;
5004	case NOP_SUB:
5005	    mpr_subi(bigratio, bigratio, fixnum);
5006	    break;
5007	case NOP_MUL:
5008	    mpr_muli(bigratio, bigratio, fixnum);
5009	    break;
5010	default:
5011	    if (fixnum == 0)
5012		fatal_error(DIVIDE_BY_ZERO);
5013	    mpr_divi(bigratio, bigratio, fixnum);
5014	    break;
5015    }
5016    rbr_canonicalize(real);
5017}
5018
5019static INLINE void
5020radd_br_fi(n_real *real, long fixnum)
5021{
5022    rop_br_fi_asmd_xr(real, fixnum, NOP_ADD);
5023}
5024
5025static INLINE void
5026rsub_br_fi(n_real *real, long fixnum)
5027{
5028    rop_br_fi_asmd_xr(real, fixnum, NOP_SUB);
5029}
5030
5031static INLINE void
5032rmul_br_fi(n_real *real, long fixnum)
5033{
5034    rop_br_fi_asmd_xr(real, fixnum, NOP_MUL);
5035}
5036
5037static INLINE void
5038rdiv_br_fi(n_real *real, long fixnum)
5039{
5040    rop_br_fi_asmd_xr(real, fixnum, NOP_DIV);
5041}
5042
5043static int
5044cmp_br_fi(mpr *bigratio, long fixnum)
5045{
5046    int cmp;
5047    mpr cmp2;
5048
5049    mpr_init(&cmp2);
5050    mpr_seti(&cmp2, fixnum, 1);
5051    cmp = mpr_cmp(bigratio, &cmp2);
5052    mpr_clear(&cmp2);
5053
5054    return (cmp);
5055}
5056
5057
5058/************************************************************************
5059 * BIGRATIO BIGNUM
5060 ************************************************************************/
5061static void
5062rop_br_bi_as_xr(n_real *real, mpi *bignum, int nop)
5063{
5064    mpi iop;
5065
5066    mpi_init(&iop);
5067    mpi_set(&iop, bignum);
5068
5069    mpi_mul(&iop, &iop, RBRD(real));
5070    if (nop == NOP_ADD)
5071	mpi_add(RBRN(real), RBRN(real), &iop);
5072    else
5073	mpi_sub(RBRN(real), RBRN(real), &iop);
5074    mpi_clear(&iop);
5075    rbr_canonicalize(real);
5076}
5077
5078static INLINE void
5079radd_br_bi(n_real *real, mpi *bignum)
5080{
5081    rop_br_bi_as_xr(real, bignum, NOP_ADD);
5082}
5083
5084static INLINE void
5085rsub_br_bi(n_real *real, mpi *bignum)
5086{
5087    rop_br_bi_as_xr(real, bignum, NOP_SUB);
5088}
5089
5090static INLINE void
5091rmul_br_bi(n_real *real, mpi *bignum)
5092{
5093    mpi_mul(RBRN(real), RBRN(real), bignum);
5094    rbr_canonicalize(real);
5095}
5096
5097static INLINE void
5098rdiv_br_bi(n_real *real, mpi *bignum)
5099{
5100    mpi_mul(RBRD(real), RBRD(real), bignum);
5101    rbr_canonicalize(real);
5102}
5103
5104static int
5105cmp_br_bi(mpr *bigratio, mpi *bignum)
5106{
5107    int cmp;
5108    mpr cmp1;
5109
5110    mpr_init(&cmp1);
5111    mpi_set(mpr_num(&cmp1), bignum);
5112    mpi_seti(mpr_den(&cmp1), 1);
5113
5114    cmp = mpr_cmp(bigratio, &cmp1);
5115    mpr_clear(&cmp1);
5116
5117    return (cmp);
5118}
5119
5120
5121/************************************************************************
5122 * BIGRATIO FIXRATIO
5123 ************************************************************************/
5124static void
5125rop_br_fr_asmd_xr(n_real *real, long num, long den, int nop)
5126{
5127    mpr *bigratio = RBR(real), rop;
5128
5129    mpr_init(&rop);
5130    mpr_seti(&rop, num, den);
5131    switch (nop) {
5132	case NOP_ADD:
5133	    mpr_add(bigratio, bigratio, &rop);
5134	    break;
5135	case NOP_SUB:
5136	    mpr_sub(bigratio, bigratio, &rop);
5137	    break;
5138	case NOP_MUL:
5139	    mpr_mul(bigratio, bigratio, &rop);
5140	    break;
5141	default:
5142	    mpr_div(bigratio, bigratio, &rop);
5143	    break;
5144    }
5145    mpr_clear(&rop);
5146    rbr_canonicalize(real);
5147}
5148
5149static INLINE void
5150radd_br_fr(n_real *real, long num, long den)
5151{
5152    rop_br_fr_asmd_xr(real, num, den, NOP_ADD);
5153}
5154
5155static INLINE void
5156rsub_br_fr(n_real *real, long num, long den)
5157{
5158    rop_br_fr_asmd_xr(real, num, den, NOP_SUB);
5159}
5160
5161static INLINE void
5162rmul_br_fr(n_real *real, long num, long den)
5163{
5164    rop_br_fr_asmd_xr(real, num, den, NOP_MUL);
5165}
5166
5167static INLINE void
5168rdiv_br_fr(n_real *real, long num, long den)
5169{
5170    rop_br_fr_asmd_xr(real, num, den, NOP_DIV);
5171}
5172
5173static int
5174cmp_br_fr(mpr *bigratio, long num, long den)
5175{
5176    int cmp;
5177    mpr cmp2;
5178
5179    mpr_init(&cmp2);
5180    mpr_seti(&cmp2, num, den);
5181    cmp = mpr_cmp(bigratio, &cmp2);
5182    mpr_clear(&cmp2);
5183
5184    return (cmp);
5185}
5186
5187
5188/************************************************************************
5189 * BIGRATIO BIGRATIO
5190 ************************************************************************/
5191static INLINE void
5192radd_br_br(n_real *real, mpr *bigratio)
5193{
5194    mpr_add(RBR(real), RBR(real), bigratio);
5195    rbr_canonicalize(real);
5196}
5197
5198static INLINE void
5199rsub_br_br(n_real *real, mpr *bigratio)
5200{
5201    mpr_sub(RBR(real), RBR(real), bigratio);
5202    rbr_canonicalize(real);
5203}
5204
5205static INLINE void
5206rmul_br_br(n_real *real, mpr *bigratio)
5207{
5208    mpr_mul(RBR(real), RBR(real), bigratio);
5209    rbr_canonicalize(real);
5210}
5211
5212static INLINE void
5213rdiv_br_br(n_real *real, mpr *bigratio)
5214{
5215    mpr_div(RBR(real), RBR(real), bigratio);
5216    rbr_canonicalize(real);
5217}
5218
5219static INLINE int
5220cmp_br_br(mpr *op1, mpr *op2)
5221{
5222    return (mpr_cmp(op1, op2));
5223}
5224