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 */
42 static LispObj *LispDivide(LispBuiltin*, int, int);
43
44 /*
45 * Initialization
46 */
47 static LispObj *obj_zero, *obj_one;
48 LispObj *Ocomplex, *Oequal_;
49
50 LispObj *Oshort_float, *Osingle_float, *Odouble_float, *Olong_float;
51
52 Atom_id Sdefault_float_format;
53
54 /*
55 * Implementation
56 */
57 #include "lisp/mathimp.c"
58
59 void
LispMathInit(void)60 LispMathInit(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->value);
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
103 LispObj *
Lisp_Mul(LispBuiltin * builtin)104 Lisp_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
135 LispObj *
Lisp_Plus(LispBuiltin * builtin)136 Lisp_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
167 LispObj *
Lisp_Minus(LispBuiltin * builtin)168 Lisp_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
193 LispObj *
Lisp_Div(LispBuiltin * builtin)194 Lisp_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
218 div_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
227 LispObj *
Lisp_OnePlus(LispBuiltin * builtin)228 Lisp_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
245 LispObj *
Lisp_OneMinus(LispBuiltin * builtin)246 Lisp_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
263 LispObj *
Lisp_Less(LispBuiltin * builtin)264 Lisp_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
290 LispObj *
Lisp_LessEqual(LispBuiltin * builtin)291 Lisp_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
317 LispObj *
Lisp_Equal_(LispBuiltin * builtin)318 Lisp_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
344 LispObj *
Lisp_Greater(LispBuiltin * builtin)345 Lisp_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
371 LispObj *
Lisp_GreaterEqual(LispBuiltin * builtin)372 Lisp_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
398 LispObj *
Lisp_NotEqual(LispBuiltin * builtin)399 Lisp_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
435 LispObj *
Lisp_Min(LispBuiltin * builtin)436 Lisp_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
461 LispObj *
Lisp_Max(LispBuiltin * builtin)462 Lisp_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
487 LispObj *
Lisp_Abs(LispBuiltin * builtin)488 Lisp_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
527 LispObj *
Lisp_Complex(LispBuiltin * builtin)528 Lisp_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
551 LispObj *
Lisp_Complexp(LispBuiltin * builtin)552 Lisp_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
564 LispObj *
Lisp_Conjugate(LispBuiltin * builtin)565 Lisp_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
590 LispObj *
Lisp_Decf(LispBuiltin * builtin)591 Lisp_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
641 LispObj *
Lisp_Denominator(LispBuiltin * builtin)642 Lisp_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
681 LispObj *
Lisp_Evenp(LispBuiltin * builtin)682 Lisp_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 */
711 LispObj *
Lisp_Float(LispBuiltin * builtin)712 Lisp_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
729 LispObj *
LispFloatCoerce(LispBuiltin * builtin,LispObj * number)730 LispFloatCoerce(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
764 LispObj *
Lisp_Floatp(LispBuiltin * builtin)765 Lisp_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
777 LispObj *
Lisp_Gcd(LispBuiltin * builtin)778 Lisp_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
806 LispObj *
Lisp_Imagpart(LispBuiltin * builtin)807 Lisp_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
825 LispObj *
Lisp_Incf(LispBuiltin * builtin)826 Lisp_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
876 LispObj *
Lisp_Integerp(LispBuiltin * builtin)877 Lisp_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
889 LispObj *
Lisp_Isqrt(LispBuiltin * builtin)890 Lisp_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
929 not_a_natural_number:
930 LispDestroy("%s: %s is not a natural number",
931 STRFUN(builtin), STROBJ(natural));
932 /*NOTREACHED*/
933 return (NIL);
934 }
935
936 LispObj *
Lisp_Lcm(LispBuiltin * builtin)937 Lisp_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
980 LispObj *
Lisp_Logand(LispBuiltin * builtin)981 Lisp_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
1001 LispObj *
Lisp_Logeqv(LispBuiltin * builtin)1002 Lisp_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
1022 LispObj *
Lisp_Logior(LispBuiltin * builtin)1023 Lisp_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
1043 LispObj *
Lisp_Lognot(LispBuiltin * builtin)1044 Lisp_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
1063 LispObj *
Lisp_Logxor(LispBuiltin * builtin)1064 Lisp_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
1084 LispObj *
Lisp_Minusp(LispBuiltin * builtin)1085 Lisp_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
1099 LispObj *
Lisp_Mod(LispBuiltin * builtin)1100 Lisp_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
1131 LispObj *
Lisp_Numberp(LispBuiltin * builtin)1132 Lisp_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
1144 LispObj *
Lisp_Numerator(LispBuiltin * builtin)1145 Lisp_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
1184 LispObj *
Lisp_Oddp(LispBuiltin * builtin)1185 Lisp_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
1213 LispObj *
Lisp_Plusp(LispBuiltin * builtin)1214 Lisp_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
1228 LispObj *
Lisp_Rational(LispBuiltin * builtin)1229 Lisp_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
1262 LispObj *
Lisp_Rationalp(LispBuiltin * builtin)1263 Lisp_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
1275 LispObj *
Lisp_Realpart(LispBuiltin * builtin)1276 Lisp_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
1294 LispObj *
Lisp_Rem(LispBuiltin * builtin)1295 Lisp_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
1326 LispObj *
Lisp_Sqrt(LispBuiltin * builtin)1327 Lisp_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
1343 LispObj *
Lisp_Zerop(LispBuiltin * builtin)1344 Lisp_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
1375 static LispObj *
LispDivide(LispBuiltin * builtin,int fun,int flo)1376 LispDivide(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
1407 LispObj *
Lisp_Ceiling(LispBuiltin * builtin)1408 Lisp_Ceiling(LispBuiltin *builtin)
1409 /*
1410 ceiling number &optional divisor
1411 */
1412 {
1413 return (LispDivide(builtin, NDIVIDE_CEIL, 0));
1414 }
1415
1416 LispObj *
Lisp_Fceiling(LispBuiltin * builtin)1417 Lisp_Fceiling(LispBuiltin *builtin)
1418 /*
1419 fceiling number &optional divisor
1420 */
1421 {
1422 return (LispDivide(builtin, NDIVIDE_CEIL, 1));
1423 }
1424
1425 LispObj *
Lisp_Floor(LispBuiltin * builtin)1426 Lisp_Floor(LispBuiltin *builtin)
1427 /*
1428 floor number &optional divisor
1429 */
1430 {
1431 return (LispDivide(builtin, NDIVIDE_FLOOR, 0));
1432 }
1433
1434 LispObj *
Lisp_Ffloor(LispBuiltin * builtin)1435 Lisp_Ffloor(LispBuiltin *builtin)
1436 /*
1437 ffloor number &optional divisor
1438 */
1439 {
1440 return (LispDivide(builtin, NDIVIDE_FLOOR, 1));
1441 }
1442
1443 LispObj *
Lisp_Round(LispBuiltin * builtin)1444 Lisp_Round(LispBuiltin *builtin)
1445 /*
1446 round number &optional divisor
1447 */
1448 {
1449 return (LispDivide(builtin, NDIVIDE_ROUND, 0));
1450 }
1451
1452 LispObj *
Lisp_Fround(LispBuiltin * builtin)1453 Lisp_Fround(LispBuiltin *builtin)
1454 /*
1455 fround number &optional divisor
1456 */
1457 {
1458 return (LispDivide(builtin, NDIVIDE_ROUND, 1));
1459 }
1460
1461 LispObj *
Lisp_Truncate(LispBuiltin * builtin)1462 Lisp_Truncate(LispBuiltin *builtin)
1463 /*
1464 truncate number &optional divisor
1465 */
1466 {
1467 return (LispDivide(builtin, NDIVIDE_TRUNC, 0));
1468 }
1469
1470 LispObj *
Lisp_Ftruncate(LispBuiltin * builtin)1471 Lisp_Ftruncate(LispBuiltin *builtin)
1472 /*
1473 ftruncate number &optional divisor
1474 */
1475 {
1476 return (LispDivide(builtin, NDIVIDE_TRUNC, 1));
1477 }
1478