arith.old.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* arith.c EULISP arithmetic functions
3 /* Copyright(c)1988 Toshihiro MATSUI, Electrotechnical Laboratory
4 /* 1986-May
5 .* 1988-Feb boxing and unboxing recoded by macros
6 /****************************************************************/
7 
8 static char *rcsid="@(#)$Id$";
9 
10 #include "eus.h"
11 #include <math.h>
12 #if alpha
13 #include <limits.h>
14 #endif
15 
16 extern pointer RANDSTATE;
17 extern int gcd();
18 extern pointer makeratio();
19 
20 extern pointer copy_big(), big_plus(), big_minus();
21 extern sub_int_big(), add_int_big();
22 extern pointer add_big_big(), big_times();
23 extern pointer makebig(), makebig1(), makebig2(), extend_big(pointer,int);
24 extern pointer normalize_bignum();
26 extern pointer eusfloat_to_big(float);
28 
29 /****************************************************************/
30 /* number predicates
31 /****************************************************************/
32 pointer NUMEQUAL(ctx,n,argv)
33 register context *ctx;
34 register int n;
35 register pointer argv[];
36 { register eusfloat_t fx,fy;
37  register pointer a,x;
38  numunion nu;
39 
40  if (n<=1) error(E_MISMATCHARG);
41  x=argv[--n];
42  if (isint(x)) {
43  while (--n>=0) {
44  a=argv[n];
45  if (isflt(a)) { fx=intval(x); fy=fltval(a); goto flteqnum;}
46  else if (isint(a)) { if (x!=a) return(NIL);}
47  else if (pisratio(a)) { x=makeratio(intval(x),1); goto reqnum;}
48  else error(E_NONUMBER);}
49  return(T);}
50  else if (isratio(x)) {
51  while (--n>=0) {
52  a=argv[n];
53  if (isflt(a)) { fx=ratio2flt(x); fy=fltval(a); goto flteqnum;}
54  else if (isint(a)) a=makeratio(intval(a),1);
55  else if (!pisratio(a)) error(E_NONUMBER);
56 reqnum:
57  if ((a->c.ratio.numerator != x->c.ratio.numerator) ||
58  (a->c.ratio.denominator != x->c.ratio.denominator))
59  return(NIL);}
60  return(T);}
61  else if (isflt(x)) {
62  fx=fltval(x);
63  while (--n>=0) {
64  fy=ckfltval(argv[n]);
65 flteqnum:
66  if (fx!=fy) return(NIL);}
67  return(T); }
68  else if (pisbignum(x))
69  { eusinteger_t *xv, *av;
70  int size,i;
71  xv=bigvec(x); size=bigsize(x);
72  while (--n >=0) {
73  a=argv[n];
74  if (!isbignum(a)) return(NIL);
75  if (size != bigsize(a)) return(NIL);
76  av=bigvec(a);
77  for (i=0; i<size; i++) if (xv[i]!=av[i]) return(NIL);}
78  return(T); }
79  else error(E_NONUMBER);}
80 
81 
82 pointer GREATERP(ctx,n,argv)
83 register context *ctx;
84 register int n;
85 register pointer argv[];
86 { register pointer left,right;
87  register eusfloat_t fleft,fright;
88  eusinteger_t ival;
89  eusinteger_t sign;
90  int comparison;
91  numunion nu;
92 
93  if (n<=1) error(E_MISMATCHARG);
94  right=argv[--n];
95 
96  if (isint(right)) goto INTGT;
97  else if (isflt(right)) goto FLTGT;
98  else if (pisratio(right)) goto RATGT;
99  else if (pisbignum(right)) goto BIGGT;
100  else error(E_NONUMBER);
101 
102 INTGT:
103  while (--n>=0) {
104  left=argv[n];
105  if (isint(left)) {
106  if ((eusinteger_t)left <= (eusinteger_t)right) return(NIL); }
107  else if (isflt(left)) { fright=intval(right); goto fltgt2;}
108  else if (isbignum(left)) {
109  if (big_sign(left)<0) return(NIL);
110  right=left; goto BIGGT; }
111  if (!isint(left)) error(E_NONUMBER);
112  right=left;}
113  return(T);
114 
115 BIGGT:
116  sign=big_sign(right);
117  while (--n>=0) {
118  left=argv[n];
119  if (isint(left)) {
120  ival= intval(left);
121  if (sign>=0) return(NIL);
122  right=left;
123  goto INTGT; }
124  else if (isflt(left)) {
125  fright=big_to_float(right);
126  if (fltval(left)<=fright) return(NIL);
127  goto FLTGT1;}
128  else if (pisbignum(left)) {
129  comparison=big_compare(left, right);
130  if (comparison<=0) return(NIL);
131  right=left;
132  sign=big_sign(right);}
133  else if (isratio(left)) goto RATGT; }
134 FLTGT:
135  fright=fltval(right);
136 FLTGT1:
137  while (--n>=0) {
138  fltgt2: fleft=ckfltval(argv[n]);
139  if (fleft<=fright) return(NIL);
140  fright=fleft; }
141  return(T);
142 RATGT:
143  error(E_USER,(pointer)"sorry, comparison of ratios are not yet implemented");
144  }
145 
146 pointer LESSP(ctx,n,argv)
147 register context *ctx;
148 register int n;
149 register pointer argv[];
150 { register pointer left,right;
151  register eusfloat_t fleft,fright;
152  eusinteger_t ival;
153  eusinteger_t sign;
154  int comparison;
155  numunion nu;
156 
157  if (n<=1) error(E_MISMATCHARG);
158  right=argv[--n];
159 
160  if (isint(right)) goto INTLT;
161  else if (isflt(right)) goto FLTLT;
162  else if (pisratio(right)) goto RATLT;
163  else if (pisbignum(right)) goto BIGLT;
164  else error(E_NONUMBER);
165 
166 INTLT:
167  while (--n>=0) {
168  left=argv[n];
169  if (isint(left)) {
170  if ((eusinteger_t)left >= (eusinteger_t)right) return(NIL); }
171  else if (isflt(left)) { fright=intval(right); goto FLTLT2;}
172  else if (isbignum(left)) {
173  if (big_sign(left)>0) return(NIL);
174  right=left; goto BIGLT; }
175  if (!isint(left)) error(E_NONUMBER);
176  right=left;}
177  return(T);
178 
179 BIGLT:
180  sign=big_sign(right);
181  while (--n>=0) {
182  left=argv[n];
183  if (isint(left)) {
184  ival= intval(left);
185  if (sign<0) return(NIL);
186  right=left;
187  goto INTLT; }
188  else if (isflt(left)) {
189  fright=big_to_float(right);
190  if (fltval(left)>=fright) return(NIL);
191  goto FLTLT1;}
192  else if (pisbignum(left)) {
193  comparison=big_compare(left, right);
194  if (comparison>=0) return(NIL);
195  right=left;
196  sign=big_sign(right);}
197  else if (isratio(left)) goto RATLT; }
198 FLTLT:
199  fright=fltval(right);
200 FLTLT1:
201  while (--n>=0) {
202  FLTLT2: fleft=ckfltval(argv[n]);
203  if (fleft>=fright) return(NIL);
204  fright=fleft; }
205  return(T);
206 RATLT:
207  error(E_USER,(pointer)"sorry, comparison of ratios are not yet implemented");
208  }
209 
210 pointer GREQP(ctx,n,argv)
211 register context *ctx;
212 register int n;
213 register pointer argv[];
214 { register pointer left,right;
215  register eusfloat_t fleft,fright;
216  eusinteger_t ival;
217  eusinteger_t sign;
218  int comparison;
219  numunion nu;
220 
221  if (n<=1) error(E_MISMATCHARG);
222  right=argv[--n];
223 
224  if (isint(right)) goto INTGE;
225  else if (isflt(right)) goto FLTGE;
226  else if (pisratio(right)) goto RATGE;
227  else if (pisbignum(right)) goto BIGGE;
228  else error(E_NONUMBER);
229 
230 INTGE:
231  while (--n>=0) {
232  left=argv[n];
233  if (isint(left)) {
234  if ((eusinteger_t)left < (eusinteger_t)right) return(NIL); }
235  else if (isflt(left)) { fright=intval(right); goto FLTGE2;}
236  else if (isbignum(left)) {
237  if (sign=big_sign(left)<0) return(NIL);
238  right=left; goto BIGGE; }
239  if (!isint(left)) error(E_NONUMBER);
240  right=left;}
241  return(T);
242 
243 BIGGE:
244  sign=big_sign(right);
245  while (--n>=0) {
246  left=argv[n];
247  if (isint(left)) {
248  ival= intval(left);
249  if (sign>0) return(NIL);
250  right=left;
251  goto INTGE; }
252  else if (isflt(left)) {
253  fright=big_to_float(right);
254  if (fltval(left)<fright) return(NIL);
255  goto FLTGE1;}
256  else if (pisbignum(left)) {
257  comparison=big_compare(left, right);
258  if (comparison<0) return(NIL);
259  right=left;
260  sign=big_sign(right);}
261  else if (isratio(left)) goto RATGE; }
262 FLTGE:
263  fright=fltval(right);
264 FLTGE1:
265  while (--n>=0) {
266  FLTGE2: fleft=ckfltval(argv[n]);
267  if (fleft<fright) return(NIL);
268  fright=fleft; }
269  return(T);
270 RATGE:
271  error(E_USER,(pointer)"sorry, comparison of ratios are not yet implemented");
272  }
273 
274 pointer LSEQP(ctx,n,argv) /*less-or-equalp*/
275 register context *ctx;
276 int n;
277 pointer argv[];
278 { register pointer left,right;
279  register eusfloat_t fleft,fright;
280  eusinteger_t ival;
281  eusinteger_t sign;
282  int comparison;
283  numunion nu;
284 
285  if (n<=1) error(E_MISMATCHARG);
286  right=argv[--n];
287 
288  if (isint(right)) goto INTLE;
289  else if (isflt(right)) goto FLTLE;
290  else if (pisratio(right)) goto RATLE;
291  else if (pisbignum(right)) goto BIGLE;
292  else error(E_NONUMBER);
293 
294 INTLE:
295  while (--n>=0) {
296  left=argv[n];
297  if (isint(left)) {
298  if ((eusinteger_t)left > (eusinteger_t)right) return(NIL); }
299  else if (isflt(left)) { fright=intval(right); goto FLTLE2;}
300  else if (isbignum(left)) {
301  if (sign=big_sign(left)>0) return(NIL);
302  right=left; goto BIGLE; }
303  if (!isint(left)) error(E_NONUMBER);
304  right=left;}
305  return(T);
306 
307 BIGLE:
308  sign=big_sign(right);
309  while (--n>=0) {
310  left=argv[n];
311  if (isint(left)) {
312  ival= intval(left);
313  if (sign<0) return(NIL);
314  right=left;
315  goto INTLE; }
316  else if (isflt(left)) {
317  fright=big_to_float(right);
318  if (fltval(left) > fright) return(NIL);
319  goto FLTLE1;}
320  else if (pisbignum(left)) {
321  comparison=big_compare(left, right);
322  if (comparison > 0) return(NIL);
323  right=left;
324  sign=big_sign(right);}
325  else if (isratio(left)) goto RATLE; }
326 FLTLE:
327  fright=fltval(right);
328 FLTLE1:
329  while (--n>=0) {
330  FLTLE2: fleft=ckfltval(argv[n]);
331  if (fleft > fright) return(NIL);
332  fright=fleft; }
333  return(T);
334 RATLE:
335  error(E_USER,(pointer)"sorry, comparison of ratios are not yet implemented");
336  }
337 
338 pointer MOD(ctx,n,argv)
339 register context *ctx;
340 int n;
341 pointer argv[];
342 { register eusinteger_t x,y;
343  ckarg(2);
344  x=ckintval(argv[0]); y=ckintval(argv[1]);
345  return(makeint(x % y));}
346 
347 pointer SUB1(ctx,n,argv)
348 register context *ctx;
349 int n;
350 pointer argv[];
351 { register pointer a=argv[0];
352  eusfloat_t x;
353  numunion nu;
354 
355  ckarg(1);
356  if (a==makeint(MINNEGFIXNUM)) { return(makebig1(MINNEGFIXNUM-1));}
357  if (isint(a)) return((pointer)((eusinteger_t)a-4));
358  else if (isflt(a)) {
359  x=fltval(a);
360  return(makeflt(x-1.0)); }
361  else if (isbignum(a)) {
362  a=copy_big(a); sub_int_big(1,a); return(normalize_bignum(a));}
363  else error(E_NOINT);
364  }
365 
366 
367 pointer ADD1(ctx,n,argv)
368 register context *ctx;
369 int n;
370 pointer argv[];
371 { register pointer a=argv[0];
372  float x;
373  numunion nu;
374 
375  ckarg(1);
376  if (a==makeint(MAXPOSFIXNUM)) { return(makebig1(MAXPOSFIXNUM+1));}
377  if (isint(a)) return((pointer)((eusinteger_t)a+4));
378  else if (isflt(a)) {
379  x=fltval(a);
380  return(makeflt(x+1.0)); }
381  else if (isbignum(a)) {
382  a=copy_big(a); add_int_big(1,a); return(a);}
383  else error(E_NOINT);
384  }
385 
386 /* extended numbers */
387 
389 pointer x,y;
390 {
391  register eusinteger_t x_num, x_den, y_num, y_den, z_num, z_den, d1,d2,t;
392 
393  x_num = intval(x->c.ratio.numerator);
394  x_den = intval(x->c.ratio.denominator);
395  y_num = intval(y->c.ratio.numerator);
396  y_den = intval(y->c.ratio.denominator);
397 
398  d1=gcd(x_den,y_den);
399  if(d1 == 1){
400  z_num = x_num * y_den + x_den * y_num;
401  z_den = x_den * y_den;
402  return(makeratio(z_num,z_den));}
403  else{
404  t = x_num * (y_den / d1) + y_num * (x_den / d1);
405  d2=gcd(t,d1);
406 
407  z_num = t / d2;
408  z_den = (x_den / d1) * (y_den / d2);
409  return(makeratio(z_num,z_den));}
410 }
411 
413 pointer x,y;
414 {
415  register eusinteger_t x_num,x_den,y_num,y_den,z_num,z_den,d1,d2,t;
416 
417  x_num = intval(x->c.ratio.numerator);
418  x_den = intval(x->c.ratio.denominator);
419  y_num = intval(y->c.ratio.numerator);
420  y_den = intval(y->c.ratio.denominator);
421  d1 = gcd(x_den,y_den);
422  if(d1 == 1){
423  z_num = x_num * y_den - x_den * y_num;
424  z_den = x_den * y_den;
425  return(makeratio(z_num,z_den));}
426  else{
427  t = x_num * (y_den / d1) - y_num * (x_den / d1);
428  d2=gcd(t,d1);
429  z_num = t / d2;
430  z_den = (x_den / d1) * (y_den / d2);
431  return(makeratio(z_num,z_den));}
432 }
433 
435 pointer x,y;
436 {
437  register eusinteger_t x_num,x_den,y_num,y_den,z_num,z_den,d1,d2;
438 
439  x_num = intval(x->c.ratio.numerator);
440  x_den = intval(x->c.ratio.denominator);
441  y_num = intval(y->c.ratio.numerator);
442  y_den = intval(y->c.ratio.denominator);
443  d1=gcd(x_num,y_den);
444  d2=gcd(x_den,y_num);
445 
446  z_num = (x_num / d1) * (y_num / d2);
447  z_den = (x_den / d2) * (y_den / d1);
448 
449  return(makeratio(z_num,z_den));
450 }
451 
453 pointer x,y;
454 {
455  register eusinteger_t x_num,x_den,y_num,y_den,z_num,z_den,d1,d2;
456  register int sign;
457 
458  x_num = intval(x->c.ratio.numerator);
459  x_den = intval(x->c.ratio.denominator);
460  y_num = intval(y->c.ratio.numerator);
461  y_den = intval(y->c.ratio.denominator);
462 
463  d1=gcd(x_num,y_num);
464  d2=gcd(x_den,y_den);
465 
466  if(y_num >= 0) sign=1; else sign=-1;
467 
468  z_num = (x_num / d1) * (y_den / d2) * sign;
469  z_den = abs((x_den / d2) * (y_num / d1));
470 
471  return(makeratio(z_num,z_den));
472 }
473 
475 eusinteger_t i;
476 { return(makeratio(i,1));}
477 
479 pointer r;
480 { pointer p,q;
481  eusfloat_t num, den;
482  p=r->c.ratio.numerator;
483  q=r->c.ratio.denominator;
484  if (isint(p)) num=intval(p);
485  else if (isbignum(p)) num=big_to_float(p);
486  else error(E_USER,(pointer)"illegal ratio numerator");
487 
488  if (isint(q)) den=intval(q);
489  else if (isbignum(q)) den=big_to_float(q);
490  else error(E_USER,(pointer)"illegal ratio denominator");
491 
492  return(num/den);}
493 
495 pointer r;
496 { if (intval(r->c.ratio.numerator)==0) return(makeint(0));
497  else if (intval(r->c.ratio.denominator)==1) return(r->c.ratio.numerator);
498  else return(r);}
499 
500 
501 pointer PLUS(ctx,n,argv)
502 register context *ctx;
503 register int n;
504 register pointer argv[];
505 { eusfloat_t fs;
506  register eusinteger_t is=0,j;
507  register int i=0;
508  register pointer a, r, rs;
509  pointer b;
510  numunion nu;
511 
512  while (i<n) {
513  a=argv[i];
514  if (isint(a)) {
515  j=intval(a);
516  is+=j;
517  if (((is >> 1) ^ is)&((eusinteger_t)1<<WORD_SIZE-3)) { /* fixnum overflow */
518  b=makebig1(is); goto bigplus;} }
519  else if (isflt(a)) { fs=is; goto fplus;}
520  else if (pisratio(a)) { rs=makeratio(is,1); goto rplus;}
521  else if (pisbignum(a)) { b=copy_big(a); goto bigplus;}
522  else error(E_NONUMBER);
523  i++;}
524  return(makeint(is));
525 rplus:
526  while (i<n) {
527  a=argv[i];
528  if (isint(a)) a=makeratio(intval(a),1);
529  else if (isflt(a)) { fs=ratio2flt(rs); goto fplus;}
530  else if (!isratio(a)) error(E_NONUMBER);
531  rs= ratio_plus(rs, a);
532  i++;}
533  return(return_ratio(rs));
534 fplus:
535  while (i<n) {
536  fs+=ckfltval(argv[i]);
537  i++;}
538  return(makeflt(fs));
539 bigplus:
540  /* fprintf(stderr, "big plus\n"); */
541  i++;
542  if (is >= 0) add_int_big(is, b);
543  else sub_int_big(is, b);
544  vpush(b);
545  while (i<n) {
546  a=argv[i];
547  if (isint(a)) {
548  j=intval(a);
549  if (j>0) add_int_big(j,b);
550  else if (j<0) sub_int_big(-j,b);
551  b=normalize_bignum(b);}
552  else if (isbignum(a)) {
553  b=big_plus(a,b);
554  vpop();
555  vpush(b);
556  b=normalize_bignum(b);
557  }
558  i++; }
559  vpop();
560  return(b);
561  }
562 
563 pointer MINUS(ctx,n,argv)
564 register context *ctx;
565 register int n;
566 register pointer argv[];
567 { float fs;
568  register eusinteger_t is,ia;
569  register int i;
570  register pointer a=argv[0], rs, b, z;
571  numunion nu;
572 
573  if (n<1) error(E_MISMATCHARG);
574  else if (n==1) { /*negate*/
575  if (a==makeint(MINNEGFIXNUM)) return(makebig1(-MINNEGFIXNUM));
576  if (isint(a)) return(makeint(-intval(a)));
577  else if (isflt(a)) {
578  fs= -fltval(a);
579  return(makeflt(fs));}
580  else if (isratio(a)) { /* buggy when numerator == MINNEGFIXNUM */
581  return(makeratio(-intval(a->c.ratio.numerator),
582  intval(a->c.ratio.denominator)));}
583 
584  else if (isbignum(a)) { return(big_minus(a));}
585  else error(E_NONUMBER); }
586 
587  /* n>1 */
588 
589  i=1;
590 
591  if (isint(a)) { is=intval(a); goto IMINUS;}
592  else if (isflt(a)) { fs=fltval(a); goto FMINUS;}
593  else if (pisratio(a)) { rs=a; goto RMINUS;}
594  else if (isbignum(a)) { b=copy_big(a); goto BIGMINUS;}
595  else error(E_NONUMBER);
596 
597 IMINUS:
598  while (i<n) {
599  a=argv[i++];
600  if (isint(a)) {
601  is -= intval(a);
602  if (((is >> 1) ^ is)&((eusinteger_t)1<<WORD_SIZE-3)) { /* fixnum overflow */
603  b=makebig1(is); goto BIGMINUS;} }
604  else if (isflt(a)) { fs=is; goto FMINUS1;}
605  else if (pisratio(a)) { rs=makeratio(is,1); goto RMINUS1;}
606  else if (isbignum(a)) {
607  z=big_minus(a); /* bignum -a is copied to z */
608  vpush(z);
609  if (is>0) add_int_big(is, z);
610  else if (is<0) sub_int_big(-is, z);
611  z=normalize_bignum(z);
612  if (isint(z)) { vpop(); is= intval(z);}
613  else { b=z; goto BIGMINUS1;} }
614  else error(E_NONUMBER); }
615  return(makeint(is));
616 
617 RMINUS:
618  while (i<n) {
619  a=argv[i++];
620 RMINUS1:
621  if (isint(a)) a=makeratio(intval(a),1);
622  else if (isflt(a)) { fs=ratio2flt(rs); goto FMINUS;}
623  else if (!isratio(a)) error(E_NONUMBER);
624  rs= ratio_minus(rs, a);
625  }
626  return(return_ratio(rs));
627 
628 FMINUS:
629  while (i<n) {
630  a=argv[i++];
631 FMINUS1:
632  fs -= ckfltval(a); }
633  return(makeflt(fs));
634 
635 BIGMINUS:
636  vpush(b);
637 BIGMINUS1:
638  while (i<n) {
639  a=argv[i++];
640  if (isint(a)) {
641  ia=intval(a);
642  if (ia>0) sub_int_big(intval(a), b);
643  else if (ia<0) add_int_big(-ia, b);
644  b=normalize_bignum(b);
645  if (isint(b)) { vpop(); goto IMINUS;}
646  }
647  else if (isflt(a)) {
648  is= big_to_float(b); vpop(); goto FMINUS;}
649  else if (isbignum(a)) {
650  z= big_minus(a);
651  vpush(z);
652  b=big_plus(b,z);
653  ctx->vsp[-2]=b; /*replace b on the stack*/
654  vpop();
655  b=normalize_bignum(b);
656  if (isint(b)) { vpop(); is=intval(b); goto IMINUS;}
657  }
658  else if (isratio(a)) error(E_USER,(pointer)"BIG-RATIO not supported");
659  else error(E_NONUMBER);}
660  return(b);}
661 
662 pointer TIMES(ctx,n,argv)
663 register context *ctx;
664 register int n;
665 register pointer argv[];
666 { register eusfloat_t fs;
667  register eusinteger_t is,s;
668  register int i;
669  register eusinteger_t sign=1;
670  register pointer a, rs, b;
671  eusinteger_t hi, lo;
672  numunion nu;
673 
674 /* fprintf(stderr, "TIMES ");
675  for (i=0; i<n; i++) fprintf(stderr, "%x ", argv[i]);
676  fprintf(stderr, "\n"); */
677 
678  i=1;
679  a=argv[0];
680  if (isint(a)) { is=intval(a); goto ITIMES;}
681  else if (isflt(a)) { fs=fltval(a); goto FTIMES;}
682  else if (isratio(a)) { rs=a; vpush(rs); goto RTIMES;}
683  else if (isbignum(a)) { b=copy_big(a); vpush(b); goto BIGTIMES;}
684  else error(E_NONUMBER);
685 
686 ITIMES:
687  while (i<n) {
688  a=argv[i++];
689 ITIMES1:
690 
691  if (isint(a)) {
692  s=intval(a);
693  if (s==0 || is==0) { is=0; break;}
694  if (is<0) { sign= -1; is = -is;}
695  if (s<0) { sign= -sign; s = -s;}
696  extended_mul(is, s, 0, &hi, &lo);
697  if( hi !=0 || (lo & ((eusinteger_t)7 << WORD_SIZE-3))!=0) { /*overflow -->bignum */
698  b=makebig2(hi, lo & MASK);
699  vpush(b);
700  if (sign<0) complement_big(b);
701  goto BIGTIMES;}
702  else is= lo*sign;}
703  else if (isflt(a)) { fs=is; goto FTIMES1;}
704  else if (pisbignum(a)) { /* fixnum times bignum */
705  b=copy_big(a);
706  vpush(b);
707  goto BIGTIMES1;}
708  else if (pisratio(a)) {
709  rs=makeratio(is,1);
710  vpush(rs);
711  goto RTIMES1;}
712  else error(E_NONUMBER);}
713  return(makeint(is));
714 
715 RTIMES:
716  while (i<n) {
717  a=argv[i++];
718 RTIMES1:
719  if (isint(a)) a=makeratio(intval(a),1);
720  else if (isflt(a)) { fs=ratio2flt(rs); goto FTIMES1;}
721  else if (!isratio(a)) error(E_NONUMBER);
722  rs= ratio_times(rs, a);
723  ctx->vsp[-1]=rs;
724  }
725  ctx->lastalloc=rs;
726  vpop();
727  return(return_ratio(rs));
728 
729 BIGTIMES:
730  while (i<n) {
731  a=argv[i++];
732  if (isint(a)) {
733  is=intval(a);
734 BIGTIMES1:
735  /* Here, b is saved, (b * is) is going to be performed */
736  sign=big_sign(b);
737  if (sign<0) { complement_big(b);}
738  if (is<0) { sign = -sign; is= -is;}
739  mul_int_big(is, b);
740  if (sign<0) complement_big(b);
741  b=normalize_bignum(b);
742  if (isint(b)) { is=intval(b); vpop(); goto ITIMES;}
743  }
744  else if (isflt(a)) {
745  fs = big_to_float(b); vpop(); goto FTIMES1;}
746  else if (pisbignum(a)) {
747  sign=big_sign(b);
748  if (sign<0) complement_big(b);
749  if (big_sign(a)<0) { sign= -sign; a=big_minus(a);}
750  vpush(a);
751  b=big_times(a,b);
752  ctx->vsp[-2]=b;
753  vpop();
754  b=normalize_bignum(b);
755  if (isint(b)) { is=intval(b); vpop(); goto ITIMES;}
756  }
757  else if (pisratio(a)) {
758  error(E_USER,(pointer)"sorry, big * ratio is not yet implemented.");}
759  else error(E_NONUMBER);
760  }
761  ctx->lastalloc= vpop();
762  return(b);
763 
764 FTIMES:
765  while (i<n) {
766  a=argv[i++];
767 FTIMES1:
768  fs*=ckfltval(a);}
769  return(makeflt(fs));}
770 
771 pointer QUOTIENT(ctx, n,argv)
772 register context *ctx;
773 register int n;
774 pointer argv[];
775 { register float fs;
776  register eusinteger_t is;
777  register int i=1;
778  register pointer a, rs;
779  numunion nu;
780  int sign;
781 
782  if (n<1) error(E_MISMATCHARG);
783  a=argv[0];
784  if (isint(a)) is=intval(a);
785  else if (isflt(a)) { fs=fltval(a); goto fquo;}
786  else if (pisratio(a)) {rs=a; goto rquo;}
787  else if (pisbignum(a)) { rs=copy_big(a); goto bquo;}
788  else error(E_NONUMBER);
789 
790  if (n==1) {
791  fs=fltval(a);
792  return(makeflt(1.0/fs));}
793 
794  while (i<n) {
795  a=argv[i];
796  if (isflt(a)) { fs=is; goto fquo2;}
797  else if (isint(a)) is/=intval(a);
798  else if (pisratio(a)) { rs=makeratio(is,1); goto rquo;}
799  else if (pisbignum(a)) error(E_USER,(pointer)"int div big?");
800  else error(E_NONUMBER);
801  i++;}
802  return(makeint(is));
803 
804 rquo: /*quotient of ratios*/
805  while (i<n) {
806  a=argv[i];
807  if (isint(a)) a=makeratio(intval(a),1);
808  else if (isflt(a)) { fs=ratio2flt(rs); goto fquo;}
809  else if (!isratio(a)) error(E_NONUMBER);
810  rs= ratio_divide(rs, a);
811  i++;}
812  return(return_ratio(rs));
813 fquo:
814  if (n==1) return(makeflt(1.0/fs));
815 fquo2:
816  while (i<n) {
817  a=argv[i];
818  fs/=ckfltval(a);
819  i++;}
820  return(makeflt(fs));
821 
822 bquo:
823  if (big_sign(rs)<0) { sign= -1; complement_big(rs);}
824  else sign=1;
825  while (i<n) {
826  a=argv[i];
827  if (isflt(a)) {
828  fs=big_to_float(rs); goto fquo2;}
829  if (!isint(a)) error(E_USER,(pointer)"big div ?");
830  is=intval(a);
831  if (is<0) { sign = - sign; is= -is;}
832  div_int_big(is, rs);
833  i++;
834  }
835  if (sign<0) complement_big(rs);
836  return(normalize_bignum(rs));
837  }
838 
839 
840 
841 
842 pointer SIN(ctx,n,argv)
843 register context *ctx;
844 int n;
845 pointer argv[];
846 { numunion nu;
847  ckarg(1);
848  return(makeflt(sin(ckfltval(argv[0]))));}
849 
850 pointer COS(ctx,n,argv)
851 register context *ctx;
852 int n;
853 pointer argv[];
854 { numunion nu;
855  ckarg(1);
856  return(makeflt(cos(ckfltval(argv[0]))));}
857 
858 pointer TAN(ctx,n,argv)
859 register context *ctx;
860 int n;
861 pointer argv[];
862 { numunion nu;
863  ckarg(1);
864  return(makeflt(tan(ckfltval(argv[0]))));}
865 
866 pointer ATAN(ctx,n,argv)
867 register context *ctx;
868 int n;
869 pointer argv[];
870 { numunion nu;
871  if (n==1) return(makeflt(atan(ckfltval(argv[0]))));
872  else if (n==2) return(makeflt(atan2(ckfltval(argv[0]),ckfltval(argv[1]))));
873  else error(E_MISMATCHARG);}
874 
875 pointer TANH(ctx,n,argv)
876 register context *ctx;
877 int n;
878 pointer argv[];
879 { numunion nu;
880  ckarg(1);
881  return(makeflt(tanh(ckfltval(argv[0]))));}
882 
883 pointer ATANH(ctx,n,argv)
884 register context *ctx;
885 int n;
886 pointer argv[];
887 { numunion nu;
888  ckarg(1);
889  return(makeflt(atanh(ckfltval(argv[0]))));}
890 
891 pointer SINH(ctx,n,argv)
892 register context *ctx;
893 int n;
894 pointer argv[];
895 { numunion nu;
896  ckarg(1);
897  return(makeflt(sinh(ckfltval(argv[0]))));}
898 
899 pointer ASINH(ctx,n,argv)
900 register context *ctx;
901 int n;
902 pointer argv[];
903 { numunion nu;
904  ckarg(1);
905  return(makeflt(asinh(ckfltval(argv[0]))));}
906 
907 pointer COSH(ctx,n,argv)
908 register context *ctx;
909 int n;
910 pointer argv[];
911 { numunion nu;
912  ckarg(1);
913  return(makeflt(cosh(ckfltval(argv[0]))));}
914 
915 pointer ACOSH(ctx,n,argv)
916 register context *ctx;
917 int n;
918 pointer argv[];
919 { numunion nu;
920  ckarg(1);
921  return(makeflt(acosh(ckfltval(argv[0]))));}
922 
923 pointer SQRT(ctx,n,argv)
924 register context *ctx;
925 int n;
926 pointer argv[];
927 { numunion nu;
928  ckarg(1);
929  return(makeflt(sqrt(ckfltval(argv[0]))));}
930 
931 pointer LOG(ctx,n,argv)
932 register context *ctx;
933 int n;
934 pointer argv[];
935 { double a;
936  numunion nu;
937  a=log(ckfltval(argv[0]));
938  if (n==1) return(makeflt(a));
939  else if (n==2) return(makeflt(a/log(ckfltval(argv[1]))));
940  else error(E_MISMATCHARG);}
941 
942 pointer EXP(ctx,n,argv)
943 register context *ctx;
944 int n;
945 pointer argv[];
946 { numunion nu;
947  ckarg(1);
948  return(makeflt(exp(ckfltval(argv[0]))));}
949 
950 pointer ABS(ctx,n,argv)
951 register context *ctx;
952 int n;
953 register pointer argv[];
954 { register pointer a, b;
955  eusfloat_t fa;
956  numunion nu;
957  ckarg(1);
958  a=argv[0];
959  if (a==makeint(MINNEGFIXNUM)) return(makebig1(-MINNEGFIXNUM));
960  if (isint(a)) return(makeint(abs(intval(a))));
961  else if (isflt(a)) return(makeflt(fabs(fltval(a))));
962  else if (pisbignum(a)) {
963  if (big_sign(a)<0) {
964  b=copy_big(a);
965  complement_big(b);
966  return(b);}
967  else return(a);}
968  else error(E_NONUMBER);}
969 
970 pointer ROUND(ctx,n,argv)
971 register context *ctx;
972 int n;
973 register pointer argv[];
974 { register pointer a=argv[0];
975  eusfloat_t f;
976  register eusinteger_t x;
977  numunion nu;
978  ckarg(1);
979  if (isint(a)) return(a);
980  else {
981  f=ckfltval(a);
982  f=(double)rint(f);
983  return(eusfloat_to_big(f));}
984  }
985 
986 pointer FLOOR(ctx,n,argv)
987 register context *ctx;
988 int n;
989 pointer argv[];
990 { register pointer a=argv[0];
991  eusfloat_t f;
992  register eusinteger_t x;
993  numunion nu;
994  ckarg(1);
995  if (isint(a)) return(a);
996  else {
997  f=floor(ckfltval(a)); return(eusfloat_to_big(f));} }
998 
999 pointer CEILING(ctx,n,argv)
1000 register context *ctx;
1001 int n;
1002 pointer argv[];
1003 { register pointer a=argv[0];
1004  eusfloat_t f;
1005  numunion nu;
1006  ckarg(1);
1007  if (isint(a)) return(a);
1008  else { f=ckfltval(a); f=ceil(f); return(eusfloat_to_big(f));}
1009  }
1010 
1011 pointer TRUNCATE(ctx,n,argv)
1012 register context *ctx;
1013 int n;
1014 pointer argv[];
1015 { register pointer a=argv[0];
1016  eusfloat_t f;
1017  register eusinteger_t x;
1018  numunion nu;
1019  ckarg(1);
1020  if (isint(a)) return(a);
1021  else if (isbignum(a)) return(a);
1022  else { f=ckfltval(a); return(eusfloat_to_big(f));}
1023  }
1024 
1025 pointer FREXP(ctx,n,argv)
1026 context *ctx;
1027 int n;
1028 pointer argv[];
1029 { eusfloat_t f,z;
1030  int exp;
1031  pointer p;
1032  numunion nu;
1033  extern double frexp(double, int *);
1034  ckarg(1);
1035  f=ckfltval(argv[0]);
1036  z=frexp(f, &exp);
1037  p=cons(ctx, makeint(exp), NIL);
1038  return(cons(ctx,makeflt(z),p));
1039  }
1040 
1041 pointer FLOAT(ctx,n,argv)
1042 register context *ctx;
1043 int n;
1044 pointer argv[];
1045 { pointer a;
1046  eusfloat_t f;
1047  numunion nu;
1048  ckarg(1);
1049  a=argv[0];
1050  if (isflt(a)) return(a);
1051  else if (isint(a)) { f=ckintval(a); return(makeflt(f));}
1052  else { f=ckfltval(a); return(makeflt(f));}
1053  }
1054 
1055 pointer DECFLOAT(ctx,n,argv) /*(decode-float FLOAT) -> int*/
1056 register context *ctx;
1057 int n;
1058 pointer argv[];
1059 { pointer x;
1060  eusinteger_t i;
1061  ckarg(1);
1062  x=argv[0];
1063  if (!isflt(x)) error(E_NONUMBER);
1064  i=intval(x);
1065  return(makeint(i));}
1066 
1067 pointer MAX(ctx,n,argv)
1068 register context *ctx;
1069 register int n;
1070 pointer argv[];
1071 { eusfloat_t fs,fm;
1072  register i=1;
1073  register eusinteger_t is;
1074  register pointer a=argv[0];
1075  numunion nu;
1076  if (n<1) error(E_MISMATCHARG);
1077  if (n==1) return(a);
1078  if (isint(a)) is=(eusinteger_t)a;
1079  else { fs=fltval(a); goto fmax;}
1080  while (i<n) {
1081  a=argv[i];
1082  if (isflt(a)) { fs=intval(is); goto fmax;}
1083  if (isint(a)) { if (is<(eusinteger_t)a) is=(eusinteger_t)a;}
1084  else error(E_NONUMBER);
1085  i++;}
1086  return((pointer)is);
1087 fmax:
1088  while (i<n) {
1089  fm=ckfltval(argv[i]);
1090  if (fs<fm) fs=fm;
1091  i++;}
1092  return(makeflt(fs));}
1093 
1094 pointer MIN(ctx,n,argv)
1095 register context *ctx;
1096 register int n;
1097 register pointer argv[];
1098 { eusfloat_t fs,fm;
1099  register int i=1;
1100  register eusinteger_t is;
1101  register pointer a=argv[0];
1102  numunion nu;
1103  if (n<1) error(E_MISMATCHARG);
1104  if (n==1) return(a);
1105  if (isint(a)) is=(eusinteger_t)a;
1106  else { fs=fltval(a); goto fmin;}
1107  while (i<n) {
1108  a=argv[i];
1109  if (isflt(a)) { fs=intval(is); goto fmin;}
1110  if (isint(a)) { if (is>(eusinteger_t)a) is=(eusinteger_t)a;}
1111  else error(E_NONUMBER);
1112  i++;}
1113  return((pointer)is);
1114 fmin:
1115  while (i<n) {
1116  fm=ckfltval(argv[i]);
1117  if (fs>fm) fs=fm;
1118  i++;}
1119  return(makeflt(fs));}
1120 
1121 /****************************************************************/
1122 /* bit wise logical operations
1123 /****************************************************************/
1124 pointer LOGAND(context *ctx, int n, pointer argv[])
1125 { int i=1,j,k,rsize,psize;
1126  eusinteger_t *rbv, *bbv, *pbv;
1127  pointer b,p,r=argv[0];
1128 
1129  if (isbignum(r)) {
1130  r=copy_big(r); rsize=bigsize(r); rbv=bigvec(r);
1131  p=argv[i++];
1132  goto bigand;}
1133 
1134  k=intval(r);
1135  while (i<n) {
1136  p=argv[i++];
1137  if (isint(p)) k &=intval(p);
1138  else if (isbignum(p)) {
1139  b=copy_big(p);
1140  p=makeint(r);
1141  r=b; rsize=bigsize(r); rbv=bigvec(r);
1142  goto bigand;}
1143  else error(E_NOINT);}
1144  return(makeint(k));
1145 
1146  while (i<n) {
1147  p=argv[i++];
1148 bigand:
1149  /* r is bignum */
1150  if (isint(p)) {
1151  rbv[0] &= intval(p);
1152  if (intval(p)>=0) for (j=1; j<rsize; j++) rbv[j]=0; }
1153  else if (isbignum(p)) {
1154  psize=bigsize(p);
1155  if (rsize>=psize) {
1156  for (j=0; j<psize; j++) rbv[j] &= p->c.bgnm.bv->c.ivec.iv[j];
1157  if (rsize>psize) {
1158  if (big_sign(p)>0) for (j=psize; j<rsize; j++) rbv[j]=0;}
1159  }
1160  else if (big_sign(r)<0) {
1161  r=extend_big(r,psize);
1162  rsize=psize; rbv=bigvec(r);
1163  for (j=0; j<psize; j++) rbv[j] &= p->c.bgnm.bv->c.ivec.iv[j];
1164  }
1165  else
1166  for (j=0; j<rsize; j++) rbv[j] &= p->c.bgnm.bv->c.ivec.iv[j];
1167  }
1168  else error(E_NOINT);}
1169  return(normalize_bignum(r));}
1170 
1171 pointer LOGIOR(ctx,n,argv)
1172 register context *ctx;
1173 register int n;
1174 register pointer argv[];
1175 { register eusinteger_t result=0;
1176  register int i=0;
1177  pointer p;
1178  while (i<n) {
1179  p=argv[i];
1180  if (!isint(p)) {
1181  if (isbignum(p)) result |= bigintval(p);
1182  else error(E_NOINT);}
1183  else result |= intval(p);
1184  i++; }
1185  return(mkbigint(result));}
1186 
1187 pointer LOGXOR(ctx,n,argv)
1188 register context *ctx;
1189 register int n;
1190 register pointer argv[];
1191 { register eusinteger_t result=0;
1192  register int i=0;
1193  while (i<n)
1194  if (!isint(argv[i])) error(E_NOINT);
1195  else result ^= intval(argv[i++]);
1196  return(makeint(result));}
1197 
1198 pointer LOGEQV(ctx,n,argv)
1199 register context *ctx;
1200 register int n;
1201 register pointer argv[];
1202 { register eusinteger_t result=0;
1203  register int i=0;
1204  while (n>0) {
1205  if (!isint(argv[--n])) error(E_NOINT);
1206  result ^= intval(argv[n]); }
1207  return(makeint(~result));}
1208 
1209 pointer LOGNAND(ctx,n,argv)
1210 register context *ctx;
1211 register int n;
1212 register pointer argv[];
1213 { register eusinteger_t result= ~0;
1214  register int i=0;
1215  while (i<n)
1216  if (!isint(argv[i])) error(E_NOINT);
1217  else result &= intval(argv[i++]);
1218  return(makeint(~result));}
1219 
1220 pointer LOGNOR(ctx,n,argv)
1221 register context *ctx;
1222 register int n;
1223 register pointer argv[];
1224 { register eusinteger_t result=0;
1225  register int i=0;
1226  while (i<n)
1227  if (!isint(argv[i])) error(E_NOINT);
1228  else result |= intval(argv[i++]);
1229  return(makeint(~result));}
1230 
1231 pointer LOGNOT(ctx,n,argv)
1232 register context *ctx;
1233 int n;
1234 pointer argv[];
1235 { eusinteger_t i;
1236  ckarg(1);
1237  if (!isint(argv[0])) error(E_NOINT);
1238  else {
1239  i=intval(argv[0]);
1240  return(makeint(~i));}}
1241 
1242 pointer LOGTEST(ctx,n,argv)
1243 register context *ctx;
1244 int n;
1245 register pointer argv[];
1246 { ckarg(2);
1247  if (!isint(argv[0])) error(E_NOINT);
1248  if (!isint(argv[1])) error(E_NOINT);
1249  if ((eusinteger_t)argv[0] & (eusinteger_t)argv[1] & (eusinteger_t)~3) return(T);
1250  else return(NIL);}
1251 
1252 pointer LOGBITP(ctx,n,argv)
1253 register context *ctx;
1254 register int n;
1255 register pointer argv[];
1256 { register eusinteger_t index,val;
1257  ckarg(2);
1258  index=ckintval(argv[0]);
1259  val=ckintval(argv[1]);
1260  if (index<0) error(E_NOINT);
1261  if ((val>>index) & 1) return(T); else return(NIL);}
1262 
1263 pointer ASH(ctx,n,argv)
1264 register context *ctx;
1265 register int n;
1266 register pointer argv[];
1267 { register eusinteger_t count,val;
1268  register int firstone;
1269  register eusinteger_t sign;
1270  pointer a,b;
1271  ckarg(2);
1272  count=ckintval(argv[1]);
1273  if (isint(argv[0])) {
1274  val=intval(argv[0]);
1275  if (count<=0) return(makeint(val>>(-count)));
1276  if (val<=0) { return(makeint(val<<count));}
1277  firstone=ffs(val);
1278  if ((firstone + count)<WORD_SIZE-2) {
1279  sign=(val>=0)?1:(-1);
1280  val=val<<count;
1281  if (sign>0) return(makeint(val));
1282  else return(makeint(~val)); }
1283  /*extend to big*/
1284  a=makebig1(val);}
1285  else if (isbignum(argv[0])) { a=argv[0]; sign=big_sign(a);}
1286  else error(E_NOINT);
1287 
1288  /*shift b by count bits*/
1289  { int size=bigsize(a);
1290  int i, j, k;
1291  eusinteger_t x, *av, *bv;
1292  pointer b=makebig(size+(count+(WORD_SIZE-1))/(WORD_SIZE-1));
1293  vpush(b);
1294  av=bigvec(a); bv=bigvec(b);
1295  if (count>=0) {
1296  j= count/(WORD_SIZE-1); k=count % (WORD_SIZE-1);
1297  for (i=0; i<size; i++) {
1298  x=av[i];
1299  bv[i+j] |= (x << k);
1300  bv[i+j+1] = (x>>((WORD_SIZE-1)-k)); } }
1301  else { /* count <0 ; shift right */
1302  count = -count;
1303  j=count/(WORD_SIZE-1); k=count % (WORD_SIZE-1);
1304  for (i=0; i<size-j-1; i++) {
1305  bv[i]=(av[j+i]>>k) | ((av[j+i+1]<<((WORD_SIZE-1)-k)) & MASK); }
1306  bv[size-j-1]=av[size-1]>>k;
1307  }
1308  b=normalize_bignum(b);
1309  vpop();
1310  return(b); }
1311  }
1312 
1313 pointer LDB(ctx,n,argv) /*(LDB 'val 'pos 'width)*/
1314 register context *ctx;
1315 register int n; /*no byte specifier in euslisp*/
1316 register pointer argv[];
1317 { register eusinteger_t pos,width=8;
1318 #if (WORD_SIZE == 64)
1319  register unsigned long val;
1320 #else
1321  register unsigned int val;
1322 #endif
1323  ckarg2(2,3);
1324  val=ckintval(argv[0]); pos=ckintval(argv[1]);
1325  if (n==3) width=ckintval(argv[2]);
1326  val=(val<<(WORD_SIZE-pos-width))>>(WORD_SIZE-width);
1327  return(makeint(val));}
1328 
1329 pointer DPB(ctx,n,argv)
1330 register context *ctx;
1331 int n;
1332 pointer argv[];
1333 { register eusinteger_t pos,width=8;
1334 #if (WORD_SIZE == 64)
1335  register unsigned long val,target,mask=~0;
1336 #else
1337  register unsigned int val,target,mask=~0;
1338 #endif
1339  ckarg(4);
1340  val=ckintval(argv[0]);
1341  target=ckintval(argv[1]);
1342  pos=ckintval(argv[2]);
1343  width=ckintval(argv[3]);
1344  mask=mask<<(WORD_SIZE-(pos+width));
1345  mask=mask>>(WORD_SIZE-width);
1346  val &= mask;
1347  mask <<= pos;
1348  target=(target & ~mask) | (val<<pos);
1349  return(makeint(target));}
1350 
1351 pointer RANDOM(ctx,n,argv)
1352 register context *ctx;
1353 int n;
1354 register pointer argv[];
1355 { pointer a=argv[0],state;
1356  eusinteger_t imax,irandval;
1357  eusfloat_t fmax,frandval;
1358  double randval;
1359  double erand48();
1360 #if news || sanyo
1361  long random();
1362 #endif
1363  numunion nu;
1364 
1365  ckarg2(1,2);
1366  if (n==2) {
1367  state=argv[1];
1368  if (!isintvector(state) && !isstring(state)) error(E_NOVECTOR);
1369  if (vecsize(state)<2) error(E_VECSIZE);}
1370  else {
1371  state=Spevalof(RANDSTATE);
1372  if (state==UNBOUND) state=speval(RANDSTATE);}
1373 #if news || sanyo
1374  randval=random();
1375 #else
1376 #if alpha
1377  randval=erand48((unsigned short *)state->c.ivec.iv);
1378 #else
1379  randval=erand48(state->c.ivec.iv);
1380 #endif
1381 #endif
1382  if (isint(a)) {
1383  imax=intval(a);
1384  irandval=randval*imax;
1385  return(makeint(irandval));}
1386  else if (isflt(a)) {
1387  fmax=fltval(a);
1388  frandval=randval*fmax;
1389  return(makeflt(frandval));}
1390  else error(E_NONUMBER);
1391  }
1392 
1393 
1394 arith(ctx,mod)
1395 register context *ctx;
1396 pointer mod;
1397 {
1398  defun(ctx,"=",mod,NUMEQUAL,NULL);
1399  defun(ctx,">",mod,GREATERP,NULL);
1400  defun(ctx,"<",mod,LESSP,NULL);
1401  defun(ctx,">=",mod,GREQP,NULL);
1402  defun(ctx,"<=",mod,LSEQP,NULL);
1403  defun(ctx,"MOD",mod,MOD,NULL);
1404  defun(ctx,"1-",mod,SUB1,NULL);
1405  defun(ctx,"1+",mod,ADD1,NULL);
1406  defun(ctx,"+",mod,PLUS,NULL);
1407  defun(ctx,"-",mod,MINUS,NULL);
1408  defun(ctx,"*",mod,TIMES,NULL);
1409  defun(ctx,"/",mod,QUOTIENT,NULL);
1410  defun(ctx,"SIN",mod,SIN,NULL);
1411  defun(ctx,"COS",mod,COS,NULL);
1412  defun(ctx,"TAN",mod,TAN,NULL);
1413  defun(ctx,"ATAN",mod,ATAN,NULL);
1414  defun(ctx,"TANH",mod,TANH,NULL);
1415  defun(ctx,"ATANH",mod,ATANH,NULL);
1416  defun(ctx,"SINH",mod,SINH,NULL);
1417  defun(ctx,"ASINH",mod,ASINH,NULL);
1418  defun(ctx,"COSH",mod,COSH,NULL);
1419  defun(ctx,"ACOSH",mod,ACOSH,NULL);
1420  defun(ctx,"SQRT",mod,SQRT,NULL);
1421  defun(ctx,"LOG",mod,LOG,NULL);
1422  defun(ctx,"EXP",mod,EXP,NULL);
1423  defun(ctx,"ABS",mod,ABS,NULL);
1424  defun(ctx,"ROUND",mod,ROUND,NULL);
1425  defun(ctx,"FLOOR",mod,FLOOR,NULL);
1426  defun(ctx,"CEILING",mod,CEILING,NULL);
1427  defun(ctx,"TRUNCATE",mod,TRUNCATE,NULL);
1428  defun(ctx,"FLOAT",mod,FLOAT,NULL);
1429  defun(ctx,"DECODE-FLOAT",mod,DECFLOAT,NULL);
1430  defun(ctx,"MAX",mod,MAX,NULL);
1431  defun(ctx,"MIN",mod,MIN,NULL);
1432  defun(ctx,"LOGAND",mod,LOGAND,NULL);
1433  defun(ctx,"LOGIOR",mod,LOGIOR,NULL);
1434  defun(ctx,"LOGXOR",mod,LOGXOR,NULL);
1435  defun(ctx,"LOGEQV",mod,LOGEQV,NULL);
1436  defun(ctx,"LOGNAND",mod,LOGNAND,NULL);
1437  defun(ctx,"LOGNOR",mod,LOGNOR,NULL);
1438  defun(ctx,"LOGNOT",mod,LOGNOT,NULL);
1439  defun(ctx,"LOGTEST",mod,LOGTEST,NULL);
1440  defun(ctx,"LOGBITP",mod,LOGBITP,NULL);
1441  defun(ctx,"ASH",mod,ASH,NULL);
1442  defun(ctx,"LDB",mod,LDB,NULL);
1443  defun(ctx,"DPB",mod,DPB,NULL);
1444  defun(ctx,"RANDOM",mod,RANDOM,NULL);
1445  defun(ctx,"FREXP",mod,FREXP,NULL);
1446 }
GREATERP
pointer GREATERP(context *ctx, int n, argv)
Definition: arith.old.c:82
SUB1
pointer SUB1(context *ctx, int n, argv)
Definition: arith.old.c:347
if
if(n==1)
Definition: unixcall.c:492
numunion
Definition: eus.h:428
NUMEQUAL
pointer NUMEQUAL(context *ctx, int n, argv)
Definition: arith.old.c:32
complement_big
void complement_big(pointer x)
Definition: big.c:475
LDB
pointer LDB(context *ctx, int n, argv)
Definition: arith.old.c:1313
NIL
pointer NIL
Definition: eus.c:110
MIN
pointer MIN(context *ctx, int n, argv)
Definition: arith.old.c:1094
defun
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
CEILING
pointer CEILING(context *ctx, int n, argv)
Definition: arith.old.c:999
makeint
#define makeint(v)
Definition: sfttest.c:2
context
Definition: eus.h:524
s
short s
Definition: structsize.c:2
makeratio
pointer makeratio()
ASH
pointer ASH(context *ctx, int n, argv)
Definition: arith.old.c:1263
TRUNCATE
pointer TRUNCATE(context *ctx, int n, argv)
Definition: arith.old.c:1011
intval
#define intval(p)
Definition: sfttest.c:1
div_int_big
eusinteger_t div_int_big(eusinteger_t c, pointer x)
Definition: big.c:628
LESSP
pointer LESSP(context *ctx, int n, argv)
Definition: arith.old.c:146
ckfltval
float ckfltval()
T
pointer T
Definition: eus.c:110
abs
#define abs(x)
Definition: image_correlation.c:12
atan2
double atan2()
E_NONUMBER
@ E_NONUMBER
Definition: eus.h:960
normalize_bignum
pointer normalize_bignum()
ratio_plus
pointer ratio_plus(pointer x, pointer y)
Definition: arith.old.c:388
E_MISMATCHARG
@ E_MISMATCHARG
Definition: eus.h:942
MOD
pointer MOD(context *ctx, int n, argv)
Definition: arith.old.c:338
eus.h
big_plus
pointer big_plus()
TIMES
pointer TIMES(context *ctx, int n, argv)
Definition: arith.old.c:662
sin
double sin()
LOGBITP
pointer LOGBITP(context *ctx, int n, argv)
Definition: arith.old.c:1252
cell::cellunion::bgnm
struct bignum bgnm
Definition: eus.h:424
cell::cellunion::ivec
struct intvector ivec
Definition: eus.h:416
eusfloat_t
double eusfloat_t
Definition: eus.h:21
LSEQP
pointer LSEQP(context *ctx, int n, argv)
Definition: arith.old.c:274
SINH
pointer SINH(context *ctx, int n, argv)
Definition: arith.old.c:891
cell::c
union cell::cellunion c
COSH
pointer COSH(context *ctx, int n, argv)
Definition: arith.old.c:907
ROUND
pointer ROUND(context *ctx, int n, argv)
Definition: arith.old.c:970
big_to_float
eusfloat_t big_to_float(pointer)
Definition: big.c:954
LOGNAND
pointer LOGNAND(context *ctx, int n, argv)
Definition: arith.old.c:1209
LOGAND
pointer LOGAND(context *ctx, int n, pointer argv[])
Definition: arith.old.c:1124
TAN
pointer TAN(context *ctx, int n, argv)
Definition: arith.old.c:858
LOGNOR
pointer LOGNOR(context *ctx, int n, argv)
Definition: arith.old.c:1220
NULL
#define NULL
Definition: transargv.c:8
mul_int_big
void mul_int_big(eusinteger_t c, pointer x)
Definition: big.c:607
makebig
pointer makebig()
add_int_big
add_int_big()
fltval
float fltval()
LOGNOT
pointer LOGNOT(context *ctx, int n, argv)
Definition: arith.old.c:1231
RANDOM
pointer RANDOM(context *ctx, int n, argv)
Definition: arith.old.c:1351
cell::cellunion::ratio
struct ratio ratio
Definition: eus.h:422
ASINH
pointer ASINH(context *ctx, int n, argv)
Definition: arith.old.c:899
COS
pointer COS(context *ctx, int n, argv)
Definition: arith.old.c:850
int2ratio
pointer int2ratio(eusinteger_t i)
Definition: arith.old.c:474
big_sign
eusinteger_t big_sign(pointer)
Definition: big.c:423
ATAN
pointer ATAN(context *ctx, int n, argv)
Definition: arith.old.c:866
MINUS
pointer MINUS(context *ctx, int n, argv)
Definition: arith.old.c:563
ACOSH
pointer ACOSH(context *ctx, int n, argv)
Definition: arith.old.c:915
DECFLOAT
pointer DECFLOAT(context *ctx, int n, argv)
Definition: arith.old.c:1055
ratio::denominator
pointer denominator
Definition: eus.h:370
DPB
pointer DPB(context *ctx, int n, argv)
Definition: arith.old.c:1329
copy_big
pointer copy_big()
big_minus
pointer big_minus()
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
ratio2flt
eusfloat_t ratio2flt(pointer r)
Definition: arith.old.c:478
makebig1
pointer makebig1()
QUOTIENT
pointer QUOTIENT(context *ctx, int n, argv)
Definition: arith.old.c:771
makebig2
pointer makebig2()
ADD1
pointer ADD1(context *ctx, int n, argv)
Definition: arith.old.c:367
E_NOVECTOR
@ E_NOVECTOR
Definition: eus.h:963
E_NOINT
@ E_NOINT
Definition: eus.h:956
MAX
pointer MAX(context *ctx, int n, argv)
Definition: arith.old.c:1067
FLOAT
pointer FLOAT(context *ctx, int n, argv)
Definition: arith.old.c:1041
FREXP
pointer FREXP(context *ctx, int n, argv)
Definition: arith.old.c:1025
makeflt
pointer makeflt()
bignum::bv
pointer bv
Definition: eus.h:378
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
count
int count
Definition: thrtest.c:11
big_times
pointer big_times()
f
f
sqrt
double sqrt()
cell
Definition: eus.h:381
RANDSTATE
pointer RANDSTATE
Definition: eus.c:172
eusinteger_t
long eusinteger_t
Definition: eus.h:19
ratio_divide
pointer ratio_divide(pointer x, pointer y)
Definition: arith.old.c:452
SIN
pointer SIN(context *ctx, int n, argv)
Definition: arith.old.c:842
extended_mul
void extended_mul(eusinteger_t d, eusinteger_t q, eusinteger_t r, eusinteger_t *hp, eusinteger_t *lp)
Definition: big.c:28
arith
arith(context *ctx, pointer mod)
Definition: arith.old.c:1394
PLUS
pointer PLUS(context *ctx, int n, argv)
Definition: arith.old.c:501
big_compare
int big_compare(pointer x, pointer y)
Definition: big.c:437
cos
double cos()
gcd
int gcd()
E_VECSIZE
@ E_VECSIZE
Definition: eus.h:964
sub_int_big
sub_int_big()
index
char * index(char *sp, char c)
Definition: eustags.c:1669
return_ratio
pointer return_ratio(pointer r)
Definition: arith.old.c:494
extend_big
pointer extend_big(pointer, int)
Definition: big.c:392
ratio::numerator
pointer numerator
Definition: eus.h:369
LOG
pointer LOG(context *ctx, int n, argv)
Definition: arith.old.c:931
rcsid
static char * rcsid
Definition: arith.old.c:8
ATANH
pointer ATANH(context *ctx, int n, argv)
Definition: arith.old.c:883
ratio_times
pointer ratio_times(pointer x, pointer y)
Definition: arith.old.c:434
E_USER
@ E_USER
Definition: eus.h:1006
TANH
pointer TANH(context *ctx, int n, argv)
Definition: arith.old.c:875
intvector::iv
eusinteger_t iv[1]
Definition: eus.h:305
FLOOR
pointer FLOOR(context *ctx, int n, argv)
Definition: arith.old.c:986
a
char a[26]
Definition: freq.c:4
EXP
pointer EXP(context *ctx, int n, argv)
Definition: arith.old.c:942
SQRT
pointer SQRT(context *ctx, int n, argv)
Definition: arith.old.c:923
eusfloat_to_big
pointer eusfloat_to_big(float)
Definition: big.c:968
n
GLfloat n[6][3]
Definition: cube.c:15
ratio_minus
pointer ratio_minus(pointer x, pointer y)
Definition: arith.old.c:412
LOGXOR
pointer LOGXOR(context *ctx, int n, argv)
Definition: arith.old.c:1187
ABS
pointer ABS(context *ctx, int n, argv)
Definition: arith.old.c:950
LOGTEST
pointer LOGTEST(context *ctx, int n, argv)
Definition: arith.old.c:1242
LOGIOR
pointer LOGIOR(context *ctx, int n, argv)
Definition: arith.old.c:1171
add_big_big
pointer add_big_big()
ckarg
ckarg(2)
LOGEQV
pointer LOGEQV(context *ctx, int n, argv)
Definition: arith.old.c:1198
GREQP
pointer GREQP(context *ctx, int n, argv)
Definition: arith.old.c:210


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:42