math.c revision 5dfecf96 
1/*
2 * Copyright (c) 2001 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/math.c,v 1.23tsi Exp $ */
31
32#include "lisp/math.h"
33#include "lisp/private.h"
34
35#ifdef __UNIXOS2__
36# define finite(x) isfinite(x)
37#endif
38
39/*
40 * Prototypes
41 */
42static LispObj *LispDivide(LispBuiltin*, int, int);
43
44/*
45 * Initialization
46 */
47static LispObj *obj_zero, *obj_one;
48LispObj *Ocomplex, *Oequal_;
49
50LispObj *Oshort_float, *Osingle_float, *Odouble_float, *Olong_float;
51
52Atom_id Sdefault_float_format;
53
54/*
55 * Implementation
56 */
57#include "lisp/mathimp.c"
58
59void
60LispMathInit(void)
61{
62    LispObj *object, *result;
63
64    mp_set_malloc(LispMalloc);
65    mp_set_calloc(LispCalloc);
66    mp_set_realloc(LispRealloc);
67    mp_set_free(LispFree);
68
69    number_init();
70    obj_zero = FIXNUM(0);
71    obj_one = FIXNUM(1);
72
73    Oequal_		= STATIC_ATOM("=");
74    Ocomplex		= STATIC_ATOM(Scomplex);
75    Oshort_float	= STATIC_ATOM("SHORT-FLOAT");
76    LispExportSymbol(Oshort_float);
77    Osingle_float	= STATIC_ATOM("SINGLE-FLOAT");
78    LispExportSymbol(Osingle_float);
79    Odouble_float	= STATIC_ATOM("DOUBLE-FLOAT");
80    LispExportSymbol(Odouble_float);
81    Olong_float		= STATIC_ATOM("LONG-FLOAT");
82    LispExportSymbol(Olong_float);
83
84    object		= STATIC_ATOM("*DEFAULT-FLOAT-FORMAT*");
85    LispProclaimSpecial(object, Odouble_float, NIL);
86    LispExportSymbol(object);
87    Sdefault_float_format = ATOMID(object);
88
89    object		= STATIC_ATOM("PI");
90    result = number_pi();
91    LispProclaimSpecial(object, result, NIL);
92    LispExportSymbol(object);
93
94    object		= STATIC_ATOM("MOST-POSITIVE-FIXNUM");
95    LispDefconstant(object, FIXNUM(MOST_POSITIVE_FIXNUM), NIL);
96    LispExportSymbol(object);
97
98    object		= STATIC_ATOM("MOST-NEGATIVE-FIXNUM");
99    LispDefconstant(object, FIXNUM(MOST_NEGATIVE_FIXNUM), NIL);
100    LispExportSymbol(object);
101}
102
103LispObj *
104Lisp_Mul(LispBuiltin *builtin)
105/*
106 * &rest numbers
107 */
108{
109    n_number num;
110    LispObj *number, *numbers;
111
112    numbers = ARGUMENT(0);
113
114    if (CONSP(numbers)) {
115	number = CAR(numbers);
116
117	numbers = CDR(numbers);
118	if (!CONSP(numbers)) {
119	    CHECK_NUMBER(number);
120	    return (number);
121	}
122    }
123    else
124	return (FIXNUM(1));
125
126    set_number_object(&num, number);
127    do {
128	mul_number_object(&num, CAR(numbers));
129	numbers = CDR(numbers);
130    } while (CONSP(numbers));
131
132    return (make_number_object(&num));
133}
134
135LispObj *
136Lisp_Plus(LispBuiltin *builtin)
137/*
138 + &rest numbers
139 */
140{
141    n_number num;
142    LispObj *number, *numbers;
143
144    numbers = ARGUMENT(0);
145
146    if (CONSP(numbers)) {
147	number = CAR(numbers);
148
149	numbers = CDR(numbers);
150	if (!CONSP(numbers)) {
151	    CHECK_NUMBER(number);
152	    return (number);
153	}
154    }
155    else
156	return (FIXNUM(0));
157
158    set_number_object(&num, number);
159    do {
160	add_number_object(&num, CAR(numbers));
161	numbers = CDR(numbers);
162    } while (CONSP(numbers));
163
164    return (make_number_object(&num));
165}
166
167LispObj *
168Lisp_Minus(LispBuiltin *builtin)
169/*
170 - number &rest more_numbers
171 */
172{
173    n_number num;
174    LispObj *number, *more_numbers;
175
176    more_numbers = ARGUMENT(1);
177    number = ARGUMENT(0);
178
179    set_number_object(&num, number);
180    if (!CONSP(more_numbers)) {
181	neg_number(&num);
182
183	return (make_number_object(&num));
184    }
185    do {
186	sub_number_object(&num, CAR(more_numbers));
187	more_numbers = CDR(more_numbers);
188    } while (CONSP(more_numbers));
189
190    return (make_number_object(&num));
191}
192
193LispObj *
194Lisp_Div(LispBuiltin *builtin)
195/*
196 / number &rest more_numbers
197 */
198{
199    n_number num;
200    LispObj *number, *more_numbers;
201
202    more_numbers = ARGUMENT(1);
203    number = ARGUMENT(0);
204
205    if (CONSP(more_numbers))
206	set_number_object(&num, number);
207    else {
208	num.complex = 0;
209	num.real.type = N_FIXNUM;
210	num.real.data.fixnum = 1;
211	goto div_one_argument;
212    }
213
214    for (;;) {
215	number = CAR(more_numbers);
216	more_numbers = CDR(more_numbers);
217
218div_one_argument:
219	div_number_object(&num, number);
220	if (!CONSP(more_numbers))
221	    break;
222    }
223
224    return (make_number_object(&num));
225}
226
227LispObj *
228Lisp_OnePlus(LispBuiltin *builtin)
229/*
230 1+ number
231 */
232{
233    n_number num;
234    LispObj *number;
235
236    number = ARGUMENT(0);
237    num.complex = 0;
238    num.real.type = N_FIXNUM;
239    num.real.data.fixnum = 1;
240    add_number_object(&num, number);
241
242    return (make_number_object(&num));
243}
244
245LispObj *
246Lisp_OneMinus(LispBuiltin *builtin)
247/*
248 1- number
249 */
250{
251    n_number num;
252    LispObj *number;
253
254    number = ARGUMENT(0);
255    num.complex = 0;
256    num.real.type = N_FIXNUM;
257    num.real.data.fixnum = -1;
258    add_number_object(&num, number);
259
260    return (make_number_object(&num));
261}
262
263LispObj *
264Lisp_Less(LispBuiltin *builtin)
265/*
266 < number &rest more-numbers
267 */
268{
269    LispObj *compare, *number, *more_numbers;
270
271    more_numbers = ARGUMENT(1);
272    compare = ARGUMENT(0);
273
274    if (CONSP(more_numbers)) {
275	do {
276	    number = CAR(more_numbers);
277	    if (cmp_object_object(compare, number, 1) >= 0)
278		return (NIL);
279	    compare = number;
280	    more_numbers = CDR(more_numbers);
281	} while (CONSP(more_numbers));
282    }
283    else {
284	CHECK_REAL(compare);
285    }
286
287    return (T);
288}
289
290LispObj *
291Lisp_LessEqual(LispBuiltin *builtin)
292/*
293 <= number &rest more-numbers
294 */
295{
296    LispObj *compare, *number, *more_numbers;
297
298    more_numbers = ARGUMENT(1);
299    compare = ARGUMENT(0);
300
301    if (CONSP(more_numbers)) {
302	do {
303	    number = CAR(more_numbers);
304	    if (cmp_object_object(compare, number, 1) > 0)
305		return (NIL);
306	    compare = number;
307	    more_numbers = CDR(more_numbers);
308	} while (CONSP(more_numbers));
309    }
310    else {
311	CHECK_REAL(compare);
312    }
313
314    return (T);
315}
316
317LispObj *
318Lisp_Equal_(LispBuiltin *builtin)
319/*
320 = number &rest more-numbers
321 */
322{
323    LispObj *compare, *number, *more_numbers;
324
325    more_numbers = ARGUMENT(1);
326    compare = ARGUMENT(0);
327
328    if (CONSP(more_numbers)) {
329	do {
330	    number = CAR(more_numbers);
331	    if (cmp_object_object(compare, number, 0) != 0)
332		return (NIL);
333	    compare = number;
334	    more_numbers = CDR(more_numbers);
335	} while (CONSP(more_numbers));
336    }
337    else {
338	CHECK_REAL(compare);
339    }
340
341    return (T);
342}
343
344LispObj *
345Lisp_Greater(LispBuiltin *builtin)
346/*
347 > number &rest more-numbers
348 */
349{
350    LispObj *compare, *number, *more_numbers;
351
352    more_numbers = ARGUMENT(1);
353    compare = ARGUMENT(0);
354
355    if (CONSP(more_numbers)) {
356	do {
357	    number = CAR(more_numbers);
358	    if (cmp_object_object(compare, number, 1) <= 0)
359		return (NIL);
360	    compare = number;
361	    more_numbers = CDR(more_numbers);
362	} while (CONSP(more_numbers));
363    }
364    else {
365	CHECK_REAL(compare);
366    }
367
368    return (T);
369}
370
371LispObj *
372Lisp_GreaterEqual(LispBuiltin *builtin)
373/*
374 >= number &rest more-numbers
375 */
376{
377    LispObj *compare, *number, *more_numbers;
378
379    more_numbers = ARGUMENT(1);
380    compare = ARGUMENT(0);
381
382    if (CONSP(more_numbers)) {
383	do {
384	    number = CAR(more_numbers);
385	    if (cmp_object_object(compare, number, 1) < 0)
386		return (NIL);
387	    compare = number;
388	    more_numbers = CDR(more_numbers);
389	} while (CONSP(more_numbers));
390    }
391    else {
392	CHECK_REAL(compare);
393    }
394
395    return (T);
396}
397
398LispObj *
399Lisp_NotEqual(LispBuiltin *builtin)
400/*
401 /= number &rest more-numbers
402 */
403{
404    LispObj *object, *compare, *number, *more_numbers;
405
406    more_numbers = ARGUMENT(1);
407    number = ARGUMENT(0);
408
409    if (!CONSP(more_numbers)) {
410	CHECK_REAL(number);
411
412	return (T);
413    }
414
415    /* compare all numbers */
416    while (1) {
417	compare = number;
418	for (object = more_numbers; CONSP(object); object = CDR(object)) {
419	    number = CAR(object);
420
421	    if (cmp_object_object(compare, number, 0) == 0)
422		return (NIL);
423	}
424	if (CONSP(more_numbers)) {
425	    number = CAR(more_numbers);
426	    more_numbers = CDR(more_numbers);
427	}
428	else
429	    break;
430    }
431
432    return (T);
433}
434
435LispObj *
436Lisp_Min(LispBuiltin *builtin)
437/*
438 min number &rest more-numbers
439 */
440{
441    LispObj *result, *number, *more_numbers;
442
443    more_numbers = ARGUMENT(1);
444    result = ARGUMENT(0);
445
446    if (CONSP(more_numbers)) {
447	do {
448	    number = CAR(more_numbers);
449	    if (cmp_object_object(result, number, 1) > 0)
450		result = number;
451	    more_numbers = CDR(more_numbers);
452	} while (CONSP(more_numbers));
453    }
454    else {
455	CHECK_REAL(result);
456    }
457
458    return (result);
459}
460
461LispObj *
462Lisp_Max(LispBuiltin *builtin)
463/*
464 max number &rest more-numbers
465 */
466{
467    LispObj *result, *number, *more_numbers;
468
469    more_numbers = ARGUMENT(1);
470    result = ARGUMENT(0);
471
472    if (CONSP(more_numbers)) {
473	do {
474	    number = CAR(more_numbers);
475	    if (cmp_object_object(result, number, 1) < 0)
476		result = number;
477	    more_numbers = CDR(more_numbers);
478	} while (CONSP(more_numbers));
479    }
480    else {
481	CHECK_REAL(result);
482    }
483
484    return (result);
485}
486
487LispObj *
488Lisp_Abs(LispBuiltin *builtin)
489/*
490 abs number
491 */
492{
493    LispObj *result, *number;
494
495    result = number = ARGUMENT(0);
496
497    switch (OBJECT_TYPE(number)) {
498	case LispFixnum_t:
499	case LispInteger_t:
500	case LispBignum_t:
501	case LispDFloat_t:
502	case LispRatio_t:
503	case LispBigratio_t:
504	    if (cmp_real_object(&zero, number) > 0) {
505		n_real real;
506
507		set_real_object(&real, number);
508		neg_real(&real);
509		result = make_real_object(&real);
510	    }
511	    break;
512	case LispComplex_t: {
513	    n_number num;
514
515	    set_number_object(&num, number);
516	    abs_number(&num);
517	    result = make_number_object(&num);
518	}   break;
519	default:
520	    fatal_builtin_object_error(builtin, number, NOT_A_NUMBER);
521	    break;
522    }
523
524    return (result);
525}
526
527LispObj *
528Lisp_Complex(LispBuiltin *builtin)
529/*
530 complex realpart &optional imagpart
531 */
532{
533    LispObj *realpart, *imagpart;
534
535    imagpart = ARGUMENT(1);
536    realpart = ARGUMENT(0);
537
538    CHECK_REAL(realpart);
539
540    if (imagpart == UNSPEC)
541	return (realpart);
542    else {
543	CHECK_REAL(imagpart);
544    }
545    if (!FLOATP(imagpart) && cmp_real_object(&zero, imagpart) == 0)
546	return (realpart);
547
548    return (COMPLEX(realpart, imagpart));
549}
550
551LispObj *
552Lisp_Complexp(LispBuiltin *builtin)
553/*
554 complexp object
555 */
556{
557    LispObj *object;
558
559    object = ARGUMENT(0);
560
561    return (COMPLEXP(object) ? T : NIL);
562}
563
564LispObj *
565Lisp_Conjugate(LispBuiltin *builtin)
566/*
567 conjugate number
568 */
569{
570    n_number num;
571    LispObj *number, *realpart, *imagpart;
572
573    number = ARGUMENT(0);
574
575    CHECK_NUMBER(number);
576
577    if (REALP(number))
578	return (number);
579
580    realpart = OCXR(number);
581    num.complex = 0;
582    num.real.type = N_FIXNUM;
583    num.real.data.fixnum = -1;
584    mul_number_object(&num, OCXI(number));
585    imagpart = make_number_object(&num);
586
587    return (COMPLEX(realpart, imagpart));
588}
589
590LispObj *
591Lisp_Decf(LispBuiltin *builtin)
592/*
593 decf place &optional delta
594 */
595{
596    n_number num;
597    LispObj *place, *delta, *number;
598
599    delta = ARGUMENT(1);
600    place = ARGUMENT(0);
601
602    if (SYMBOLP(place)) {
603	number = LispGetVar(place);
604	if (number == NULL)
605	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
606    }
607    else
608	number = EVAL(place);
609
610    if (delta != UNSPEC) {
611	LispObj *operand;
612
613	operand = EVAL(delta);
614	set_number_object(&num, number);
615	sub_number_object(&num, operand);
616	number = make_number_object(&num);
617    }
618    else {
619	num.complex = 0;
620	num.real.type = N_FIXNUM;
621	num.real.data.fixnum = -1;
622	add_number_object(&num, number);
623	number = make_number_object(&num);
624    }
625
626    if (SYMBOLP(place)) {
627	CHECK_CONSTANT(place);
628	LispSetVar(place, number);
629    }
630    else {
631	GC_ENTER();
632
633	GC_PROTECT(number);
634	(void)APPLY2(Osetf, place, number);
635	GC_LEAVE();
636    }
637
638    return (number);
639}
640
641LispObj *
642Lisp_Denominator(LispBuiltin *builtin)
643/*
644 denominator rational
645 */
646{
647    LispObj *result, *rational;
648
649    rational = ARGUMENT(0);
650
651    switch (OBJECT_TYPE(rational)) {
652	case LispFixnum_t:
653	case LispInteger_t:
654	case LispBignum_t:
655	    result = FIXNUM(1);
656	    break;
657	case LispRatio_t:
658	    result = INTEGER(OFRD(rational));
659	    break;
660	case LispBigratio_t:
661	    if (mpi_fiti(OBRD(rational)))
662		result = INTEGER(mpi_geti(OBRD(rational)));
663	    else {
664		mpi *den = XALLOC(mpi);
665
666		mpi_init(den);
667		mpi_set(den, OBRD(rational));
668		result = BIGNUM(den);
669	    }
670	    break;
671	default:
672	    LispDestroy("%s: %s is not a rational number",
673			STRFUN(builtin), STROBJ(rational));
674	    /*NOTREACHED*/
675	    result = NIL;
676    }
677
678    return (result);
679}
680
681LispObj *
682Lisp_Evenp(LispBuiltin *builtin)
683/*
684 evenp integer
685 */
686{
687    LispObj *result, *integer;
688
689    integer = ARGUMENT(0);
690
691    switch (OBJECT_TYPE(integer)) {
692	case LispFixnum_t:
693	    result = FIXNUM_VALUE(integer) % 2 ? NIL : T;
694	    break;
695	case LispInteger_t:
696	    result = INT_VALUE(integer) % 2 ? NIL : T;
697	    break;
698	case LispBignum_t:
699	    result = mpi_remi(OBI(integer), 2) ? NIL : T;
700	    break;
701	default:
702	    fatal_builtin_object_error(builtin, integer, NOT_AN_INTEGER);
703	    /*NOTREACHED*/
704	    result = NIL;
705    }
706
707    return (result);
708}
709
710/* only one float format */
711LispObj *
712Lisp_Float(LispBuiltin *builtin)
713/*
714 float number &optional other
715 */
716{
717    LispObj *number, *other;
718
719    other = ARGUMENT(1);
720    number = ARGUMENT(0);
721
722    if (other != UNSPEC) {
723	CHECK_DFLOAT(other);
724    }
725
726    return (LispFloatCoerce(builtin, number));
727}
728
729LispObj *
730LispFloatCoerce(LispBuiltin *builtin, LispObj *number)
731{
732    double value;
733
734    switch (OBJECT_TYPE(number)) {
735	case LispFixnum_t:
736	    value = FIXNUM_VALUE(number);
737	    break;
738	case LispInteger_t:
739	    value = INT_VALUE(number);
740	    break;
741	case LispBignum_t:
742	    value = mpi_getd(OBI(number));
743	    break;
744	case LispDFloat_t:
745	    return (number);
746	case LispRatio_t:
747	    value = (double)OFRN(number) / (double)OFRD(number);
748	    break;
749	case LispBigratio_t:
750	    value = mpr_getd(OBR(number));
751	    break;
752	default:
753	    value = 0.0;
754	    fatal_builtin_object_error(builtin, number, NOT_A_REAL_NUMBER);
755	    break;
756    }
757
758    if (!finite(value))
759	fatal_error(FLOATING_POINT_OVERFLOW);
760
761    return (DFLOAT(value));
762}
763
764LispObj *
765Lisp_Floatp(LispBuiltin *builtin)
766/*
767 floatp object
768 */
769{
770    LispObj *object;
771
772    object = ARGUMENT(0);
773
774    return (FLOATP(object) ? T : NIL);
775}
776
777LispObj *
778Lisp_Gcd(LispBuiltin *builtin)
779/*
780 gcd &rest integers
781 */
782{
783    n_real real;
784    LispObj *integers, *integer, *operand;
785
786    integers = ARGUMENT(0);
787
788    if (!CONSP(integers))
789	return (FIXNUM(0));
790
791    integer = CAR(integers);
792
793    CHECK_INTEGER(integer);
794    set_real_object(&real, integer);
795    integers = CDR(integers);
796
797    for (; CONSP(integers); integers = CDR(integers)) {
798	operand = CAR(integers);
799	gcd_real_object(&real, operand);
800    }
801    abs_real(&real);
802
803    return (make_real_object(&real));
804}
805
806LispObj *
807Lisp_Imagpart(LispBuiltin *builtin)
808/*
809 imagpart number
810 */
811{
812    LispObj *number;
813
814    number = ARGUMENT(0);
815
816    if (COMPLEXP(number))
817	return (OCXI(number));
818    else {
819	CHECK_REAL(number);
820    }
821
822    return (FIXNUM(0));
823}
824
825LispObj *
826Lisp_Incf(LispBuiltin *builtin)
827/*
828 incf place &optional delta
829 */
830{
831    n_number num;
832    LispObj *place, *delta, *number;
833
834    delta = ARGUMENT(1);
835    place = ARGUMENT(0);
836
837    if (SYMBOLP(place)) {
838	number = LispGetVar(place);
839	if (number == NULL)
840	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
841    }
842    else
843	number = EVAL(place);
844
845    if (delta != UNSPEC) {
846	LispObj *operand;
847
848	operand = EVAL(delta);
849	set_number_object(&num, number);
850	add_number_object(&num, operand);
851	number = make_number_object(&num);
852    }
853    else {
854	num.complex = 0;
855	num.real.type = N_FIXNUM;
856	num.real.data.fixnum = 1;
857	add_number_object(&num, number);
858	number = make_number_object(&num);
859    }
860
861    if (SYMBOLP(place)) {
862	CHECK_CONSTANT(place);
863	LispSetVar(place, number);
864    }
865    else {
866	GC_ENTER();
867
868	GC_PROTECT(number);
869	(void)APPLY2(Osetf, place, number);
870	GC_LEAVE();
871    }
872
873    return (number);
874}
875
876LispObj *
877Lisp_Integerp(LispBuiltin *builtin)
878/*
879 integerp object
880 */
881{
882    LispObj *object;
883
884    object = ARGUMENT(0);
885
886    return (INTEGERP(object) ? T : NIL);
887}
888
889LispObj *
890Lisp_Isqrt(LispBuiltin *builtin)
891/*
892 isqrt natural
893 */
894{
895    LispObj *natural, *result;
896
897    natural = ARGUMENT(0);
898
899    if (cmp_object_object(natural, obj_zero, 1) < 0)
900	goto not_a_natural_number;
901
902    switch (OBJECT_TYPE(natural)) {
903	case LispFixnum_t:
904	    result = FIXNUM((long)floor(sqrt(FIXNUM_VALUE(natural))));
905	    break;
906	case LispInteger_t:
907	    result = INTEGER((long)floor(sqrt(INT_VALUE(natural))));
908	    break;
909	case LispBignum_t: {
910	    mpi *bigi;
911
912	    bigi = XALLOC(mpi);
913	    mpi_init(bigi);
914	    mpi_sqrt(bigi, OBI(natural));
915	    if (mpi_fiti(bigi)) {
916		result = INTEGER(mpi_geti(bigi));
917		mpi_clear(bigi);
918		XFREE(bigi);
919	    }
920	    else
921		result = BIGNUM(bigi);
922	}   break;
923	default:
924	    goto not_a_natural_number;
925    }
926
927    return (result);
928
929not_a_natural_number:
930    LispDestroy("%s: %s is not a natural number",
931		STRFUN(builtin), STROBJ(natural));
932    /*NOTREACHED*/
933    return (NIL);
934}
935
936LispObj *
937Lisp_Lcm(LispBuiltin *builtin)
938/*
939 lcm &rest integers
940 */
941{
942    n_real real, gcd;
943    LispObj *integers, *operand;
944
945    integers = ARGUMENT(0);
946
947    if (!CONSP(integers))
948	return (FIXNUM(1));
949
950    operand = CAR(integers);
951
952    CHECK_INTEGER(operand);
953    set_real_object(&real, operand);
954    integers = CDR(integers);
955
956    gcd.type = N_FIXNUM;
957    gcd.data.fixnum = 0;
958
959    for (; CONSP(integers); integers = CDR(integers)) {
960	operand = CAR(integers);
961
962	if (real.type == N_FIXNUM && real.data.fixnum == 0)
963	    break;
964
965	/* calculate gcd before changing integer */
966	clear_real(&gcd);
967	set_real_real(&gcd, &real);
968	gcd_real_object(&gcd, operand);
969
970	/* calculate lcm */
971	mul_real_object(&real, operand);
972	div_real_real(&real, &gcd);
973    }
974    clear_real(&gcd);
975    abs_real(&real);
976
977    return (make_real_object(&real));
978}
979
980LispObj *
981Lisp_Logand(LispBuiltin *builtin)
982/*
983 logand &rest integers
984 */
985{
986    n_real real;
987
988    LispObj *integers;
989
990    integers = ARGUMENT(0);
991
992    real.type = N_FIXNUM;
993    real.data.fixnum = -1;
994
995    for (; CONSP(integers); integers = CDR(integers))
996	and_real_object(&real, CAR(integers));
997
998    return (make_real_object(&real));
999}
1000
1001LispObj *
1002Lisp_Logeqv(LispBuiltin *builtin)
1003/*
1004 logeqv &rest integers
1005 */
1006{
1007    n_real real;
1008
1009    LispObj *integers;
1010
1011    integers = ARGUMENT(0);
1012
1013    real.type = N_FIXNUM;
1014    real.data.fixnum = -1;
1015
1016    for (; CONSP(integers); integers = CDR(integers))
1017	eqv_real_object(&real, CAR(integers));
1018
1019    return (make_real_object(&real));
1020}
1021
1022LispObj *
1023Lisp_Logior(LispBuiltin *builtin)
1024/*
1025 logior &rest integers
1026 */
1027{
1028    n_real real;
1029
1030    LispObj *integers;
1031
1032    integers = ARGUMENT(0);
1033
1034    real.type = N_FIXNUM;
1035    real.data.fixnum = 0;
1036
1037    for (; CONSP(integers); integers = CDR(integers))
1038	ior_real_object(&real, CAR(integers));
1039
1040    return (make_real_object(&real));
1041}
1042
1043LispObj *
1044Lisp_Lognot(LispBuiltin *builtin)
1045/*
1046 lognot integer
1047 */
1048{
1049    n_real real;
1050
1051    LispObj *integer;
1052
1053    integer = ARGUMENT(0);
1054
1055    CHECK_INTEGER(integer);
1056
1057    set_real_object(&real, integer);
1058    not_real(&real);
1059
1060    return (make_real_object(&real));
1061}
1062
1063LispObj *
1064Lisp_Logxor(LispBuiltin *builtin)
1065/*
1066 logxor &rest integers
1067 */
1068{
1069    n_real real;
1070
1071    LispObj *integers;
1072
1073    integers = ARGUMENT(0);
1074
1075    real.type = N_FIXNUM;
1076    real.data.fixnum = 0;
1077
1078    for (; CONSP(integers); integers = CDR(integers))
1079	xor_real_object(&real, CAR(integers));
1080
1081    return (make_real_object(&real));
1082}
1083
1084LispObj *
1085Lisp_Minusp(LispBuiltin *builtin)
1086/*
1087 minusp number
1088 */
1089{
1090    LispObj *number;
1091
1092    number = ARGUMENT(0);
1093
1094    CHECK_REAL(number);
1095
1096    return (cmp_real_object(&zero, number) > 0 ? T : NIL);
1097}
1098
1099LispObj *
1100Lisp_Mod(LispBuiltin *builtin)
1101/*
1102 mod number divisor
1103 */
1104{
1105    LispObj *result;
1106
1107    LispObj *number, *divisor;
1108
1109    divisor = ARGUMENT(1);
1110    number = ARGUMENT(0);
1111
1112    if (INTEGERP(number) && INTEGERP(divisor)) {
1113	n_real real;
1114
1115	set_real_object(&real, number);
1116	mod_real_object(&real, divisor);
1117	result = make_real_object(&real);
1118    }
1119    else {
1120	n_number num;
1121
1122	set_number_object(&num, number);
1123	divide_number_object(&num, divisor, NDIVIDE_FLOOR, 0);
1124	result = make_real_object(&(num.imag));
1125	clear_real(&(num.real));
1126    }
1127
1128    return (result);
1129}
1130
1131LispObj *
1132Lisp_Numberp(LispBuiltin *builtin)
1133/*
1134 numberp object
1135 */
1136{
1137    LispObj *object;
1138
1139    object = ARGUMENT(0);
1140
1141    return (NUMBERP(object) ? T : NIL);
1142}
1143
1144LispObj *
1145Lisp_Numerator(LispBuiltin *builtin)
1146/*
1147 numerator rational
1148 */
1149{
1150    LispObj *result, *rational;
1151
1152    rational = ARGUMENT(0);
1153
1154    switch (OBJECT_TYPE(rational)) {
1155	case LispFixnum_t:
1156	case LispInteger_t:
1157	case LispBignum_t:
1158	    result = rational;
1159	    break;
1160	case LispRatio_t:
1161	    result = INTEGER(OFRN(rational));
1162	    break;
1163	case LispBigratio_t:
1164	    if (mpi_fiti(OBRN(rational)))
1165		result = INTEGER(mpi_geti(OBRN(rational)));
1166	    else {
1167		mpi *num = XALLOC(mpi);
1168
1169		mpi_init(num);
1170		mpi_set(num, OBRN(rational));
1171		result = BIGNUM(num);
1172	    }
1173	    break;
1174	default:
1175	    LispDestroy("%s: %s is not a rational number",
1176			STRFUN(builtin), STROBJ(rational));
1177	    /*NOTREACHED*/
1178	    result = NIL;
1179    }
1180
1181    return (result);
1182}
1183
1184LispObj *
1185Lisp_Oddp(LispBuiltin *builtin)
1186/*
1187 oddp integer
1188 */
1189{
1190    LispObj *result, *integer;
1191
1192    integer = ARGUMENT(0);
1193
1194    switch (OBJECT_TYPE(integer)) {
1195	case LispFixnum_t:
1196	    result = FIXNUM_VALUE(integer) % 2 ? T : NIL;
1197	    break;
1198	case LispInteger_t:
1199	    result = INT_VALUE(integer) % 2 ? T : NIL;
1200	    break;
1201	case LispBignum_t:
1202	    result = mpi_remi(OBI(integer), 2) ? T : NIL;
1203	    break;
1204	default:
1205	    fatal_builtin_object_error(builtin, integer, NOT_AN_INTEGER);
1206	    /*NOTREACHED*/
1207	    result = NIL;
1208    }
1209
1210    return (result);
1211}
1212
1213LispObj *
1214Lisp_Plusp(LispBuiltin *builtin)
1215/*
1216 plusp number
1217 */
1218{
1219    LispObj *number;
1220
1221    number = ARGUMENT(0);
1222
1223    CHECK_REAL(number);
1224
1225    return (cmp_real_object(&zero, number) < 0 ? T : NIL);
1226}
1227
1228LispObj *
1229Lisp_Rational(LispBuiltin *builtin)
1230/*
1231 rational number
1232 */
1233{
1234    LispObj *number;
1235
1236    number = ARGUMENT(0);
1237
1238    if (DFLOATP(number)) {
1239	double numerator = ODF(number);
1240
1241	if ((long)numerator == numerator)
1242	    number = INTEGER(numerator);
1243	else {
1244	    n_real real;
1245	    mpr *bigr = XALLOC(mpr);
1246
1247	    mpr_init(bigr);
1248	    mpr_setd(bigr, numerator);
1249	    real.type = N_BIGRATIO;
1250	    real.data.bigratio = bigr;
1251	    rbr_canonicalize(&real);
1252	    number = make_real_object(&real);
1253	}
1254    }
1255    else {
1256	CHECK_REAL(number);
1257    }
1258
1259    return (number);
1260}
1261
1262LispObj *
1263Lisp_Rationalp(LispBuiltin *builtin)
1264/*
1265 rationalp object
1266 */
1267{
1268    LispObj *object;
1269
1270    object = ARGUMENT(0);
1271
1272    return (RATIONALP(object) ? T : NIL);
1273}
1274
1275LispObj *
1276Lisp_Realpart(LispBuiltin *builtin)
1277/*
1278 realpart number
1279 */
1280{
1281    LispObj *number;
1282
1283    number = ARGUMENT(0);
1284
1285    if (COMPLEXP(number))
1286	return (OCXR(number));
1287    else {
1288	CHECK_REAL(number);
1289    }
1290
1291    return (number);
1292}
1293
1294LispObj *
1295Lisp_Rem(LispBuiltin *builtin)
1296/*
1297 rem number divisor
1298 */
1299{
1300    LispObj *result;
1301
1302    LispObj *number, *divisor;
1303
1304    divisor = ARGUMENT(1);
1305    number = ARGUMENT(0);
1306
1307    if (INTEGERP(number) && INTEGERP(divisor)) {
1308	n_real real;
1309
1310	set_real_object(&real, number);
1311	rem_real_object(&real, divisor);
1312	result = make_real_object(&real);
1313    }
1314    else {
1315	n_number num;
1316
1317	set_number_object(&num, number);
1318	divide_number_object(&num, divisor, NDIVIDE_TRUNC, 0);
1319	result = make_real_object(&(num.imag));
1320	clear_real(&(num.real));
1321    }
1322
1323    return (result);
1324}
1325
1326LispObj *
1327Lisp_Sqrt(LispBuiltin *builtin)
1328/*
1329 sqrt number
1330 */
1331{
1332    n_number num;
1333    LispObj *number;
1334
1335    number = ARGUMENT(0);
1336
1337    set_number_object(&num, number);
1338    sqrt_number(&num);
1339
1340    return (make_number_object(&num));
1341}
1342
1343LispObj *
1344Lisp_Zerop(LispBuiltin *builtin)
1345/*
1346 zerop number
1347 */
1348{
1349    LispObj *result, *number;
1350
1351    number = ARGUMENT(0);
1352
1353    switch (OBJECT_TYPE(number)) {
1354	case LispFixnum_t:
1355	case LispInteger_t:
1356	case LispBignum_t:
1357	case LispDFloat_t:
1358	case LispRatio_t:
1359	case LispBigratio_t:
1360	    result = cmp_real_object(&zero, number) == 0 ? T : NIL;
1361	    break;
1362	case LispComplex_t:
1363	    result = cmp_real_object(&zero, OCXR(number)) == 0 &&
1364		     cmp_real_object(&zero, OCXI(number)) == 0 ? T : NIL;
1365	    break;
1366	default:
1367	    fatal_builtin_object_error(builtin, number, NOT_A_NUMBER);
1368	    /*NOTREACHED*/
1369	    result = NIL;
1370    }
1371
1372    return (result);
1373}
1374
1375static LispObj *
1376LispDivide(LispBuiltin *builtin, int fun, int flo)
1377{
1378    n_number num;
1379    LispObj *number, *divisor;
1380
1381    divisor = ARGUMENT(1);
1382    number = ARGUMENT(0);
1383
1384    RETURN_COUNT = 1;
1385
1386    if (cmp_real_object(&zero, number) == 0) {
1387	if (divisor != NIL) {
1388	    CHECK_REAL(divisor);
1389	}
1390
1391	return (RETURN(0) = obj_zero);
1392    }
1393
1394    if (divisor == UNSPEC)
1395	divisor = obj_one;
1396
1397    set_number_object(&num, number);
1398    if (num.complex)
1399	fatal_builtin_object_error(builtin, divisor, NOT_A_REAL_NUMBER);
1400
1401    divide_number_object(&num, divisor, fun, flo);
1402    RETURN(0) = make_real_object(&(num.imag));
1403
1404    return (make_real_object(&(num.real)));
1405}
1406
1407LispObj *
1408Lisp_Ceiling(LispBuiltin *builtin)
1409/*
1410 ceiling number &optional divisor
1411 */
1412{
1413    return (LispDivide(builtin, NDIVIDE_CEIL, 0));
1414}
1415
1416LispObj *
1417Lisp_Fceiling(LispBuiltin *builtin)
1418/*
1419 fceiling number &optional divisor
1420 */
1421{
1422    return (LispDivide(builtin, NDIVIDE_CEIL, 1));
1423}
1424
1425LispObj *
1426Lisp_Floor(LispBuiltin *builtin)
1427/*
1428 floor number &optional divisor
1429 */
1430{
1431    return (LispDivide(builtin, NDIVIDE_FLOOR, 0));
1432}
1433
1434LispObj *
1435Lisp_Ffloor(LispBuiltin *builtin)
1436/*
1437 ffloor number &optional divisor
1438 */
1439{
1440    return (LispDivide(builtin, NDIVIDE_FLOOR, 1));
1441}
1442
1443LispObj *
1444Lisp_Round(LispBuiltin *builtin)
1445/*
1446 round number &optional divisor
1447 */
1448{
1449    return (LispDivide(builtin, NDIVIDE_ROUND, 0));
1450}
1451
1452LispObj *
1453Lisp_Fround(LispBuiltin *builtin)
1454/*
1455 fround number &optional divisor
1456 */
1457{
1458    return (LispDivide(builtin, NDIVIDE_ROUND, 1));
1459}
1460
1461LispObj *
1462Lisp_Truncate(LispBuiltin *builtin)
1463/*
1464 truncate number &optional divisor
1465 */
1466{
1467    return (LispDivide(builtin, NDIVIDE_TRUNC, 0));
1468}
1469
1470LispObj *
1471Lisp_Ftruncate(LispBuiltin *builtin)
1472/*
1473 ftruncate number &optional divisor
1474 */
1475{
1476    return (LispDivide(builtin, NDIVIDE_TRUNC, 1));
1477}
1478