home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / number.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  4.6 KB  |  247 lines
  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.     number.c
  24.     IMPLEMENTATION-DEPENDENT
  25.  
  26.     This file creates some implementation dependent constants.
  27. */
  28.  
  29. #include "include.h"
  30. #include "num_include.h"
  31.  
  32.  
  33. int
  34. fixint(x)
  35. object x;
  36. {
  37.     if (type_of(x) != t_fixnum)
  38.         FEerror("~S is not a fixnum.", 1, x);
  39.     return(fix(x));
  40. }
  41.  
  42. int
  43. fixnnint(x)
  44. object x;
  45. {
  46.     if (type_of(x) != t_fixnum || fix(x) < 0)
  47.         FEerror("~S is not a non-negative fixnum.", 1, x);
  48.     return(fix(x));
  49. }
  50.  
  51. object
  52. make_fixnum(i)
  53. int i;
  54. {
  55.     object x;
  56.  
  57.     if (-SMALL_FIXNUM_LIMIT <= i && i < SMALL_FIXNUM_LIMIT)
  58.         return(small_fixnum(i));
  59.     x = alloc_object(t_fixnum);
  60.     fix(x) = i;
  61.     return(x);
  62. }
  63.  
  64. object
  65. make_ratio(num, den)
  66. object num, den;
  67. {
  68.     object g, r, integer_divide1(), get_gcd();
  69.     vs_mark;
  70.  
  71.     if (number_zerop(den))
  72.         FEerror("Zero denominator.", 0);
  73.     if (number_zerop(num))
  74.         return(small_fixnum(0));
  75.     if (type_of(den) == t_fixnum && fix(den) == 1)
  76.         return(num);
  77.     if (number_minusp(den)) {
  78.         num = number_negate(num);
  79.         vs_push(num);
  80.         den = number_negate(den);
  81.         vs_push(den);
  82.     }
  83.     g = get_gcd(num, den);
  84.     vs_push(g);
  85.     num = integer_divide1(num, g);
  86.     vs_push(num);
  87.     den = integer_divide1(den, g);
  88.     vs_push(den);
  89.     if(type_of(den) == t_fixnum && fix(den) == 1) {
  90.         vs_reset;
  91.         return(num);
  92.     }
  93.     if(type_of(den) == t_fixnum && fix(den) == -1) {
  94.         num = number_negate(num);
  95.         vs_reset;
  96.         return(num);
  97.     }
  98.     r = alloc_object(t_ratio);
  99.     r->rat.rat_num = num;
  100.     r->rat.rat_den = den;
  101.     vs_reset;
  102.     return(r);
  103. }
  104.  
  105. object
  106. make_shortfloat(f)
  107. shortfloat f;
  108. {
  109.     object x;
  110.  
  111.     if (f == (shortfloat)0.0)
  112.         return(shortfloat_zero);
  113.     x = alloc_object(t_shortfloat);
  114.     sf(x) = f;
  115.     return(x);
  116. }
  117.  
  118. object
  119. make_longfloat(f)
  120. longfloat f;
  121. {
  122.     object x;
  123.  
  124.     if (f == (longfloat)0.0)
  125.         return(longfloat_zero);
  126.     x = alloc_object(t_longfloat);
  127.     lf(x) = f;
  128.     return(x);
  129. }
  130.  
  131. object
  132. make_complex(r, i)
  133. object r, i;
  134. {
  135.     object c;
  136.     vs_mark;
  137.  
  138.     switch (type_of(r)) {
  139.     case t_fixnum:
  140.     case t_bignum:
  141.     case t_ratio:
  142.         switch (type_of(i)) {
  143.         case t_fixnum:
  144.             if (fix(i) == 0)
  145.                 return(r);
  146.             break;
  147.         case t_shortfloat:
  148.             r = make_shortfloat((shortfloat)number_to_double(r));
  149.             vs_push(r);
  150.             break;
  151.         case t_longfloat:
  152.             r = make_longfloat(number_to_double(r));
  153.             vs_push(r);
  154.             break;
  155.         }
  156.         break;
  157.     case t_shortfloat:
  158.         switch (type_of(i)) {
  159.         case t_fixnum:
  160.         case t_bignum:
  161.         case t_ratio:
  162.             i = make_shortfloat((shortfloat)number_to_double(i));
  163.             vs_push(i);
  164.             break;
  165.         case t_longfloat:
  166.             r = make_longfloat((double)(sf(r)));
  167.             vs_push(r);
  168.             break;
  169.         }
  170.         break;
  171.     case t_longfloat:
  172.         switch (type_of(i)) {
  173.         case t_fixnum:
  174.         case t_bignum:
  175.         case t_ratio:
  176.         case t_shortfloat:
  177.             i = make_longfloat(number_to_double(i));
  178.             vs_push(i);
  179.             break;
  180.         }
  181.         break;
  182.     }            
  183.     c = alloc_object(t_complex);
  184.     c->cmp.cmp_real = r;
  185.     c->cmp.cmp_imag = i;
  186.     vs_reset;
  187.     return(c);
  188. }
  189.  
  190. double
  191. number_to_double(x)
  192. object x;
  193. {
  194.     switch(type_of(x)) {
  195.     case t_fixnum:
  196.         return((double)(fix(x)));
  197.  
  198.     case t_bignum:
  199.         return(big_to_double((struct bignum *)x));
  200.  
  201.     case t_ratio:
  202.         return(number_to_double(x->rat.rat_num) /
  203.                number_to_double(x->rat.rat_den));
  204.  
  205.     case t_shortfloat:
  206.         return((double)(sf(x)));
  207.  
  208.     case t_longfloat:
  209.         return(lf(x));
  210.  
  211.     default:
  212.         wrong_type_argument(TSor_rational_float, x);
  213.     }
  214. }
  215.  
  216. init_number()
  217. {
  218.     int i;
  219.     object x;
  220.  
  221.     for (i = -SMALL_FIXNUM_LIMIT;  i < SMALL_FIXNUM_LIMIT;  i++) {
  222.         small_fixnum_table[i + SMALL_FIXNUM_LIMIT].t
  223.         = (short)t_fixnum;
  224.         small_fixnum_table[i + SMALL_FIXNUM_LIMIT].FIXVAL = i;
  225.     }
  226.  
  227.     shortfloat_zero = alloc_object(t_shortfloat);
  228.     sf(shortfloat_zero) = (shortfloat)0.0;
  229.     longfloat_zero = alloc_object(t_longfloat);
  230.     lf(longfloat_zero) = (longfloat)0.0;
  231.     enter_mark_origin(&shortfloat_zero);
  232.     enter_mark_origin(&longfloat_zero);
  233.  
  234.       make_constant("MOST-POSITIVE-FIXNUM",
  235.               make_fixnum(MOST_POSITIVE_FIX));
  236.     make_constant("MOST-NEGATIVE-FIXNUM",
  237.               make_fixnum(MOST_NEGATIVE_FIX));
  238.  
  239.     init_num_pred();
  240.     init_num_comp();
  241.     init_num_arith();
  242.     init_num_co();
  243.     init_num_log();
  244.     init_num_sfun();
  245.     init_num_rand();
  246. }
  247.