← Back to branch summary

~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to o/num_arith.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
Import upstream version 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/num_arith.c
 
1
/*
 
2
 Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
 
14
License for more details.
 
15
 
 
16
You should have received a copy of the GNU Library General Public License 
 
17
along with GCL; see the file COPYING.  If not, write to the Free Software
 
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
19
 
 
20
*/
 
21
 
 
22
/*
 
23
        Arithmetic operations
 
24
*/
 
25
#define NEED_MP_H
 
26
#include "include.h"
 
27
 
 
28
#include "num_include.h"
 
29
 
 
30
object fixnum_add(i,j)
 
31
     int i,j;
 
32
{
 
33
 
 
34
  if (i>=0)
 
35
   { if (j<= (MOST_POSITIVE_FIX-i))
 
36
      { MYmake_fixnum(return,i+j);
 
37
      }
 
38
   MPOP(return,addss,i,j);
 
39
   } else { /* i < 0 */
 
40
     if ((MOST_NEG_FIXNUM -i) <= j) {
 
41
       MYmake_fixnum(return,i+j);
 
42
     }
 
43
   MPOP(return,addss,i,j);
 
44
   }
 
45
}
 
46
/* return i - j */
 
47
object fixnum_sub(i,j)
 
48
     int i,j;
 
49
{  
 
50
 
 
51
  if (i>=0)
 
52
   { if (j >= (i - MOST_POSITIVE_FIX))
 
53
      { MYmake_fixnum(return,i-j);
 
54
      }
 
55
   MPOP(return,subss,i,j);
 
56
   } else { /* i < 0 */
 
57
     if ((MOST_NEG_FIXNUM -i) <= -j) {
 
58
       MYmake_fixnum(return,i-j);
 
59
     }
 
60
   MPOP(return,subss,i,j);
 
61
   }
 
62
}
 
63
 
 
64
object
 
65
fixnum_times(i, j)
 
66
int i, j;
 
67
{
 
68
 
 
69
  MPOP(return,mulss,i,j);
 
70
}
 
71
 
 
72
object
 
73
number_to_complex(x)
 
74
object x;
 
75
{
 
76
        object z;
 
77
 
 
78
        switch (type_of(x)) {
 
79
 
 
80
        case t_fixnum:
 
81
        case t_bignum:
 
82
        case t_ratio:
 
83
        case t_shortfloat:
 
84
        case t_longfloat:
 
85
                z = alloc_object(t_complex);
 
86
                z->cmp.cmp_real = x;
 
87
                z->cmp.cmp_imag = small_fixnum(0);
 
88
                return(z);
 
89
 
 
90
        case t_complex:
 
91
                return(x);
 
92
 
 
93
        default:
 
94
                FEwrong_type_argument(sLnumber, x);
 
95
        }
 
96
}
 
97
 
 
98
object
 
99
number_plus(x, y)
 
100
object x, y;
 
101
{
 
102
        int i, j, k;
 
103
        double dx, dy;
 
104
        object z, z1;
 
105
        switch (type_of(x)) {
 
106
        case t_fixnum:
 
107
                switch(type_of(y)) {
 
108
                case t_fixnum:
 
109
                  return fixnum_add(fix(x),fix(y));
 
110
                case t_bignum:
 
111
                  MPOP(return, addsi,fix(x),MP(y));
 
112
                case t_ratio:
 
113
                        z = number_plus(number_times(x, y->rat.rat_den),
 
114
                                        y->rat.rat_num);
 
115
                        return make_ratio(z, y->rat.rat_den);
 
116
                case t_shortfloat:
 
117
                        dx = (double)(fix(x));
 
118
                        dy = (double)(sf(y));
 
119
                        goto SHORTFLOAT;
 
120
                case t_longfloat:
 
121
                        dx = (double)(fix(x));
 
122
                        dy = lf(y);
 
123
                        goto LONGFLOAT;
 
124
                case t_complex:
 
125
                        goto COMPLEX;
 
126
                default:
 
127
                        FEwrong_type_argument(sLnumber, y);
 
128
                }
 
129
 
 
130
        case t_bignum:
 
131
                switch (type_of(y)) {
 
132
                case t_fixnum:
 
133
                  MPOP(return,addsi,fix(y),MP(x)); 
 
134
                case t_bignum:
 
135
                  MPOP(return,addii,MP(y),MP(x)); 
 
136
                case t_ratio:
 
137
                        z = number_plus(number_times(x, y->rat.rat_den), y->rat.rat_num);
 
138
                        return make_ratio(z, y->rat.rat_den);
 
139
                case t_shortfloat:
 
140
                        dx = number_to_double(x);
 
141
                        dy = (double)(sf(y));
 
142
                        goto SHORTFLOAT;
 
143
                case t_longfloat:
 
144
                        dx = number_to_double(x);
 
145
                        dy = lf(y);
 
146
                        goto LONGFLOAT;
 
147
                case t_complex:
 
148
                        goto COMPLEX;
 
149
                default:
 
150
                        FEwrong_type_argument(sLnumber, y);
 
151
                }
 
152
 
 
153
        case t_ratio:
 
154
                switch (type_of(y)) {
 
155
                case t_fixnum:
 
156
                case t_bignum:
 
157
                        
 
158
                        z = number_plus(x->rat.rat_num,
 
159
                                        number_times(x->rat.rat_den, y));
 
160
                        z = make_ratio(z, x->rat.rat_den);
 
161
                        return(z);
 
162
                case t_ratio:
 
163
 
 
164
                        z = number_plus(number_times(x->rat.rat_num,y->rat.rat_den),
 
165
                                        number_times(x->rat.rat_den,y->rat.rat_num));
 
166
                        z = make_ratio(z,number_times(x->rat.rat_den,y->rat.rat_den));
 
167
                        return(z);
 
168
                case t_shortfloat:
 
169
                        dx = number_to_double(x);
 
170
                        dy = (double)(sf(y));
 
171
                        goto SHORTFLOAT;
 
172
                case t_longfloat:
 
173
                        dx = number_to_double(x);
 
174
                        dy = lf(y);
 
175
                        goto LONGFLOAT;
 
176
                case t_complex:
 
177
                        goto COMPLEX;
 
178
                default:
 
179
                        FEwrong_type_argument(sLnumber, y);
 
180
                }
 
181
 
 
182
        case t_shortfloat:
 
183
                switch (type_of(y)) {
 
184
                case t_fixnum:
 
185
                        dx = (double)(sf(x));
 
186
                        dy = (double)(fix(y));
 
187
                        goto SHORTFLOAT;
 
188
                case t_shortfloat:
 
189
                        dx = (double)(sf(x));
 
190
                        dy = (double)(sf(y));
 
191
                        goto SHORTFLOAT;
 
192
                case t_longfloat:
 
193
                        dx = (double)(sf(x));
 
194
                        dy = lf(y);
 
195
                        goto LONGFLOAT;
 
196
                case t_complex:
 
197
                        goto COMPLEX;
 
198
                default:
 
199
                        dx = (double)(sf(x));
 
200
                        dy = number_to_double(y);
 
201
                        goto SHORTFLOAT;
 
202
                }
 
203
        SHORTFLOAT:
 
204
                z = alloc_object(t_shortfloat);
 
205
                sf(z) = (shortfloat)(dx + dy);
 
206
                return(z);
 
207
 
 
208
        case t_longfloat:
 
209
                dx = lf(x);
 
210
                switch (type_of(y)) {
 
211
                case t_fixnum:
 
212
                        dy = (double)(fix(y));
 
213
                        goto LONGFLOAT;
 
214
                case t_shortfloat:
 
215
                        dy = (double)(sf(y));
 
216
                        goto LONGFLOAT;
 
217
                case t_longfloat:
 
218
                        dy = lf(y);
 
219
                        goto LONGFLOAT;
 
220
                case t_complex:
 
221
                        goto COMPLEX;
 
222
                default:
 
223
                        dy = number_to_double(y);
 
224
                        goto LONGFLOAT;
 
225
                }
 
226
        LONGFLOAT:
 
227
                z = alloc_object(t_longfloat);
 
228
                lf(z) = dx + dy;
 
229
                return(z);
 
230
 
 
231
        case t_complex:
 
232
        COMPLEX:
 
233
                x = number_to_complex(x);
 
234
                y = number_to_complex(y);
 
235
                z = make_complex(number_plus(x->cmp.cmp_real, y->cmp.cmp_real),
 
236
                                 number_plus(x->cmp.cmp_imag, y->cmp.cmp_imag));
 
237
                return(z);
 
238
 
 
239
        default:
 
240
                FEwrong_type_argument(sLnumber, x);
 
241
        }
 
242
}
 
243
 
 
244
object
 
245
one_plus(x)
 
246
object x;
 
247
{
 
248
        int i;
 
249
        double dx;
 
250
        object z, z1;
 
251
 
 
252
        
 
253
        switch (type_of(x)) {
 
254
 
 
255
        case t_fixnum:
 
256
          
 
257
          if (fix(x)< MOST_POSITIVE_FIX-1) {
 
258
            MYmake_fixnum(return,fix(x)+1);
 
259
          }
 
260
          MPOP(return,addss,1,fix(x));
 
261
        case t_bignum:
 
262
          MPOP(return,addsi,1,MP(x));
 
263
        case t_ratio:
 
264
                z = number_plus(x->rat.rat_num, x->rat.rat_den);
 
265
                z = make_ratio(z, x->rat.rat_den);
 
266
                return(z);
 
267
 
 
268
        case t_shortfloat:
 
269
                dx = (double)(sf(x));
 
270
                z = alloc_object(t_shortfloat);
 
271
                sf(z) = (shortfloat)(dx + 1.0);
 
272
                return(z);
 
273
 
 
274
        case t_longfloat:
 
275
                dx = lf(x);
 
276
                z = alloc_object(t_longfloat);
 
277
                lf(z) = dx + 1.0;
 
278
                return(z);
 
279
 
 
280
        case t_complex:
 
281
        COMPLEX:
 
282
                z = make_complex(one_plus(x->cmp.cmp_real), x->cmp.cmp_imag);
 
283
                return(z);
 
284
 
 
285
        default:
 
286
                FEwrong_type_argument(sLnumber, x);
 
287
        }
 
288
}
 
289
 
 
290
object
 
291
number_minus(x, y)
 
292
object x, y;
 
293
{
 
294
        int i, j, k;
 
295
        double dx, dy;
 
296
        object z, z1;
 
297
 
 
298
        
 
299
        switch (type_of(x)) {
 
300
 
 
301
        case t_fixnum:
 
302
                switch(type_of(y)) {
 
303
                case t_fixnum:
 
304
                  MPOP(return,subss,fix(x),fix(y));
 
305
                case t_bignum:
 
306
                  MPOP(return, subsi,fix(x),MP(y));
 
307
                case t_ratio:
 
308
                        z = number_minus(number_times(x, y->rat.rat_den), y->rat.rat_num);
 
309
                        z = make_ratio(z, y->rat.rat_den);
 
310
                        return(z);
 
311
                case t_shortfloat:
 
312
                        dx = (double)(fix(x));
 
313
                        dy = (double)(sf(y));
 
314
                        goto SHORTFLOAT;
 
315
                case t_longfloat:
 
316
                        dx = (double)(fix(x));
 
317
                        dy = lf(y);
 
318
                        goto LONGFLOAT;
 
319
                case t_complex:
 
320
                        goto COMPLEX;
 
321
                default:
 
322
                        FEwrong_type_argument(sLnumber, y);
 
323
                }
 
324
 
 
325
        case t_bignum:
 
326
                switch (type_of(y)) {
 
327
                case t_fixnum:
 
328
                  MPOP(return,subis,MP(x),fix(y));
 
329
                case t_bignum:
 
330
                  MPOP(return,subii,MP(x),MP(y));
 
331
                case t_ratio:
 
332
                        z = number_minus(number_times(x, y->rat.rat_den), y->rat.rat_num);
 
333
                        z = make_ratio(z, y->rat.rat_den);
 
334
                        return(z);
 
335
                case t_shortfloat:
 
336
                        dx = number_to_double(x);
 
337
                        dy = (double)(sf(y));
 
338
                        goto SHORTFLOAT;
 
339
                case t_longfloat:
 
340
                        dx = number_to_double(x);
 
341
                        dy = lf(y);
 
342
                        goto LONGFLOAT;
 
343
                case t_complex:
 
344
                        goto COMPLEX;
 
345
                default:
 
346
                        FEwrong_type_argument(sLnumber, y);
 
347
                }
 
348
 
 
349
        case t_ratio:
 
350
                switch (type_of(y)) {
 
351
                case t_fixnum:
 
352
                case t_bignum:
 
353
                        z = number_minus(x->rat.rat_num, number_times(x->rat.rat_den, y));
 
354
                        z = make_ratio(z, x->rat.rat_den);
 
355
                        return(z);
 
356
                case t_ratio:
 
357
                        z = number_minus(number_times(x->rat.rat_num,y->rat.rat_den),
 
358
                                         (number_times(x->rat.rat_den,y->rat.rat_num)));
 
359
                        z = make_ratio(z,number_times(x->rat.rat_den,y->rat.rat_den));
 
360
                        return(z);
 
361
                case t_shortfloat:
 
362
                        dx = number_to_double(x);
 
363
                        dy = (double)(sf(y));
 
364
                        goto SHORTFLOAT;
 
365
                case t_longfloat:
 
366
                        dx = number_to_double(x);
 
367
                        dy = lf(y);
 
368
                        goto LONGFLOAT;
 
369
                case t_complex:
 
370
                        goto COMPLEX;
 
371
                default:
 
372
                        FEwrong_type_argument(sLnumber, y);
 
373
                }
 
374
 
 
375
        case t_shortfloat:
 
376
                switch (type_of(y)) {
 
377
                case t_fixnum:
 
378
                        dx = (double)(sf(x));
 
379
                        dy = (double)(fix(y));
 
380
                        goto SHORTFLOAT;
 
381
                case t_shortfloat:
 
382
                        dx = (double)(sf(x));
 
383
                        dy = (double)(sf(y));
 
384
                        goto SHORTFLOAT;
 
385
                case t_longfloat:
 
386
                        dx = (double)(sf(x));
 
387
                        dy = lf(y);
 
388
                        goto LONGFLOAT;
 
389
                case t_complex:
 
390
                        goto COMPLEX;
 
391
                default:
 
392
                        dx = (double)(sf(x));
 
393
                        dy = number_to_double(y);
 
394
                        goto SHORTFLOAT;
 
395
                }
 
396
        SHORTFLOAT:
 
397
                z = alloc_object(t_shortfloat);
 
398
                sf(z) = (shortfloat)(dx - dy);
 
399
                return(z);
 
400
 
 
401
        case t_longfloat:
 
402
                dx = lf(x);
 
403
                switch (type_of(y)) {
 
404
                case t_fixnum:
 
405
                        dy = (double)(fix(y));
 
406
                        goto LONGFLOAT;
 
407
                case t_shortfloat:
 
408
                        dy = (double)(sf(y));
 
409
                        goto LONGFLOAT;
 
410
                case t_longfloat:
 
411
                        dy = lf(y);
 
412
                        goto LONGFLOAT;
 
413
                case t_complex:
 
414
                        goto COMPLEX;
 
415
                default:
 
416
                        dy = number_to_double(y);
 
417
                }
 
418
        LONGFLOAT:
 
419
                z = alloc_object(t_longfloat);
 
420
                lf(z) = dx - dy;
 
421
                return(z);
 
422
 
 
423
        case t_complex:
 
424
        COMPLEX:
 
425
                x = number_to_complex(x);
 
426
                y = number_to_complex(y);
 
427
                z = make_complex(number_minus(x->cmp.cmp_real, y->cmp.cmp_real),
 
428
                                 number_minus(x->cmp.cmp_imag, y->cmp.cmp_imag));
 
429
                return(z);
 
430
 
 
431
        default:
 
432
                FEwrong_type_argument(sLnumber, x);
 
433
        }
 
434
}
 
435
 
 
436
object
 
437
one_minus(x)
 
438
object x;
 
439
{
 
440
        int i;
 
441
        double dx;
 
442
        object z, z1;
 
443
        switch (type_of(x)) {
 
444
 
 
445
        case t_fixnum:
 
446
          MPOP(return,addss,fix(x),-1);
 
447
        case t_bignum:
 
448
          MPOP(return,addsi,-1,MP(x));
 
449
        case t_ratio:
 
450
                z = number_minus(x->rat.rat_num, x->rat.rat_den);
 
451
                z = make_ratio(z, x->rat.rat_den);
 
452
                return(z);
 
453
 
 
454
        case t_shortfloat:
 
455
                dx = (double)(sf(x));
 
456
                z = alloc_object(t_shortfloat);
 
457
                sf(z) = (shortfloat)(dx - 1.0);
 
458
                return(z);
 
459
 
 
460
        case t_longfloat:
 
461
                dx = lf(x);
 
462
                z = alloc_object(t_longfloat);
 
463
                lf(z) = dx - 1.0;
 
464
                return(z);
 
465
 
 
466
        case t_complex:
 
467
        COMPLEX:
 
468
                z = make_complex(one_minus(x->cmp.cmp_real), x->cmp.cmp_imag);
 
469
                return(z);
 
470
 
 
471
        default:
 
472
                FEwrong_type_argument(sLnumber, x);
 
473
        }
 
474
}
 
475
 
 
476
object
 
477
number_negate(x)
 
478
object x;
 
479
{
 
480
        object  z, z1;
 
481
 
 
482
        switch (type_of(x)) {
 
483
 
 
484
        case t_fixnum:
 
485
                if(fix(x) == MOST_NEGATIVE_FIX)
 
486
                  return fixnum_add(1,MOST_POSITIVE_FIX);
 
487
                else
 
488
                  return(make_fixnum(-fix(x)));
 
489
        case t_bignum:
 
490
                return big_minus(x);
 
491
        case t_ratio:
 
492
                z1 = number_negate(x->rat.rat_num);
 
493
                z = alloc_object(t_ratio);
 
494
                z->rat.rat_num = z1;
 
495
                z->rat.rat_den = x->rat.rat_den;
 
496
                return(z);
 
497
 
 
498
        case t_shortfloat:
 
499
                z = alloc_object(t_shortfloat);
 
500
                sf(z) = -sf(x);
 
501
                return(z);
 
502
 
 
503
        case t_longfloat:
 
504
                z = alloc_object(t_longfloat);
 
505
                lf(z) = -lf(x);
 
506
                return(z);
 
507
 
 
508
        case t_complex:
 
509
                z = make_complex(number_negate(x->cmp.cmp_real),
 
510
                                 number_negate(x->cmp.cmp_imag));
 
511
                return(z);
 
512
 
 
513
        default:
 
514
                FEwrong_type_argument(sLnumber, x);
 
515
        }
 
516
}
 
517
 
 
518
object
 
519
number_times(x, y)
 
520
object x, y;
 
521
{  
 
522
        object z;
 
523
        double dx, dy;
 
524
 
 
525
        switch (type_of(x)) {
 
526
 
 
527
        case t_fixnum:
 
528
                switch (type_of(y)) {
 
529
                case t_fixnum:
 
530
                  MPOP(return,mulss,fix(x),fix(y));
 
531
                case t_bignum:
 
532
                  MPOP(return,mulsi,fix(x),MP(y));
 
533
                case t_ratio:
 
534
                        z = make_ratio(number_times(x, y->rat.rat_num), y->rat.rat_den);
 
535
                        return(z);
 
536
                case t_shortfloat:
 
537
                        dx = (double)(fix(x));
 
538
                        dy = (double)(sf(y));
 
539
                        goto SHORTFLOAT;
 
540
                case t_longfloat:
 
541
                        dx = (double)(fix(x));
 
542
                        dy = lf(y);
 
543
                        goto LONGFLOAT;
 
544
                case t_complex:
 
545
                        goto COMPLEX;
 
546
                default:
 
547
                        FEwrong_type_argument(sLnumber, y);
 
548
                }
 
549
 
 
550
        case t_bignum:
 
551
                switch (type_of(y)) {
 
552
                case t_fixnum:
 
553
                  MPOP(return,mulsi,fix(y),MP(x));
 
554
 
 
555
                case t_bignum:
 
556
                  MPOP(return,mulii,MP(y),MP(x));
 
557
                case t_ratio:
 
558
                        z = make_ratio(number_times(x, y->rat.rat_num), y->rat.rat_den);
 
559
                        return(z);
 
560
                case t_shortfloat:
 
561
                        dx = number_to_double(x);
 
562
                        dy = (double)(sf(y));
 
563
                        goto SHORTFLOAT;
 
564
                case t_longfloat:
 
565
                        dx = number_to_double(x);
 
566
                        dy = lf(y);
 
567
                        goto LONGFLOAT;
 
568
                case t_complex:
 
569
                        goto COMPLEX;
 
570
                default:
 
571
                        FEwrong_type_argument(sLnumber, y);
 
572
                }
 
573
 
 
574
        case t_ratio:
 
575
                switch (type_of(y)) {
 
576
                case t_fixnum:
 
577
                case t_bignum:
 
578
                        z = make_ratio(number_times(x->rat.rat_num, y), x->rat.rat_den);
 
579
                        return(z);
 
580
                case t_ratio:
 
581
                        z = make_ratio(number_times(x->rat.rat_num,y->rat.rat_num),
 
582
                                       number_times(x->rat.rat_den,y->rat.rat_den));
 
583
                        return(z);
 
584
                case t_shortfloat:
 
585
                        dx = number_to_double(x);
 
586
                        dy = (double)(sf(y));
 
587
                        goto SHORTFLOAT;
 
588
                case t_longfloat:
 
589
                        dx = number_to_double(x);
 
590
                        dy = lf(y);
 
591
                        goto LONGFLOAT;
 
592
                case t_complex:
 
593
                        goto COMPLEX;
 
594
                default:
 
595
                        FEwrong_type_argument(sLnumber, y);
 
596
                }
 
597
 
 
598
        case t_shortfloat:
 
599
                switch (type_of(y)) {
 
600
                case t_fixnum:
 
601
                        dx = (double)(sf(x));
 
602
                        dy = (double)(fix(y));
 
603
                        goto SHORTFLOAT;
 
604
                case t_shortfloat:
 
605
                        dx = (double)(sf(x));
 
606
                        dy = (double)(sf(y));
 
607
                        goto SHORTFLOAT;
 
608
                case t_longfloat:
 
609
                        dx = (double)(sf(x));
 
610
                        dy = lf(y);
 
611
                        goto LONGFLOAT;
 
612
                case t_complex:
 
613
                        goto COMPLEX;
 
614
                default:
 
615
                        dx = (double)(sf(x));
 
616
                        dy = number_to_double(y);
 
617
                        break;
 
618
                }
 
619
        SHORTFLOAT:
 
620
                z = alloc_object(t_shortfloat);
 
621
                sf(z) = (shortfloat)(dx * dy);
 
622
                return(z);
 
623
 
 
624
        case t_longfloat:
 
625
                dx = lf(x);
 
626
                switch (type_of(y)) {
 
627
                case t_fixnum:
 
628
                        dy = (double)(fix(y));
 
629
                        goto LONGFLOAT;
 
630
                case t_shortfloat:
 
631
                        dy = (double)(sf(y));
 
632
                        goto LONGFLOAT;
 
633
                case t_longfloat:
 
634
                        dy = lf(y);
 
635
                        goto LONGFLOAT;
 
636
                case t_complex:
 
637
                        goto COMPLEX;
 
638
                default:
 
639
                        dy = number_to_double(y);
 
640
                }
 
641
        LONGFLOAT:
 
642
                z = alloc_object(t_longfloat);
 
643
                lf(z) = dx * dy;
 
644
                return(z);
 
645
 
 
646
        case t_complex:
 
647
        COMPLEX:
 
648
        {
 
649
                object z1, z2, z11, z12, z21, z22;
 
650
 
 
651
                x = number_to_complex(x);
 
652
                y = number_to_complex(y);
 
653
                z11 = number_times(x->cmp.cmp_real, y->cmp.cmp_real);
 
654
                z12 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag);
 
655
                z21 = number_times(x->cmp.cmp_imag, y->cmp.cmp_real);
 
656
                z22 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag);
 
657
                z1 =  number_minus(z11, z12);
 
658
                z2 =  number_plus(z21, z22);
 
659
                z = make_complex(z1, z2);
 
660
                return(z);
 
661
        }
 
662
 
 
663
        default:
 
664
                FEwrong_type_argument(sLnumber, x);
 
665
        }
 
666
}
 
667
 
 
668
object
 
669
number_divide(x, y)
 
670
object x, y;
 
671
{
 
672
        object z;
 
673
        double dx, dy;
 
674
 
 
675
        switch (type_of(x)) {
 
676
 
 
677
        case t_fixnum:
 
678
        case t_bignum:
 
679
                switch (type_of(y)) {
 
680
                case t_fixnum:
 
681
                case t_bignum:
 
682
                        if(number_zerop(y) == TRUE)
 
683
                                zero_divisor();
 
684
                        if (number_minusp(y) == TRUE) {
 
685
                                x = number_negate(x);
 
686
                                y = number_negate(y);
 
687
                        }
 
688
                        z = make_ratio(x, y);
 
689
                        return(z);
 
690
                case t_ratio:
 
691
                        if(number_zerop(y->rat.rat_num))
 
692
                                zero_divisor();
 
693
                        z = make_ratio(number_times(x, y->rat.rat_den), y->rat.rat_num);
 
694
                        return(z);
 
695
                case t_shortfloat:
 
696
                        dx = number_to_double(x);
 
697
                        dy = (double)(sf(y));
 
698
                        goto SHORTFLOAT;
 
699
                case t_longfloat:
 
700
                        dx = number_to_double(x);
 
701
                        dy = lf(y);
 
702
                        goto LONGFLOAT;
 
703
                case t_complex:
 
704
                        goto COMPLEX;
 
705
                default:
 
706
                        FEwrong_type_argument(sLnumber, y);
 
707
                }
 
708
 
 
709
        case t_ratio:
 
710
                switch (type_of(y)) {
 
711
                case t_fixnum:
 
712
                case t_bignum:
 
713
                        if (number_zerop(y))
 
714
                                zero_divisor();
 
715
                        z = make_ratio(x->rat.rat_num, number_times(x->rat.rat_den, y));
 
716
                        return(z);
 
717
                case t_ratio:
 
718
                        z = make_ratio(number_times(x->rat.rat_num,y->rat.rat_den),
 
719
                                       number_times(x->rat.rat_den,y->rat.rat_num));
 
720
                        return(z);
 
721
                case t_shortfloat:
 
722
                        dx = number_to_double(x);
 
723
                        dy = (double)(sf(y));
 
724
                        goto SHORTFLOAT;
 
725
                case t_longfloat:
 
726
                        dx = number_to_double(x);
 
727
                        dy = lf(y);
 
728
                        goto LONGFLOAT;
 
729
                case t_complex:
 
730
                        goto COMPLEX;
 
731
                default:
 
732
                        FEwrong_type_argument(sLnumber, y);
 
733
                }
 
734
 
 
735
        case t_shortfloat:
 
736
                switch (type_of(y)) {
 
737
                case t_fixnum:
 
738
                        dx = (double)(sf(x));
 
739
                        dy = (double)(fix(y));
 
740
                        goto SHORTFLOAT;
 
741
                case t_shortfloat:
 
742
                        dx = (double)(sf(x));
 
743
                        dy = (double)(sf(y));
 
744
                        goto SHORTFLOAT;
 
745
                case t_longfloat:
 
746
                        dx = (double)(sf(x));
 
747
                        dy = lf(y);
 
748
                        goto LONGFLOAT;
 
749
                case t_complex:
 
750
                        goto COMPLEX;
 
751
                default:
 
752
                        dx = (double)(sf(x));
 
753
                        dy = number_to_double(y);
 
754
                        goto LONGFLOAT;
 
755
                }
 
756
        SHORTFLOAT:
 
757
                z = alloc_object(t_shortfloat);
 
758
                if (dy == 0.0)
 
759
                        zero_divisor();
 
760
                sf(z) = (shortfloat)(dx / dy);
 
761
                return(z);
 
762
 
 
763
 
 
764
        case t_longfloat:
 
765
                dx = lf(x);
 
766
                switch (type_of(y)) {
 
767
                case t_fixnum:
 
768
                        dy = (double)(fix(y));
 
769
                        goto LONGFLOAT;
 
770
                case t_shortfloat:
 
771
                        dy = (double)(sf(y));
 
772
                        goto LONGFLOAT;
 
773
                case t_longfloat:
 
774
                        dy = lf(y);
 
775
                        goto LONGFLOAT;
 
776
                case t_complex:
 
777
                        goto COMPLEX;
 
778
                default:
 
779
                        dy = number_to_double(y);
 
780
                }
 
781
        LONGFLOAT:
 
782
                z = alloc_object(t_longfloat);
 
783
                if (dy == 0.0)
 
784
                        zero_divisor();
 
785
                lf(z) = dx / dy;
 
786
                return(z);
 
787
 
 
788
        case t_complex:
 
789
        COMPLEX:
 
790
        {
 
791
                object z1, z2, z3;
 
792
 
 
793
                x = number_to_complex(x);
 
794
                y = number_to_complex(y);
 
795
                z1 = number_times(y->cmp.cmp_real, y->cmp.cmp_real);
 
796
                z2 = number_times(y->cmp.cmp_imag, y->cmp.cmp_imag);
 
797
                if (number_zerop(z3 = number_plus(z1, z2)))
 
798
                        zero_divisor();
 
799
                z1 = number_times(x->cmp.cmp_real, y->cmp.cmp_real);
 
800
                z2 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag);
 
801
                z1 = number_plus(z1, z2);
 
802
                z = number_times(x->cmp.cmp_imag, y->cmp.cmp_real);
 
803
                z2 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag);
 
804
                z2 = number_minus(z, z2);
 
805
                z1 = number_divide(z1, z3);
 
806
                z2 = number_divide(z2, z3);
 
807
                z = make_complex(z1, z2);
 
808
                return(z);
 
809
        }
 
810
 
 
811
        default:
 
812
                FEwrong_type_argument(sLnumber, x);
 
813
        }
 
814
}
 
815
 
 
816
object
 
817
integer_divide1(x, y)
 
818
object x, y;
 
819
{
 
820
        object q, r;
 
821
 
 
822
        integer_quotient_remainder_1(x, y, &q, &r);
 
823
        return(q);
 
824
}
 
825
 
 
826
object
 
827
get_gcd(x, y)
 
828
object  x, y;
 
829
{
 
830
        int     i, j, k;
 
831
        object  q, r;
 
832
 
 
833
        if (number_minusp(x))
 
834
                x = number_negate(x);
 
835
        if (number_minusp(y))
 
836
                y = number_negate(y);
 
837
 
 
838
L:
 
839
        if (type_of(x) == t_fixnum && type_of(y) == t_fixnum) {
 
840
                i = fix(x);
 
841
                j = fix(y);
 
842
LL:
 
843
                if (i < j) {
 
844
                        k = i;
 
845
                        i = j;
 
846
                        j = k;
 
847
                }
 
848
                if (j == 0) {
 
849
                        return(make_fixnum(i));
 
850
                }
 
851
                k = i % j;
 
852
                i = j;
 
853
                j = k;
 
854
                goto LL;
 
855
        }
 
856
 
 
857
        if (number_compare(x, y) < 0) {
 
858
                r = x;
 
859
                x = y;
 
860
                y = r;
 
861
        }
 
862
        if (type_of(y) == t_fixnum && fix(y) == 0) {
 
863
                return(x);
 
864
        }
 
865
        integer_quotient_remainder_1(x, y, &q, &r);
 
866
         x = y;
 
867
         y = r;
 
868
        goto L;
 
869
}
 
870
 
 
871
/* (+          )   */
 
872
Lplus()
 
873
{
 
874
        int i, j;
 
875
        
 
876
        j = vs_top - vs_base;
 
877
        if (j == 0) {
 
878
                vs_push(small_fixnum(0));
 
879
                return;
 
880
        }
 
881
        for (i = 0;  i < j;  i++)
 
882
                check_type_number(&vs_base[i]);
 
883
        for (i = 1;  i < j;  i++)
 
884
                vs_base[0] = number_plus(vs_base[0], vs_base[i]);
 
885
        vs_top = vs_base+1;
 
886
}
 
887
 
 
888
Lminus()
 
889
{
 
890
        int i, j;
 
891
 
 
892
        j = vs_top - vs_base;
 
893
        if (j == 0)
 
894
                too_few_arguments();
 
895
        for (i = 0; i < j ; i++)
 
896
                check_type_number(&vs_base[i]);
 
897
        if (j == 1) {
 
898
                vs_base[0] = number_negate(vs_base[0]);
 
899
                return;
 
900
        }
 
901
        for (i = 1;  i < j;  i++)
 
902
                vs_base[0] = number_minus(vs_base[0], vs_base[i]);
 
903
        vs_top = vs_base+1;
 
904
}
 
905
 
 
906
Ltimes()
 
907
{
 
908
        int i, j;
 
909
 
 
910
        j = vs_top - vs_base;
 
911
        if (j == 0) {
 
912
                vs_push(small_fixnum(1));
 
913
                return;
 
914
        }
 
915
        for (i = 0;  i < j;  i++)
 
916
                check_type_number(&vs_base[i]);
 
917
        for (i = 1;  i < j;  i++)
 
918
                vs_base[0] = number_times(vs_base[0], vs_base[i]);
 
919
        vs_top = vs_base+1;
 
920
}
 
921
 
 
922
Ldivide()
 
923
{
 
924
        int i, j;
 
925
 
 
926
        j = vs_top - vs_base;
 
927
        if (j == 0)
 
928
                too_few_arguments();
 
929
        for(i = 0;  i < j;  i++)
 
930
                check_type_number(&vs_base[i]);
 
931
        if (j == 1) {
 
932
                vs_base[0] = number_divide(small_fixnum(1), vs_base[0]);
 
933
                return;
 
934
        }
 
935
        for (i = 1; i < j; i++)
 
936
                vs_base[0] = number_divide(vs_base[0], vs_base[i]);
 
937
        vs_top = vs_base+1;
 
938
}
 
939
 
 
940
Lone_plus()
 
941
{
 
942
        object x;
 
943
        
 
944
        check_arg(1);
 
945
        check_type_number(&vs_base[0]);
 
946
        vs_base[0] = one_plus(vs_base[0]);
 
947
}
 
948
 
 
949
Lone_minus()
 
950
{
 
951
        object x;
 
952
        
 
953
        check_arg(1);
 
954
        check_type_number(&vs_base[0]);
 
955
        vs_base[0] = one_minus(vs_base[0]);
 
956
}
 
957
 
 
958
Lconjugate()
 
959
{
 
960
        object  c, i;
 
961
 
 
962
        check_arg(1);
 
963
        check_type_number(&vs_base[0]);
 
964
        c = vs_base[0];
 
965
        if (type_of(c) == t_complex) {
 
966
                i = number_negate(c->cmp.cmp_imag);
 
967
                vs_push(i);
 
968
                vs_base[0] = make_complex(c->cmp.cmp_real, i);
 
969
                vs_pop;
 
970
        }
 
971
}
 
972
 
 
973
Lgcd()
 
974
{
 
975
        int i, narg;
 
976
 
 
977
        narg = vs_top - vs_base;
 
978
        if (narg == 0) {
 
979
                vs_push(small_fixnum(0));
 
980
                return;
 
981
        }
 
982
        for (i = 0;  i < narg;  i++)
 
983
                check_type_integer(&vs_base[i]);
 
984
        if (narg == 1) {
 
985
                if (number_minusp(vs_base[0]))
 
986
                        vs_base[0] = number_negate(vs_base[0]);
 
987
                return;
 
988
        }
 
989
        for (i = 1;  i < narg;  i++)
 
990
                vs_base[0] = get_gcd(vs_base[0], vs_base[i]);
 
991
        vs_top = vs_base+1;
 
992
}
 
993
 
 
994
Llcm()
 
995
{
 
996
        object t, g;
 
997
        int i, narg;
 
998
 
 
999
        narg = vs_top - vs_base;
 
1000
        if (narg == 0)
 
1001
                too_few_arguments();
 
1002
        for (i = 0;  i < narg;  i++)
 
1003
                check_type_integer(&vs_base[i]);
 
1004
        if (narg == 1) {
 
1005
                if (number_minusp(vs_base[0]))
 
1006
                        vs_base[0] = number_negate(vs_base[0]);
 
1007
                return;
 
1008
        }
 
1009
        for (i = 1;  i < narg;  i++) {
 
1010
                t = number_times(vs_base[0], vs_base[i]);
 
1011
                vs_push(t);
 
1012
                g = get_gcd(vs_base[0], vs_base[i]);
 
1013
                vs_push(g);
 
1014
                vs_base[0] = number_divide(t, g);
 
1015
                vs_pop;
 
1016
                vs_pop;
 
1017
        }
 
1018
        if (number_minusp(vs_base[0]))
 
1019
                vs_base[0] = number_negate(vs_base[0]);
 
1020
        vs_top = vs_base+1;
 
1021
}
 
1022
 
 
1023
zero_divisor()
 
1024
{
 
1025
        FEerror("Zero divisor.", 0);
 
1026
}
 
1027
 
 
1028
init_num_arith()
 
1029
{
 
1030
        make_function("+", Lplus);
 
1031
        make_function("-", Lminus);
 
1032
        make_function("*", Ltimes);
 
1033
        make_function("/", Ldivide);
 
1034
        make_function("1+", Lone_plus);
 
1035
        make_function("1-", Lone_minus);
 
1036
        make_function("CONJUGATE", Lconjugate);
 
1037
        make_function("GCD", Lgcd);
 
1038
        make_function("LCM", Llcm);
 
1039
}