native/arithmetic.h

   1 #include "factor.h"
   2
   3 BIGNUM* fixnum_to_bignum(CELL n);
   4 RATIO* fixnum_to_ratio(CELL n);
   5 FLOAT* fixnum_to_float(CELL n);
   6 FIXNUM bignum_to_fixnum(CELL tagged);
   7 RATIO* bignum_to_ratio(CELL n);
   8 FLOAT* bignum_to_float(CELL n);
   9 FLOAT* ratio_to_float(CELL n);
  10
  11 #define CELL_TO_INTEGER(result) \
  12         FIXNUM _result = (result); \
  13         if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
  14                 return tag_object(fixnum_to_bignum(_result)); \
  15         else \
  16                 return tag_fixnum(_result);
  17
  18 #define BIGNUM_2_TO_INTEGER(result) \
  19         BIGNUM_2 _result = (result); \
  20         if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
  21                 return tag_object(bignum(_result)); \
  22         else \
  23                 return tag_fixnum(_result);
  24
  25 #define BINARY_OP(OP,anytype,integerOnly) \
  26 CELL OP(CELL x, CELL y) \
  27 { \
  28         switch(type_of(x)) \
  29         { \
  30         case FIXNUM_TYPE: \
  31 \
  32                 switch(type_of(y)) \
  33                 { \
  34                 case FIXNUM_TYPE: \
  35                         return OP##_fixnum(x,y); \
  36                 case RATIO_TYPE: \
  37                         if(integerOnly) \
  38                                 return OP(x,to_integer(y)); \
  39                         else \
  40                                 return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
  41                 case BIGNUM_TYPE: \
  42                         return OP##_bignum((CELL)fixnum_to_bignum(x),y); \
  43                 case FLOAT_TYPE: \
  44                         if(integerOnly) \
  45                                 return OP(x,to_integer(y)); \
  46                         else \
  47                                 return OP##_float((CELL)fixnum_to_float(x),y); \
  48                 default: \
  49                         if(anytype) \
  50                                 return OP##_anytype(x,y); \
  51                         else \
  52                                 type_error(FIXNUM_TYPE,y); \
  53                         return F; \
  54                 } \
  55 \
  56         case RATIO_TYPE: \
  57 \
  58                 switch(type_of(y)) \
  59                 { \
  60                 case FIXNUM_TYPE: \
  61                         if(integerOnly) \
  62                                 return OP(to_integer(x),y); \
  63                         else \
  64                                 return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
  65                 case RATIO_TYPE: \
  66                         if(integerOnly) \
  67                                 return OP(to_integer(x),to_integer(y)); \
  68                         else \
  69                                 return OP##_ratio(x,y); \
  70                 case BIGNUM_TYPE: \
  71                         if(integerOnly) \
  72                                 return OP(to_integer(x),y); \
  73                         else \
  74                                 return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
  75                 case FLOAT_TYPE: \
  76                         if(integerOnly) \
  77                                 return OP(to_integer(x),to_integer(y)); \
  78                         else \
  79                                 return OP##_float((CELL)ratio_to_float(x),y); \
  80                 default: \
  81                         if(anytype) \
  82                                 return OP##_anytype(x,y); \
  83                         else \
  84                                 type_error(FIXNUM_TYPE,y); \
  85                         return F; \
  86                 } \
  87 \
  88         case BIGNUM_TYPE: \
  89          \
  90                 switch(type_of(y)) \
  91                 { \
  92                 case FIXNUM_TYPE: \
  93                         return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
  94                 case RATIO_TYPE: \
  95                         if(integerOnly) \
  96                                 return OP(x,to_integer(y)); \
  97                         else \
  98                                 return OP##_ratio((CELL)bignum_to_ratio(x),y); \
  99                 case BIGNUM_TYPE: \
 100                         return OP##_bignum(x,y); \
 101                 case FLOAT_TYPE: \
 102                         if(integerOnly) \
 103                                 return OP(x,to_integer(y)); \
 104                         else \
 105                                 return OP##_float((CELL)bignum_to_float(x),y); \
 106                 default: \
 107                         if(anytype) \
 108                                 return OP##_anytype(x,y); \
 109                         else \
 110                                 type_error(BIGNUM_TYPE,y); \
 111                         return F; \
 112                 } \
 113 \
 114         case FLOAT_TYPE: \
 115          \
 116                 switch(type_of(y)) \
 117                 { \
 118                 case FIXNUM_TYPE: \
 119                         if(integerOnly) \
 120                                 return OP(to_integer(x),y); \
 121                         else \
 122                                 return OP##_float(x,(CELL)fixnum_to_float(y)); \
 123                 case RATIO_TYPE: \
 124                         if(integerOnly) \
 125                                 return OP(x,to_integer(y)); \
 126                         else \
 127                                 return OP##_float(x,(CELL)ratio_to_float(y)); \
 128                 case BIGNUM_TYPE: \
 129                         if(integerOnly) \
 130                                 return OP(to_integer(x),y); \
 131                         else \
 132                                 return OP##_float(x,(CELL)bignum_to_float(y)); \
 133                 case FLOAT_TYPE: \
 134                         if(integerOnly) \
 135                                 return OP(to_integer(x),to_integer(y)); \
 136                         else \
 137                                 return OP##_float(x,y); \
 138                 default: \
 139                         if(anytype) \
 140                                 return OP##_anytype(x,y); \
 141                         else \
 142                                 type_error(FLOAT_TYPE,y); \
 143                         return F; \
 144                 } \
 145 \
 146         default: \
 147 \
 148                 if(anytype) \
 149                         return OP##_anytype(x,y); \
 150                 else \
 151                         type_error(FIXNUM_TYPE,x); \
 152                 return F; \
 153         } \
 154 } \
 155 \
 156 void primitive_##OP(void) \
 157 { \
 158         CELL x = dpop(), y = env.dt; \
 159         env.dt = OP(x,y); \
 160 }
 161
 162 void primitive_numberp(void);
 163
 164 FIXNUM to_fixnum(CELL tagged);
 165 void primitive_to_fixnum(void);
 166 BIGNUM* to_bignum(CELL tagged);
 167 void primitive_to_bignum(void);
 168 CELL to_integer(CELL tagged);
 169 void primitive_to_integer(void);
 170 CELL number_eq(CELL x, CELL y);
 171 void primitive_number_eq(void);
 172 CELL add(CELL x, CELL y);
 173 void primitive_add(void);
 174 CELL subtract(CELL x, CELL y);
 175 void primitive_subtract(void);
 176 CELL multiply(CELL x, CELL y);
 177 void primitive_multiply(void);
 178 CELL divide(CELL x, CELL y);
 179 void primitive_divmod(void);
 180 CELL divint(CELL x, CELL y);
 181 void primitive_divint(void);
 182 CELL divfloat(CELL x, CELL y);
 183 void primitive_divfloat(void);
 184 CELL divide(CELL x, CELL y);
 185 void primitive_divide(void);
 186 CELL less(CELL x, CELL y);
 187 void primitive_less(void);
 188 CELL lesseq(CELL x, CELL y);
 189 void primitive_lesseq(void);
 190 CELL greater(CELL x, CELL y);
 191 void primitive_greater(void);
 192 CELL greatereq(CELL x, CELL y);
 193 void primitive_greatereq(void);
 194 CELL mod(CELL x, CELL y);
 195 void primitive_mod(void);
 196 CELL and(CELL x, CELL y);
 197 void primitive_and(void);
 198 CELL or(CELL x, CELL y);
 199 void primitive_or(void);
 200 CELL xor(CELL x, CELL y);
 201 void primitive_xor(void);
 202 CELL shiftleft(CELL x, CELL y);
 203 void primitive_shiftleft(void);
 204 CELL shiftright(CELL x, CELL y);
 205 void primitive_shiftright(void);