native/float.c

   1 #include "factor.h"
   2
   3 void primitive_floatp(void)
   4 {
   5         check_non_empty(env.dt);
   6         env.dt = tag_boolean(typep(FLOAT_TYPE,env.dt));
   7 }
   8
   9 FLOAT* to_float(CELL tagged)
  10 {
  11         switch(type_of(tagged))
  12         {
  13         case FIXNUM_TYPE:
  14                 return fixnum_to_float(tagged);
  15         case BIGNUM_TYPE:
  16                 return bignum_to_float(tagged);
  17         case RATIO_TYPE:
  18                 return ratio_to_float(tagged);
  19         case FLOAT_TYPE:
  20                 return (FLOAT*)UNTAG(tagged);
  21         default:
  22                 type_error(FLOAT_TYPE,tagged);
  23                 return NULL; /* can't happen */
  24         }
  25 }
  26
  27 void primitive_to_float(void)
  28 {
  29         env.dt = tag_object(to_float(env.dt));
  30 }
  31
  32 CELL number_eq_float(CELL x, CELL y)
  33 {
  34         return tag_boolean(((FLOAT*)UNTAG(x))->n
  35                 == ((FLOAT*)UNTAG(y))->n);
  36 }
  37
  38 CELL add_float(CELL x, CELL y)
  39 {
  40         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  41                 + ((FLOAT*)UNTAG(y))->n));
  42 }
  43
  44 CELL subtract_float(CELL x, CELL y)
  45 {
  46         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  47                 - ((FLOAT*)UNTAG(y))->n));
  48 }
  49
  50 CELL multiply_float(CELL x, CELL y)
  51 {
  52         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  53                 * ((FLOAT*)UNTAG(y))->n));
  54 }
  55
  56 CELL divide_float(CELL x, CELL y)
  57 {
  58         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  59                 / ((FLOAT*)UNTAG(y))->n));
  60 }
  61
  62 CELL divfloat_float(CELL x, CELL y)
  63 {
  64         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  65                 / ((FLOAT*)UNTAG(y))->n));
  66 }
  67
  68 CELL less_float(CELL x, CELL y)
  69 {
  70         return tag_boolean(((FLOAT*)UNTAG(x))->n
  71                 < ((FLOAT*)UNTAG(y))->n);
  72 }
  73
  74 CELL lesseq_float(CELL x, CELL y)
  75 {
  76         return tag_boolean(((FLOAT*)UNTAG(x))->n
  77                 <= ((FLOAT*)UNTAG(y))->n);
  78 }
  79
  80 CELL greater_float(CELL x, CELL y)
  81 {
  82         return tag_boolean(((FLOAT*)UNTAG(x))->n
  83                 > ((FLOAT*)UNTAG(y))->n);
  84 }
  85
  86 CELL greatereq_float(CELL x, CELL y)
  87 {
  88         return tag_boolean(((FLOAT*)UNTAG(x))->n
  89                 >= ((FLOAT*)UNTAG(y))->n);
  90 }