some minor cleanups in preparation for landing of s48 bignums

diff --git a/Makefile b/Makefile
index d577b76fea2686744da655a7d33ac638220ffe8f..b5a42bfb5624405549d5afccb1184a0173ad4a00 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -4,6 +4,7 @@ LIBS = -lm
 STRIP = strip
 
 OBJS = native/arithmetic.o native/array.o native/bignum.o \
+       native/s48_bignum.o \
        native/complex.o native/cons.o native/error.o \
        native/factor.o native/file.o native/fixnum.o \
        native/float.o native/gc.o \

diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index 36439f00413a09b37a6941d3cce4496b6243255f..a7a44fddc4d0f1210625ff61892f5613c5b7d007 100644 (file)
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -52,6 +52,7 @@ DEFER: room
 DEFER: os-env
 DEFER: type-of
 DEFER: size-of
+DEFER: dump
 
 IN: strings
 DEFER: str=
@@ -244,6 +245,7 @@ IN: cross-compiler
         profiling
         call-count
         set-call-count
+        dump
     ] [
         swap succ tuck primitive,
     ] each drop ;

diff --git a/library/image.factor b/library/image.factor
index a96ee66ab3744ce3c97234ce203a0a5788cfb6b3..00aa136f4e10df726b6a303ceae55891718e1821 100644 (file)
--- a/library/image.factor
+++ b/library/image.factor
@@ -142,7 +142,9 @@ USE: words
     #! Very bad!
     object-tag here-as >r
     bignum-type >header emit
-    0 emit ( alignment -- FIXME 64-bit arch )
+    4 emit ( capacity )
+    0 emit ( sign XXXX )
+    0 emit ( pad XXXX )
     ( bignum -- ) emit64 r> ;
 
 ( Special objects )

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 9ce426cbb88a84861e0aac51d23a17a6e1813037..c9200dd647afb1f1cac9507736ca04047ad4bc5e 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -1,5 +1,54 @@
 #include "factor.h"
 
+CELL upgraded_arithmetic_type(CELL type1, CELL type2)
+{
+       switch(type1)
+       {
+       case FIXNUM_TYPE:
+               return type2;
+       case BIGNUM_TYPE:
+               switch(type2)
+               {
+               case FIXNUM_TYPE:
+                       return type1;
+               default:
+                       return type2;
+               }
+       case RATIO_TYPE:
+               switch(type2)
+               {
+               case FIXNUM_TYPE:
+               case BIGNUM_TYPE:
+                       return type1;
+               default:
+                       return type2;
+               }
+       case FLOAT_TYPE:
+               switch(type2)
+               {
+               case FIXNUM_TYPE:
+               case BIGNUM_TYPE:
+               case RATIO_TYPE:
+                       return type1;
+               default:
+                       return type2;
+               }
+       case COMPLEX_TYPE:
+               switch(type2)
+               {
+               case FIXNUM_TYPE:
+               case BIGNUM_TYPE:
+               case RATIO_TYPE:
+               case FLOAT_TYPE:
+                       return type1;
+               default:
+                       return type2;
+               }
+       default:
+               return type1;
+       }
+}
+
 BIGNUM* fixnum_to_bignum(CELL n)
 {
        return bignum((BIGNUM_2)untag_fixnum_fast(n));

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 52cff586f0aac701ec30245972de845ee81c0f1e..4c003ccf3f48795eac116972d4afaf20fadc20b3 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -1,5 +1,6 @@
 #include "factor.h"
 
+CELL upgraded_arithmetic_type(CELL type1, CELL type2);
 BIGNUM* fixnum_to_bignum(CELL n);
 RATIO* fixnum_to_ratio(CELL n);
 FLOAT* fixnum_to_float(CELL n);
@@ -25,100 +26,19 @@ FLOAT* ratio_to_float(CELL n);
 #define BINARY_OP(OP) \
 CELL OP(CELL x, CELL y) \
 { \
-       switch(type_of(x)) \
+       switch(upgraded_arithmetic_type(type_of(x),type_of(y))) \
        { \
        case FIXNUM_TYPE: \
-\
-               switch(type_of(y)) \
-               { \
-               case FIXNUM_TYPE: \
-                       return OP##_fixnum(x,y); \
-               case RATIO_TYPE: \
-                       return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
-               case COMPLEX_TYPE: \
-                       return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
-               case BIGNUM_TYPE: \
-                       return OP##_bignum((CELL)fixnum_to_bignum(x),y); \
-               case FLOAT_TYPE: \
-                       return OP##_float((CELL)fixnum_to_float(x),y); \
-               default: \
-                       return OP##_anytype(x,y); \
-               } \
-\
-       case RATIO_TYPE: \
-\
-               switch(type_of(y)) \
-               { \
-               case FIXNUM_TYPE: \
-                       return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
-               case RATIO_TYPE: \
-                       return OP##_ratio(x,y); \
-               case COMPLEX_TYPE: \
-                       return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
-               case BIGNUM_TYPE: \
-                       return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
-               case FLOAT_TYPE: \
-                       return OP##_float((CELL)ratio_to_float(x),y); \
-               default: \
-                       return OP##_anytype(x,y); \
-               } \
-\
-       case COMPLEX_TYPE: \
-\
-               switch(type_of(y)) \
-               { \
-               case FIXNUM_TYPE: \
-                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
-               case RATIO_TYPE: \
-                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
-               case COMPLEX_TYPE: \
-                       return OP##_complex(x,y); \
-               case BIGNUM_TYPE: \
-                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
-               case FLOAT_TYPE: \
-                       return OP##_complex(x,(CELL)complex(y,tag_fixnum(0))); \
-               default: \
-                       return OP##_anytype(x,y); \
-               } \
-\
+               return OP##_fixnum(x,y); \
        case BIGNUM_TYPE: \
-        \
-               switch(type_of(y)) \
-               { \
-               case FIXNUM_TYPE: \
-                       return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
-               case RATIO_TYPE: \
-                       return OP##_ratio((CELL)bignum_to_ratio(x),y); \
-               case COMPLEX_TYPE: \
-                       return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
-               case BIGNUM_TYPE: \
-                       return OP##_bignum(x,y); \
-               case FLOAT_TYPE: \
-                       return OP##_float((CELL)bignum_to_float(x),y); \
-               default: \
-                       return OP##_anytype(x,y); \
-               } \
-\
+               return OP##_bignum(to_bignum(x),to_bignum(y)); \
+       case RATIO_TYPE: \
+               return OP##_ratio(to_ratio(x),to_ratio(y)); \
        case FLOAT_TYPE: \
-\
-               switch(type_of(y)) \
-               { \
-               case FIXNUM_TYPE: \
-                       return OP##_float(x,(CELL)fixnum_to_float(y)); \
-               case RATIO_TYPE: \
-                       return OP##_float(x,(CELL)ratio_to_float(y)); \
-               case COMPLEX_TYPE: \
-                       return OP##_complex((CELL)complex(x,tag_fixnum(0)),y); \
-               case BIGNUM_TYPE: \
-                       return OP##_float(x,(CELL)bignum_to_float(y)); \
-               case FLOAT_TYPE: \
-                       return OP##_float(x,y); \
-               default: \
-                       return OP##_anytype(x,y); \
-               } \
-\
+               return OP##_float(to_float(x),to_float(y)); \
+       case COMPLEX_TYPE: \
+               return OP##_complex(to_complex(x),to_complex(y)); \
        default: \
-\
                return OP##_anytype(x,y); \
        } \
 } \
@@ -131,21 +51,21 @@ void primitive_##OP(void) \
 
 #define BINARY_OP_INTEGER_ONLY(OP) \
 \
-CELL OP##_ratio(CELL x, CELL y) \
+CELL OP##_ratio(RATIO* x, RATIO* y) \
 { \
-       type_error(INTEGER_TYPE,x); \
+       type_error(INTEGER_TYPE,tag_ratio(x)); \
        return F; \
 } \
 \
-CELL OP##_complex(CELL x, CELL y) \
+CELL OP##_complex(COMPLEX* x, COMPLEX* y) \
 { \
-       type_error(INTEGER_TYPE,x); \
+       type_error(INTEGER_TYPE,tag_complex(x)); \
        return F; \
 } \
 \
-CELL OP##_float(CELL x, CELL y) \
+CELL OP##_float(FLOAT* x, FLOAT* y) \
 { \
-       type_error(INTEGER_TYPE,x); \
+       type_error(INTEGER_TYPE,tag_object(x)); \
        return F; \
 }
 
@@ -165,13 +85,13 @@ CELL OP(CELL x) \
        case FIXNUM_TYPE: \
                return OP##_fixnum(x); \
        case RATIO_TYPE: \
-               return OP##_ratio(x); \
+               return OP##_ratio((RATIO*)UNTAG(x)); \
        case COMPLEX_TYPE: \
-               return OP##_complex(x); \
+               return OP##_complex((COMPLEX*)UNTAG(x)); \
        case BIGNUM_TYPE: \
-               return OP##_bignum(x); \
+               return OP##_bignum((BIGNUM*)UNTAG(x)); \
        case FLOAT_TYPE: \
-               return OP##_float(x); \
+               return OP##_float((FLOAT*)UNTAG(x)); \
        default: \
                return OP##_anytype(x); \
        } \
@@ -184,21 +104,21 @@ void primitive_##OP(void) \
 
 #define UNARY_OP_INTEGER_ONLY(OP) \
 \
-CELL OP##_ratio(CELL x) \
+CELL OP##_ratio(RATIO* x) \
 { \
-       type_error(INTEGER_TYPE,x); \
+       type_error(INTEGER_TYPE,tag_ratio(x)); \
        return F; \
 } \
 \
-CELL OP##_complex(CELL x) \
+CELL OP##_complex(COMPLEX* x) \
 { \
-       type_error(INTEGER_TYPE,x); \
+       type_error(INTEGER_TYPE,tag_complex(x)); \
        return F; \
 } \
 \
-CELL OP##_float(CELL x) \
+CELL OP##_float(FLOAT* x) \
 { \
-       type_error(INTEGER_TYPE,x); \
+       type_error(INTEGER_TYPE,tag_object(x)); \
        return F; \
 }
 

diff --git a/native/bignum.c b/native/bignum.c
index 4d009d1f7c74bf33e1dea63ca383371da8ca716b..b4c0358588a0817b6ebeca253ad5957892a5b07e 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -33,28 +33,24 @@ void primitive_to_bignum(void)
        drepl(tag_object(to_bignum(dpeek())));
 }
 
-CELL number_eq_bignum(CELL x, CELL y)
+CELL number_eq_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               == ((BIGNUM*)UNTAG(y))->n);
+       return tag_boolean(x->n == y->n);
 }
 
-CELL add_bignum(CELL x, CELL y)
+CELL add_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               + ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n + y->n));
 }
 
-CELL subtract_bignum(CELL x, CELL y)
+CELL subtract_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               - ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n - y->n));
 }
 
-CELL multiply_bignum(CELL x, CELL y)
+CELL multiply_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               * ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n * y->n));
 }
 
 BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
@@ -84,10 +80,10 @@ BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
        }
 }
 
-CELL divide_bignum(CELL x, CELL y)
+CELL divide_bignum(BIGNUM* x, BIGNUM* y)
 {
-       BIGNUM_2 _x = ((BIGNUM*)UNTAG(x))->n;
-       BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n;
+       BIGNUM_2 _x = x->n;
+       BIGNUM_2 _y = y->n;
        BIGNUM_2 gcd;
 
        if(_y == 0)
@@ -118,88 +114,75 @@ CELL divide_bignum(CELL x, CELL y)
        }
 }
 
-CELL divint_bignum(CELL x, CELL y)
+CELL divint_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               / ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n / y->n));
 }
 
-CELL divfloat_bignum(CELL x, CELL y)
+CELL divfloat_bignum(BIGNUM* x, BIGNUM* y)
 {
-       BIGNUM_2 _x = ((BIGNUM*)UNTAG(x))->n;
-       BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n;
+       BIGNUM_2 _x = x->n;
+       BIGNUM_2 _y = y->n;
        return tag_object(make_float((double)_x / (double)_y));
 }
 
-CELL divmod_bignum(CELL x, CELL y)
+CELL divmod_bignum(BIGNUM* x, BIGNUM* y)
 {
-       dpush(tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               / ((BIGNUM*)UNTAG(y))->n)));
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               % ((BIGNUM*)UNTAG(y))->n));
+       dpush(tag_object(bignum(x->n / y->n)));
+       return tag_object(bignum(x->n % y->n));
 }
 
-CELL mod_bignum(CELL x, CELL y)
+CELL mod_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               % ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n % y->n));
 }
 
-CELL and_bignum(CELL x, CELL y)
+CELL and_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               & ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n & y->n));
 }
 
-CELL or_bignum(CELL x, CELL y)
+CELL or_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               | ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n | y->n));
 }
 
-CELL xor_bignum(CELL x, CELL y)
+CELL xor_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               ^ ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n ^ y->n));
 }
 
-CELL shiftleft_bignum(CELL x, CELL y)
+CELL shiftleft_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               << ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n << y->n));
 }
 
-CELL shiftright_bignum(CELL x, CELL y)
+CELL shiftright_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               >> ((BIGNUM*)UNTAG(y))->n));
+       return tag_object(bignum(x->n >> y->n));
 }
 
-CELL less_bignum(CELL x, CELL y)
+CELL less_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               < ((BIGNUM*)UNTAG(y))->n);
+       return tag_boolean(x->n < y->n);
 }
 
-CELL lesseq_bignum(CELL x, CELL y)
+CELL lesseq_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               <= ((BIGNUM*)UNTAG(y))->n);
+       return tag_boolean(x->n <= y->n);
 }
 
-CELL greater_bignum(CELL x, CELL y)
+CELL greater_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               > ((BIGNUM*)UNTAG(y))->n);
+       return tag_boolean(x->n > y->n);
 }
 
-CELL greatereq_bignum(CELL x, CELL y)
+CELL greatereq_bignum(BIGNUM* x, BIGNUM* y)
 {
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               >= ((BIGNUM*)UNTAG(y))->n);
+       return tag_boolean(x->n >= y->n);
 }
 
-CELL not_bignum(CELL x)
+CELL not_bignum(BIGNUM* x)
 {
-       return tag_object(bignum(~((BIGNUM*)UNTAG(x))->n));
+       return tag_object(bignum(~(x->n)));
 }

diff --git a/native/bignum.h b/native/bignum.h
index b8208f325a3519622b208c9f8a911b03bb42985d..ecf6468f0822fb57e26034c81fec6b7eb5955e4c 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -32,23 +32,23 @@ INLINE BIGNUM* untag_bignum(CELL tagged)
 void primitive_bignump(void);
 BIGNUM* to_bignum(CELL tagged);
 void primitive_to_bignum(void);
-CELL number_eq_bignum(CELL x, CELL y);
-CELL add_bignum(CELL x, CELL y);
-CELL subtract_bignum(CELL x, CELL y);
-CELL multiply_bignum(CELL x, CELL y);
+CELL number_eq_bignum(BIGNUM* x, BIGNUM* y);
+CELL add_bignum(BIGNUM* x, BIGNUM* y);
+CELL subtract_bignum(BIGNUM* x, BIGNUM* y);
+CELL multiply_bignum(BIGNUM* x, BIGNUM* y);
 BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y);
-CELL divide_bignum(CELL x, CELL y);
-CELL divint_bignum(CELL x, CELL y);
-CELL divfloat_bignum(CELL x, CELL y);
-CELL divmod_bignum(CELL x, CELL y);
-CELL mod_bignum(CELL x, CELL y);
-CELL and_bignum(CELL x, CELL y);
-CELL or_bignum(CELL x, CELL y);
-CELL xor_bignum(CELL x, CELL y);
-CELL shiftleft_bignum(CELL x, CELL y);
-CELL shiftright_bignum(CELL x, CELL y);
-CELL less_bignum(CELL x, CELL y);
-CELL lesseq_bignum(CELL x, CELL y);
-CELL greater_bignum(CELL x, CELL y);
-CELL greatereq_bignum(CELL x, CELL y);
-CELL not_bignum(CELL x);
+CELL divide_bignum(BIGNUM* x, BIGNUM* y);
+CELL divint_bignum(BIGNUM* x, BIGNUM* y);
+CELL divfloat_bignum(BIGNUM* x, BIGNUM* y);
+CELL divmod_bignum(BIGNUM* x, BIGNUM* y);
+CELL mod_bignum(BIGNUM* x, BIGNUM* y);
+CELL and_bignum(BIGNUM* x, BIGNUM* y);
+CELL or_bignum(BIGNUM* x, BIGNUM* y);
+CELL xor_bignum(BIGNUM* x, BIGNUM* y);
+CELL shiftleft_bignum(BIGNUM* x, BIGNUM* y);
+CELL shiftright_bignum(BIGNUM* x, BIGNUM* y);
+CELL less_bignum(BIGNUM* x, BIGNUM* y);
+CELL lesseq_bignum(BIGNUM* x, BIGNUM* y);
+CELL greater_bignum(BIGNUM* x, BIGNUM* y);
+CELL greatereq_bignum(BIGNUM* x, BIGNUM* y);
+CELL not_bignum(BIGNUM* x);

diff --git a/native/complex.c b/native/complex.c
index 0949e8c9fc159ff5ecbb4016ad7b6dac4ce9bfc9..e9f201be40e1dc9fe9b4620c148bdda7d2618f2e 100644 (file)
--- a/native/complex.c
+++ b/native/complex.c
@@ -8,6 +8,23 @@ COMPLEX* complex(CELL real, CELL imaginary)
        return complex;
 }
 
+COMPLEX* to_complex(CELL x)
+{
+       switch(type_of(x))
+       {
+       case FIXNUM_TYPE:
+       case BIGNUM_TYPE:
+       case FLOAT_TYPE:
+       case RATIO_TYPE:
+               return complex(x,0);
+       case COMPLEX_TYPE:
+               return (COMPLEX*)UNTAG(x);
+       default:
+               type_error(NUMBER_TYPE,x);
+               return NULL;
+       }
+}
+
 CELL possibly_complex(CELL real, CELL imaginary)
 {
        if(zerop(imaginary))
@@ -35,7 +52,7 @@ void primitive_real(void)
                drepl(untag_complex(dpeek())->real);
                break;
        default:
-               type_error(COMPLEX_TYPE,dpeek());
+               type_error(NUMBER_TYPE,dpeek());
                break;
        }
 }
@@ -54,7 +71,7 @@ void primitive_imaginary(void)
                drepl(untag_complex(dpeek())->imaginary);
                break;
        default:
-               type_error(COMPLEX_TYPE,dpeek());
+               type_error(NUMBER_TYPE,dpeek());
                break;
        }
 }
@@ -95,68 +112,58 @@ void primitive_from_rect(void)
        dpush(possibly_complex(real,imaginary));
 }
 
-CELL number_eq_complex(CELL x, CELL y)
+CELL number_eq_complex(COMPLEX* x, COMPLEX* y)
 {
-       COMPLEX* cx = (COMPLEX*)UNTAG(x);
-       COMPLEX* cy = (COMPLEX*)UNTAG(y);
        return tag_boolean(
-               untag_boolean(number_eq(cx->real,cy->real)) &&
-               untag_boolean(number_eq(cx->imaginary,cy->imaginary)));
+               untag_boolean(number_eq(x->real,y->real)) &&
+               untag_boolean(number_eq(x->imaginary,y->imaginary)));
 }
 
-CELL add_complex(CELL x, CELL y)
+CELL add_complex(COMPLEX* x, COMPLEX* y)
 {
-       COMPLEX* cx = (COMPLEX*)UNTAG(x);
-       COMPLEX* cy = (COMPLEX*)UNTAG(y);
        return possibly_complex(
-               add(cx->real,cy->real),
-               add(cx->imaginary,cy->imaginary));
+               add(x->real,y->real),
+               add(x->imaginary,y->imaginary));
 }
 
-CELL subtract_complex(CELL x, CELL y)
+CELL subtract_complex(COMPLEX* x, COMPLEX* y)
 {
-       COMPLEX* cx = (COMPLEX*)UNTAG(x);
-       COMPLEX* cy = (COMPLEX*)UNTAG(y);
        return possibly_complex(
-               subtract(cx->real,cy->real),
-               subtract(cx->imaginary,cy->imaginary));
+               subtract(x->real,y->real),
+               subtract(x->imaginary,y->imaginary));
 }
 
-CELL multiply_complex(CELL x, CELL y)
+CELL multiply_complex(COMPLEX* x, COMPLEX* y)
 {
-       COMPLEX* cx = (COMPLEX*)UNTAG(x);
-       COMPLEX* cy = (COMPLEX*)UNTAG(y);
        return possibly_complex(
                subtract(
-                       multiply(cx->real,cy->real),
-                       multiply(cx->imaginary,cy->imaginary)),
+                       multiply(x->real,y->real),
+                       multiply(x->imaginary,y->imaginary)),
                add(
-                       multiply(cx->real,cy->imaginary),
-                       multiply(cx->imaginary,cy->real)));
+                       multiply(x->real,y->imaginary),
+                       multiply(x->imaginary,y->real)));
 }
 
 #define COMPLEX_DIVIDE(x,y) \
-       COMPLEX* cx = (COMPLEX*)UNTAG(x); \
-       COMPLEX* cy = (COMPLEX*)UNTAG(y); \
 \
        CELL mag = add( \
-               multiply(cy->real,cy->real), \
-               multiply(cy->imaginary,cy->imaginary)); \
+               multiply(y->real,y->real), \
+               multiply(y->imaginary,y->imaginary)); \
 \
        CELL r = add( \
-               multiply(cx->real,cy->real), \
-               multiply(cx->imaginary,cy->imaginary)); \
+               multiply(x->real,y->real), \
+               multiply(x->imaginary,y->imaginary)); \
        CELL i = subtract( \
-               multiply(cx->imaginary,cy->real), \
-               multiply(cx->real,cy->imaginary));
+               multiply(x->imaginary,y->real), \
+               multiply(x->real,y->imaginary));
 
-CELL divide_complex(CELL x, CELL y)
+CELL divide_complex(COMPLEX* x, COMPLEX* y)
 {
        COMPLEX_DIVIDE(x,y);
        return possibly_complex(divide(r,mag),divide(i,mag));
 }
 
-CELL divfloat_complex(CELL x, CELL y)
+CELL divfloat_complex(COMPLEX* x, COMPLEX* y)
 {
        COMPLEX_DIVIDE(x,y);
        return possibly_complex(divfloat(r,mag),divfloat(i,mag));
@@ -165,25 +172,25 @@ CELL divfloat_complex(CELL x, CELL y)
 #define INCOMPARABLE(x,y) general_error(ERROR_INCOMPARABLE, \
        tag_cons(cons(RETAG(x,COMPLEX_TYPE),RETAG(y,COMPLEX_TYPE))));
 
-CELL less_complex(CELL x, CELL y)
+CELL less_complex(COMPLEX* x, COMPLEX* y)
 {
        INCOMPARABLE(x,y);
        return F;
 }
 
-CELL lesseq_complex(CELL x, CELL y)
+CELL lesseq_complex(COMPLEX* x, COMPLEX* y)
 {
        INCOMPARABLE(x,y);
        return F;
 }
 
-CELL greater_complex(CELL x, CELL y)
+CELL greater_complex(COMPLEX* x, COMPLEX* y)
 {
        INCOMPARABLE(x,y);
        return F;
 }
 
-CELL greatereq_complex(CELL x, CELL y)
+CELL greatereq_complex(COMPLEX* x, COMPLEX* y)
 {
        INCOMPARABLE(x,y);
        return F;

diff --git a/native/complex.h b/native/complex.h
index cb0fc751e4b9d7f9ba197f1a7d6d9dc5e5e36a97..7fffa7479efee817c90bc66aeb2851d09de1ecd3 100644 (file)
--- a/native/complex.h
+++ b/native/complex.h
@@ -15,6 +15,7 @@ INLINE CELL tag_complex(COMPLEX* complex)
 }
 
 COMPLEX* complex(CELL real, CELL imaginary);
+COMPLEX* to_complex(CELL x);
 CELL possibly_complex(CELL real, CELL imaginary);
 
 void primitive_complexp(void);
@@ -22,13 +23,13 @@ void primitive_real(void);
 void primitive_imaginary(void);
 void primitive_to_rect(void);
 void primitive_from_rect(void);
-CELL number_eq_complex(CELL x, CELL y);
-CELL add_complex(CELL x, CELL y);
-CELL subtract_complex(CELL x, CELL y);
-CELL multiply_complex(CELL x, CELL y);
-CELL divide_complex(CELL x, CELL y);
-CELL divfloat_complex(CELL x, CELL y);
-CELL less_complex(CELL x, CELL y);
-CELL lesseq_complex(CELL x, CELL y);
-CELL greater_complex(CELL x, CELL y);
-CELL greatereq_complex(CELL x, CELL y);
+CELL number_eq_complex(COMPLEX* x, COMPLEX* y);
+CELL add_complex(COMPLEX* x, COMPLEX* y);
+CELL subtract_complex(COMPLEX* x, COMPLEX* y);
+CELL multiply_complex(COMPLEX* x, COMPLEX* y);
+CELL divide_complex(COMPLEX* x, COMPLEX* y);
+CELL divfloat_complex(COMPLEX* x, COMPLEX* y);
+CELL less_complex(COMPLEX* x, COMPLEX* y);
+CELL lesseq_complex(COMPLEX* x, COMPLEX* y);
+CELL greater_complex(COMPLEX* x, COMPLEX* y);
+CELL greatereq_complex(COMPLEX* x, COMPLEX* y);

diff --git a/native/float.c b/native/float.c
index a3f5d9786a94d21dc7564cac3d1c3867233f0291..9982e3fce7573f797b759f03eb04705b5bc1d984 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -54,64 +54,54 @@ void primitive_float_to_bits(void)
        drepl(tag_object(bignum(f_raw)));
 }
 
-CELL number_eq_float(CELL x, CELL y)
+CELL number_eq_float(FLOAT* x, FLOAT* y)
 {
-       return tag_boolean(((FLOAT*)UNTAG(x))->n
-               == ((FLOAT*)UNTAG(y))->n);
+       return tag_boolean(x->n == y->n);
 }
 
-CELL add_float(CELL x, CELL y)
+CELL add_float(FLOAT* x, FLOAT* y)
 {
-       return tag_object(make_float(((FLOAT*)UNTAG(x))->n
-               + ((FLOAT*)UNTAG(y))->n));
+       return tag_object(make_float(x->n + y->n));
 }
 
-CELL subtract_float(CELL x, CELL y)
+CELL subtract_float(FLOAT* x, FLOAT* y)
 {
-       return tag_object(make_float(((FLOAT*)UNTAG(x))->n
-               - ((FLOAT*)UNTAG(y))->n));
+       return tag_object(make_float(x->n - y->n));
 }
 
-CELL multiply_float(CELL x, CELL y)
+CELL multiply_float(FLOAT* x, FLOAT* y)
 {
-       return tag_object(make_float(((FLOAT*)UNTAG(x))->n
-               * ((FLOAT*)UNTAG(y))->n));
+       return tag_object(make_float(x->n * y->n));
 }
 
-CELL divide_float(CELL x, CELL y)
+CELL divide_float(FLOAT* x, FLOAT* y)
 {
-       return tag_object(make_float(((FLOAT*)UNTAG(x))->n
-               / ((FLOAT*)UNTAG(y))->n));
+       return tag_object(make_float(x->n / y->n));
 }
 
-CELL divfloat_float(CELL x, CELL y)
+CELL divfloat_float(FLOAT* x, FLOAT* y)
 {
-       return tag_object(make_float(((FLOAT*)UNTAG(x))->n
-               / ((FLOAT*)UNTAG(y))->n));
+       return tag_object(make_float(x->n / y->n));
 }
 
-CELL less_float(CELL x, CELL y)
+CELL less_float(FLOAT* x, FLOAT* y)
 {
-       return tag_boolean(((FLOAT*)UNTAG(x))->n
-               < ((FLOAT*)UNTAG(y))->n);
+       return tag_boolean(x->n < y->n);
 }
 
-CELL lesseq_float(CELL x, CELL y)
+CELL lesseq_float(FLOAT* x, FLOAT* y)
 {
-       return tag_boolean(((FLOAT*)UNTAG(x))->n
-               <= ((FLOAT*)UNTAG(y))->n);
+       return tag_boolean(x->n <= y->n);
 }
 
-CELL greater_float(CELL x, CELL y)
+CELL greater_float(FLOAT* x, FLOAT* y)
 {
-       return tag_boolean(((FLOAT*)UNTAG(x))->n
-               > ((FLOAT*)UNTAG(y))->n);
+       return tag_boolean(x->n > y->n);
 }
 
-CELL greatereq_float(CELL x, CELL y)
+CELL greatereq_float(FLOAT* x, FLOAT* y)
 {
-       return tag_boolean(((FLOAT*)UNTAG(x))->n
-               >= ((FLOAT*)UNTAG(y))->n);
+       return tag_boolean(x->n >= y->n);
 }
 
 void primitive_facos(void)

diff --git a/native/float.h b/native/float.h
index b138237519d3808f8e79f3648ddb9b12eb3470d0..86bccaa21d49312e5c4731c825733b241f4e3c98 100644 (file)
--- a/native/float.h
+++ b/native/float.h
@@ -32,16 +32,16 @@ void primitive_str_to_float(void);
 void primitive_float_to_str(void);
 void primitive_float_to_bits(void);
 
-CELL number_eq_float(CELL x, CELL y);
-CELL add_float(CELL x, CELL y);
-CELL subtract_float(CELL x, CELL y);
-CELL multiply_float(CELL x, CELL y);
-CELL divide_float(CELL x, CELL y);
-CELL divfloat_float(CELL x, CELL y);
-CELL less_float(CELL x, CELL y);
-CELL lesseq_float(CELL x, CELL y);
-CELL greater_float(CELL x, CELL y);
-CELL greatereq_float(CELL x, CELL y);
+CELL number_eq_float(FLOAT* x, FLOAT* y);
+CELL add_float(FLOAT* x, FLOAT* y);
+CELL subtract_float(FLOAT* x, FLOAT* y);
+CELL multiply_float(FLOAT* x, FLOAT* y);
+CELL divide_float(FLOAT* x, FLOAT* y);
+CELL divfloat_float(FLOAT* x, FLOAT* y);
+CELL less_float(FLOAT* x, FLOAT* y);
+CELL lesseq_float(FLOAT* x, FLOAT* y);
+CELL greater_float(FLOAT* x, FLOAT* y);
+CELL greatereq_float(FLOAT* x, FLOAT* y);
 
 void primitive_facos(void);
 void primitive_fasin(void);

diff --git a/native/ratio.c b/native/ratio.c
index e581aaebf9eeb2995f815abbe8ed9d0b06727955..c131ae994362fddea1bd209678fd81061e2afcdc 100644 (file)
--- a/native/ratio.c
+++ b/native/ratio.c
@@ -8,6 +8,21 @@ RATIO* ratio(CELL numerator, CELL denominator)
        return ratio;
 }
 
+RATIO* to_ratio(CELL x)
+{
+       switch(type_of(x))
+       {
+       case FIXNUM_TYPE:
+       case BIGNUM_TYPE:
+               return ratio(x,tag_fixnum(1));
+       case RATIO_TYPE:
+               return (RATIO*)UNTAG(x);
+       default:
+               type_error(RATIONAL_TYPE,x);
+               return NULL;
+       }
+}
+
 void primitive_ratiop(void)
 {
        drepl(tag_boolean(typep(RATIO_TYPE,dpeek())));
@@ -47,88 +62,68 @@ void primitive_denominator(void)
        }
 }
 
-CELL number_eq_ratio(CELL x, CELL y)
+CELL number_eq_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
        return tag_boolean(
-               untag_boolean(number_eq(rx->numerator,ry->numerator)) &&
-               untag_boolean(number_eq(rx->denominator,ry->denominator)));
+               untag_boolean(number_eq(x->numerator,y->numerator)) &&
+               untag_boolean(number_eq(x->denominator,y->denominator)));
 }
 
-CELL add_ratio(CELL x, CELL y)
+CELL add_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return divide(add(multiply(rx->numerator,ry->denominator),
-               multiply(rx->denominator,ry->numerator)),
-               multiply(rx->denominator,ry->denominator));
+       return divide(add(multiply(x->numerator,y->denominator),
+               multiply(x->denominator,y->numerator)),
+               multiply(x->denominator,y->denominator));
 }
 
-CELL subtract_ratio(CELL x, CELL y)
+CELL subtract_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return divide(subtract(multiply(rx->numerator,ry->denominator),
-               multiply(rx->denominator,ry->numerator)),
-               multiply(rx->denominator,ry->denominator));
+       return divide(subtract(multiply(x->numerator,y->denominator),
+               multiply(x->denominator,y->numerator)),
+               multiply(x->denominator,y->denominator));
 }
 
-CELL multiply_ratio(CELL x, CELL y)
+CELL multiply_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
        return divide(
-               multiply(rx->numerator,ry->numerator),
-               multiply(rx->denominator,ry->denominator));
+               multiply(x->numerator,y->numerator),
+               multiply(x->denominator,y->denominator));
 }
 
-CELL divide_ratio(CELL x, CELL y)
+CELL divide_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
        return divide(
-               multiply(rx->numerator,ry->denominator),
-               multiply(rx->denominator,ry->numerator));
+               multiply(x->numerator,y->denominator),
+               multiply(x->denominator,y->numerator));
 }
 
-CELL divfloat_ratio(CELL x, CELL y)
+CELL divfloat_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
        return divfloat(
-               multiply(rx->numerator,ry->denominator),
-               multiply(rx->denominator,ry->numerator));
+               multiply(x->numerator,y->denominator),
+               multiply(x->denominator,y->numerator));
 }
 
-CELL less_ratio(CELL x, CELL y)
+CELL less_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return less(multiply(rx->numerator,ry->denominator),
-               multiply(ry->numerator,rx->denominator));
+       return less(multiply(x->numerator,y->denominator),
+               multiply(y->numerator,x->denominator));
 }
 
-CELL lesseq_ratio(CELL x, CELL y)
+CELL lesseq_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return lesseq(multiply(rx->numerator,ry->denominator),
-               multiply(ry->numerator,rx->denominator));
+       return lesseq(multiply(x->numerator,y->denominator),
+               multiply(y->numerator,x->denominator));
 }
 
-CELL greater_ratio(CELL x, CELL y)
+CELL greater_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return greater(multiply(rx->numerator,ry->denominator),
-               multiply(ry->numerator,rx->denominator));
+       return greater(multiply(x->numerator,y->denominator),
+               multiply(y->numerator,x->denominator));
 }
 
-CELL greatereq_ratio(CELL x, CELL y)
+CELL greatereq_ratio(RATIO* x, RATIO* y)
 {
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return greatereq(multiply(rx->numerator,ry->denominator),
-               multiply(ry->numerator,rx->denominator));
+       return greatereq(multiply(x->numerator,y->denominator),
+               multiply(y->numerator,x->denominator));
 }

diff --git a/native/ratio.h b/native/ratio.h
index cfb0d89cc118ed80079ddb64b21cdc526ac916b4..eedde3b7a28e286b687a68cd999a8bab24028607 100644 (file)
--- a/native/ratio.h
+++ b/native/ratio.h
@@ -15,17 +15,18 @@ INLINE CELL tag_ratio(RATIO* ratio)
 }
 
 RATIO* ratio(CELL numerator, CELL denominator);
+RATIO* to_ratio(CELL x);
 
 void primitive_ratiop(void);
 void primitive_numerator(void);
 void primitive_denominator(void);
-CELL number_eq_ratio(CELL x, CELL y);
-CELL add_ratio(CELL x, CELL y);
-CELL subtract_ratio(CELL x, CELL y);
-CELL multiply_ratio(CELL x, CELL y);
-CELL divide_ratio(CELL x, CELL y);
-CELL divfloat_ratio(CELL x, CELL y);
-CELL less_ratio(CELL x, CELL y);
-CELL lesseq_ratio(CELL x, CELL y);
-CELL greater_ratio(CELL x, CELL y);
-CELL greatereq_ratio(CELL x, CELL y);
+CELL number_eq_ratio(RATIO* x, RATIO* y);
+CELL add_ratio(RATIO* x, RATIO* y);
+CELL subtract_ratio(RATIO* x, RATIO* y);
+CELL multiply_ratio(RATIO* x, RATIO* y);
+CELL divide_ratio(RATIO* x, RATIO* y);
+CELL divfloat_ratio(RATIO* x, RATIO* y);
+CELL less_ratio(RATIO* x, RATIO* y);
+CELL lesseq_ratio(RATIO* x, RATIO* y);
+CELL greater_ratio(RATIO* x, RATIO* y);
+CELL greatereq_ratio(RATIO* x, RATIO* y);