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         case FLOAT_TYPE:
  49                 env.dt = T;
  50                 break;
  51         default:
  52                 env.dt = F;
  53                 break;
  54         }
  55 }
  56
  57 CELL to_integer(CELL tagged)
  58 {
  59         RATIO* r;
  60
  61         switch(type_of(tagged))
  62         {
  63         case FIXNUM_TYPE:
  64         case BIGNUM_TYPE:
  65                 return tagged;
  66         case RATIO_TYPE:
  67                 r = (RATIO*)UNTAG(tagged);
  68                 return divint(r->numerator,r->denominator);
  69         default:
  70                 type_error(FIXNUM_TYPE,tagged);
  71                 return NULL; /* can't happen */
  72         }
  73 }
  74
  75 void primitive_to_integer(void)
  76 {
  77         env.dt = to_integer(env.dt);
  78 }
  79
  80 /* EQUALITY */
  81 CELL number_eq_anytype(CELL x, CELL y)
  82 {
  83         return F;
  84 }
  85
  86           /* op */   /* anytype */   /* integer only */
  87 BINARY_OP(number_eq, true,           false)
  88 BINARY_OP(add,       false,          false)
  89 BINARY_OP(subtract,  false,          false)
  90 BINARY_OP(multiply,  false,          false)
  91 BINARY_OP(divide,    false,          false)
  92 BINARY_OP(divint,    false,          true)
  93 BINARY_OP(divfloat,  false,          false)
  94 BINARY_OP(divmod,    false,          true)
  95 BINARY_OP(mod,       false,          true)
  96 BINARY_OP(and,       false,          true)
  97 BINARY_OP(or,        false,          true)
  98 BINARY_OP(xor,       false,          true)
  99 BINARY_OP(shiftleft, false,          true)
 100 BINARY_OP(shiftright,false,          true)
 101 BINARY_OP(less,      false,          false)
 102 BINARY_OP(lesseq,    false,          false)
 103 BINARY_OP(greater,   false,          false)
 104 BINARY_OP(greatereq, false,          false)