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 void primitive_str_to_float(void)
  33 {
  34         char* c_str = to_c_string(untag_string(env.dt));
  35         env.dt = tag_object(make_float(atof(c_str)));
  36 }
  37
  38 void primitive_float_to_str(void)
  39 {
  40         char tmp[33];
  41         snprintf(&tmp,32,"%.16g",untag_float(env.dt)->n);
  42         tmp[32] = '\0';
  43         env.dt = tag_object(from_c_string(tmp));
  44 }
  45
  46 void primitive_float_to_bits(void)
  47 {
  48         /* FIXME */
  49 }
  50
  51 CELL number_eq_float(CELL x, CELL y)
  52 {
  53         return tag_boolean(((FLOAT*)UNTAG(x))->n
  54                 == ((FLOAT*)UNTAG(y))->n);
  55 }
  56
  57 CELL add_float(CELL x, CELL y)
  58 {
  59         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  60                 + ((FLOAT*)UNTAG(y))->n));
  61 }
  62
  63 CELL subtract_float(CELL x, CELL y)
  64 {
  65         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  66                 - ((FLOAT*)UNTAG(y))->n));
  67 }
  68
  69 CELL multiply_float(CELL x, CELL y)
  70 {
  71         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  72                 * ((FLOAT*)UNTAG(y))->n));
  73 }
  74
  75 CELL divide_float(CELL x, CELL y)
  76 {
  77         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  78                 / ((FLOAT*)UNTAG(y))->n));
  79 }
  80
  81 CELL divfloat_float(CELL x, CELL y)
  82 {
  83         return tag_object(make_float(((FLOAT*)UNTAG(x))->n
  84                 / ((FLOAT*)UNTAG(y))->n));
  85 }
  86
  87 CELL less_float(CELL x, CELL y)
  88 {
  89         return tag_boolean(((FLOAT*)UNTAG(x))->n
  90                 < ((FLOAT*)UNTAG(y))->n);
  91 }
  92
  93 CELL lesseq_float(CELL x, CELL y)
  94 {
  95         return tag_boolean(((FLOAT*)UNTAG(x))->n
  96                 <= ((FLOAT*)UNTAG(y))->n);
  97 }
  98
  99 CELL greater_float(CELL x, CELL y)
 100 {
 101         return tag_boolean(((FLOAT*)UNTAG(x))->n
 102                 > ((FLOAT*)UNTAG(y))->n);
 103 }
 104
 105 CELL greatereq_float(CELL x, CELL y)
 106 {
 107         return tag_boolean(((FLOAT*)UNTAG(x))->n
 108                 >= ((FLOAT*)UNTAG(y))->n);
 109 }