« back to all changes in this revision
Viewing changes to xedit/lisp/math.c
- browse files at revision 2
- compare with another revision
- download diff
- download tarball
- view history from revision 2
- Committer: Bazaar Package Importer
- Author(s): Julien Cristau
- Date: 2008-09-23 00:24:45 UTC
- mfrom: (1.1.2 intrepid)
- Revision ID: james.westby@ubuntu.com-20080923002445-mb2rwkif45zz1vlj
Tags: 7.3+4
* Remove xedit from the package, it's unmaintained and broken
(closes: #321434).
* Remove xedit's conffiles on upgrade.
(closes: #321434).
* Remove xedit's conffiles on upgrade.
- files added:
- bitmap
- xgc
- xgc/Written
- files removed:
- debian/xsfbs/xsfbs-autoreconf.mk
- xedit
- xedit/lisp
- xedit/lisp/modules
- xedit/lisp/modules/progmodes
- xedit/lisp/mp
- xedit/lisp/re
- xedit/lisp/test
- files modified:
- debian/changelog
added
removed
xedit/lisp/math.c
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
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);
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
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 *
1408
Lisp_Ceiling(LispBuiltin *builtin)
1409
/*
1410
ceiling number &optional divisor
1411
*/
1412
{
1413
return (LispDivide(builtin, NDIVIDE_CEIL, 0));
1414
}
1415
1416
LispObj *
1417
Lisp_Fceiling(LispBuiltin *builtin)
1418
/*
1419
fceiling number &optional divisor
1420
*/
1421
{
1422
return (LispDivide(builtin, NDIVIDE_CEIL, 1));
1423
}
1424
1425
LispObj *
1426
Lisp_Floor(LispBuiltin *builtin)
1427
/*
1428
floor number &optional divisor
1429
*/
1430
{
1431
return (LispDivide(builtin, NDIVIDE_FLOOR, 0));
1432
}
1433
1434
LispObj *
1435
Lisp_Ffloor(LispBuiltin *builtin)
1436
/*
1437
ffloor number &optional divisor
1438
*/
1439
{
1440
return (LispDivide(builtin, NDIVIDE_FLOOR, 1));
1441
}
1442
1443
LispObj *
1444
Lisp_Round(LispBuiltin *builtin)
1445
/*
1446
round number &optional divisor
1447
*/
1448
{
1449
return (LispDivide(builtin, NDIVIDE_ROUND, 0));
1450
}
1451
1452
LispObj *
1453
Lisp_Fround(LispBuiltin *builtin)
1454
/*
1455
fround number &optional divisor
1456
*/
1457
{
1458
return (LispDivide(builtin, NDIVIDE_ROUND, 1));
1459
}
1460
1461
LispObj *
1462
Lisp_Truncate(LispBuiltin *builtin)
1463
/*
1464
truncate number &optional divisor
1465
*/
1466
{
1467
return (LispDivide(builtin, NDIVIDE_TRUNC, 0));
1468
}
1469
1470
LispObj *
1471
Lisp_Ftruncate(LispBuiltin *builtin)
1472
/*
1473
ftruncate number &optional divisor
1474
*/
1475
{
1476
return (LispDivide(builtin, NDIVIDE_TRUNC, 1));
1477
}
Loggerhead is a web-based interface for Breezy
Version: 2.0.1