native/fixnum.c

   1 #include "factor.h"
   2
   3 void primitive_fixnump(void)
   4 {
   5         check_non_empty(env.dt);
   6         env.dt = tag_boolean(TAG(env.dt) == FIXNUM_TYPE);
   7 }
   8
   9 void primitive_not(void)
  10 {
  11         type_check(FIXNUM_TYPE,env.dt);
  12         env.dt = RETAG(UNTAG(~env.dt),FIXNUM_TYPE);
  13 }
  14
  15 FIXNUM to_fixnum(CELL tagged)
  16 {
  17         RATIO* r;
  18
  19         switch(type_of(tagged))
  20         {
  21         case FIXNUM_TYPE:
  22                 return untag_fixnum_fast(tagged);
  23         case BIGNUM_TYPE:
  24                 return bignum_to_fixnum(tagged);
  25         case RATIO_TYPE:
  26                 r = (RATIO*)UNTAG(tagged);
  27                 return to_fixnum(divint(r->numerator,r->denominator));
  28         default:
  29                 type_error(FIXNUM_TYPE,tagged);
  30                 return -1; /* can't happen */
  31         }
  32 }
  33
  34 void primitive_to_fixnum(void)
  35 {
  36         env.dt = tag_fixnum(to_fixnum(env.dt));
  37 }
  38
  39 CELL number_eq_fixnum(CELL x, CELL y)
  40 {
  41         return tag_boolean(x == y);
  42 }
  43
  44 CELL add_fixnum(CELL x, CELL y)
  45 {
  46         CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y));
  47 }
  48
  49 CELL subtract_fixnum(CELL x, CELL y)
  50 {
  51         CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
  52 }
  53
  54 CELL multiply_fixnum(CELL x, CELL y)
  55 {
  56         BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
  57                 * (BIGNUM_2)untag_fixnum_fast(y));
  58 }
  59
  60 CELL divint_fixnum(CELL x, CELL y)
  61 {
  62         /* division takes common factor of 8 out. */
  63         return tag_fixnum(x / y);
  64 }
  65
  66 CELL divmod_fixnum(CELL x, CELL y)
  67 {
  68         ldiv_t q = ldiv(x,y);
  69         /* division takes common factor of 8 out. */
  70         dpush(tag_fixnum(q.quot));
  71         return q.rem;
  72 }
  73
  74 CELL mod_fixnum(CELL x, CELL y)
  75 {
  76         return x % y;
  77 }
  78
  79 FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y)
  80 {
  81         FIXNUM t;
  82
  83         if(x < 0)
  84                 x = -x;
  85         if(y < 0)
  86                 y = -y;
  87
  88         if(x > y)
  89         {
  90                 t = x;
  91                 x = y;
  92                 y = t;
  93         }
  94
  95         for(;;)
  96         {
  97                 if(x == 0)
  98                         return y;
  99
 100                 t = y % x;
 101                 y = x;
 102                 x = t;
 103         }
 104 }
 105
 106 CELL divide_fixnum(CELL x, CELL y)
 107 {
 108         FIXNUM _x = untag_fixnum_fast(x);
 109         FIXNUM _y = untag_fixnum_fast(y);
 110
 111         if(_y == 0)
 112         {
 113                 /* FIXME */
 114                 abort();
 115         }
 116         else if(_y < 0)
 117         {
 118                 _x = -_x;
 119                 _y = -_y;
 120         }
 121
 122         FIXNUM gcd = gcd_fixnum(_x,_y);
 123         if(gcd != 1)
 124         {
 125                 _x /= gcd;
 126                 _y /= gcd;
 127         }
 128
 129         if(_y == 1)
 130                 return tag_fixnum(_x);
 131         else
 132                 return tag_ratio(ratio(tag_fixnum(_x),tag_fixnum(_y)));
 133 }
 134
 135 CELL and_fixnum(CELL x, CELL y)
 136 {
 137         return x & y;
 138 }
 139
 140 CELL or_fixnum(CELL x, CELL y)
 141 {
 142         return x | y;
 143 }
 144
 145 CELL xor_fixnum(CELL x, CELL y)
 146 {
 147         return x ^ y;
 148 }
 149
 150 CELL shiftleft_fixnum(CELL x, CELL y)
 151 {
 152         BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
 153                 << (BIGNUM_2)untag_fixnum_fast(y));
 154 }
 155
 156 CELL shiftright_fixnum(CELL x, CELL y)
 157 {
 158         BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
 159                 >> (BIGNUM_2)untag_fixnum_fast(y));
 160 }
 161
 162 CELL less_fixnum(CELL x, CELL y)
 163 {
 164         return tag_boolean((FIXNUM)x < (FIXNUM)y);
 165 }
 166
 167 CELL lesseq_fixnum(CELL x, CELL y)
 168 {
 169         return tag_boolean((FIXNUM)x <= (FIXNUM)y);
 170 }
 171
 172 CELL greater_fixnum(CELL x, CELL y)
 173 {
 174         return tag_boolean((FIXNUM)x > (FIXNUM)y);
 175 }
 176
 177 CELL greatereq_fixnum(CELL x, CELL y)
 178 {
 179         return tag_boolean((FIXNUM)x >= (FIXNUM)y);
 180 }