native/arithmetic.c

   1 #include "factor.h"
   2
   3 BIGNUM* fixnum_to_bignum(CELL n)
   4 {
   5         return bignum((BIGNUM_2)untag_fixnum_fast(n));
   6 }
   7
   8 RATIO* fixnum_to_ratio(CELL n)
   9 {
  10         return ratio(n,tag_fixnum(1));
  11 }
  12
  13 FLOAT* fixnum_to_float(CELL n)
  14 {
  15         return make_float((double)untag_fixnum_fast(n));
  16 }
  17
  18 FIXNUM bignum_to_fixnum(CELL tagged)
  19 {
  20         return (FIXNUM)(((BIGNUM*)UNTAG(tagged))->n);
  21 }
  22
  23 RATIO* bignum_to_ratio(CELL n)
  24 {
  25         return ratio(n,tag_fixnum(1));
  26 }
  27
  28 FLOAT* bignum_to_float(CELL tagged)
  29 {
  30         return make_float((double)((BIGNUM*)UNTAG(tagged))->n);
  31 }
  32
  33 FLOAT* ratio_to_float(CELL tagged)
  34 {
  35         RATIO* r = (RATIO*)UNTAG(tagged);
  36         return (FLOAT*)UNTAG(divfloat(r->numerator,r->denominator));
  37 }
  38
  39 void primitive_numberp(void)
  40 {
  41         check_non_empty(env.dt);
  42
  43         switch(type_of(env.dt))
  44         {
  45         case FIXNUM_TYPE:
  46         case BIGNUM_TYPE:
  47         case RATIO_TYPE:
  48                 env.dt = T;
  49                 break;
  50         default:
  51                 env.dt = F;
  52                 break;
  53         }
  54 }
  55
  56 CELL to_integer(CELL tagged)
  57 {
  58         RATIO* r;
  59
  60         switch(type_of(tagged))
  61         {
  62         case FIXNUM_TYPE:
  63         case BIGNUM_TYPE:
  64                 return tagged;
  65         case RATIO_TYPE:
  66                 r = (RATIO*)UNTAG(tagged);
  67                 return divint(r->numerator,r->denominator);
  68         default:
  69                 type_error(FIXNUM_TYPE,tagged);
  70                 return NULL; /* can't happen */
  71         }
  72 }
  73
  74 void primitive_to_integer(void)
  75 {
  76         env.dt = to_integer(env.dt);
  77 }
  78
  79 /* EQUALITY */
  80 CELL number_eq_anytype(CELL x, CELL y)
  81 {
  82         return F;
  83 }
  84
  85           /* op */   /* anytype */   /* integer only */
  86 BINARY_OP(number_eq, true,           false)
  87 BINARY_OP(add,       false,          false)
  88 BINARY_OP(subtract,  false,          false)
  89 BINARY_OP(multiply,  false,          false)
  90 BINARY_OP(divide,    false,          false)
  91 BINARY_OP(divint,    false,          true)
  92 BINARY_OP(divfloat,  false,          false)
  93 BINARY_OP(divmod,    false,          true)
  94 BINARY_OP(mod,       false,          true)
  95 BINARY_OP(and,       false,          true)
  96 BINARY_OP(or,        false,          true)
  97 BINARY_OP(xor,       false,          true)
  98 BINARY_OP(shiftleft, false,          true)
  99 BINARY_OP(shiftright,false,          true)
 100 BINARY_OP(less,      false,          false)
 101 BINARY_OP(lesseq,    false,          false)
 102 BINARY_OP(greater,   false,          false)
 103 BINARY_OP(greatereq, false,          false)