clean up native arithmetic code

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index a36f3c9555768ffcf2a759f58df0fde307ebf83a..ae2c1b4d749a5fa8a0f1080b950743f855276e6e 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,7 +1,7 @@
 + native:\r
 \r
 ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ]\r
-\r
+- errors: don't show .factor-rc\r
 - ratio comparsion, ratio bitops that coerce to integers\r
 - handle division by zero\r
 - fixup-words is crusty\r

diff --git a/doc/devel-guide.lyx b/doc/devel-guide.lyx
index 0c19007b91968aceec5fcf333f435e1aa9da3a0f..915e3cbb0b5946a8bf373f627f02728dba4c0354 100644 (file)
--- a/doc/devel-guide.lyx
+++ b/doc/devel-guide.lyx
@@ -4202,26 +4202,10 @@ Studying Factor                                   0:30
 Paperwork                                         1:05
 \layout Subsection
 
-The complete program
-\layout Standard
-
-TODO operations:
-\layout Standard
-
-- print a time difference as hours:minutes
-\layout Standard
-
-- begin work
-\layout Standard
-
-- end work & annotate
-\layout Standard
-
-- print an invoice, takes hourly rate as a parameter.
- do simple formatted output, using 'spaces' and 'pad-string'.
+The main menu
 \layout Standard
 
-use a vector to store [ annotation | time ] pairs, pass the vector in
+Reading a number, showing a menu
 \layout Section
 
 Variables and namespaces

diff --git a/native/arithmetic.c b/native/arithmetic.c
index 16dfc96e156038782a48cc181b0a216f7fc4bc22..d063923780ee4ebd62f8bb585cba21ed1a9d0588 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -1,70 +1,42 @@
 #include "factor.h"
 
-void primitive_numberp(void)
+BIGNUM* fixnum_to_bignum(CELL n)
 {
-       check_non_empty(env.dt);
-
-       switch(type_of(env.dt))
-       {
-       case FIXNUM_TYPE:
-       case BIGNUM_TYPE:
-       case RATIO_TYPE:
-               env.dt = T;
-               break;
-       default:
-               env.dt = F;
-               break;
-       }
+       return bignum((BIGNUM_2)untag_fixnum_fast(n));
 }
 
-FIXNUM to_fixnum(CELL tagged)
+RATIO* fixnum_to_ratio(CELL n)
 {
-       RATIO* r;
+       return ratio(n,tag_fixnum(1));
+}
 
-       switch(type_of(tagged))
-       {
-       case FIXNUM_TYPE:
-               return untag_fixnum_fast(tagged);
-       case BIGNUM_TYPE:
-               return bignum_to_fixnum(tagged);
-       case RATIO_TYPE:
-               r = (RATIO*)UNTAG(tagged);
-               return to_fixnum(divint(r->numerator,r->denominator));
-       default:
-               type_error(FIXNUM_TYPE,tagged);
-               return -1; /* can't happen */
-       }
+FIXNUM bignum_to_fixnum(CELL tagged)
+{
+       return (FIXNUM)(untag_bignum(tagged)->n);
 }
 
-void primitive_to_fixnum(void)
+RATIO* bignum_to_ratio(CELL n)
 {
-       env.dt = tag_fixnum(to_fixnum(env.dt));
+       return ratio(n,tag_fixnum(1));
 }
 
-BIGNUM* to_bignum(CELL tagged)
+void primitive_numberp(void)
 {
-       RATIO* r;
+       check_non_empty(env.dt);
 
-       switch(type_of(tagged))
+       switch(type_of(env.dt))
        {
        case FIXNUM_TYPE:
-               return fixnum_to_bignum(tagged);
        case BIGNUM_TYPE:
-               return (BIGNUM*)UNTAG(tagged);
        case RATIO_TYPE:
-               r = (RATIO*)UNTAG(tagged);
-               return to_bignum(divint(r->numerator,r->denominator));
+               env.dt = T;
+               break;
        default:
-               type_error(BIGNUM_TYPE,tagged);
-               return NULL; /* can't happen */
+               env.dt = F;
+               break;
        }
 }
 
-void primitive_to_bignum(void)
-{
-       env.dt = tag_bignum(to_bignum(env.dt));
-}
-
 CELL to_integer(CELL tagged)
 {
        RATIO* r;
@@ -89,463 +61,26 @@ void primitive_to_integer(void)
 }
 
 /* EQUALITY */
-INLINE CELL number_eq_fixnum(CELL x, CELL y)
-{
-       return tag_boolean(x == y);
-}
-
-CELL number_eq_bignum(CELL x, CELL y)
-{
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               == ((BIGNUM*)UNTAG(y))->n);
-}
-
-CELL number_eq_ratio(CELL x, CELL 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)));
-}
-
 CELL number_eq_anytype(CELL x, CELL y)
 {
        return F;
 }
 
-BINARY_OP(number_eq,true)
-
-/* ADDITION */
-INLINE CELL add_fixnum(CELL x, CELL y)
-{
-       CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y));
-}
-
-CELL add_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               + ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL add_ratio(CELL x, CELL 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));
-}
-
-BINARY_OP(add,false)
-
-/* SUBTRACTION */
-INLINE CELL subtract_fixnum(CELL x, CELL y)
-{
-       CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
-}
-
-CELL subtract_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               - ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL subtract_ratio(CELL x, CELL 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));
-}
-
-BINARY_OP(subtract,false)
-
-/* MULTIPLICATION */
-INLINE CELL multiply_fixnum(CELL x, CELL y)
-{
-       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               * (BIGNUM_2)untag_fixnum_fast(y));
-}
-
-CELL multiply_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               * ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL multiply_ratio(CELL x, CELL y)
-{
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return divide(
-               multiply(rx->numerator,ry->numerator),
-               multiply(rx->denominator,ry->denominator));
-}
-
-BINARY_OP(multiply,false)
-
-FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y)
-{
-       FIXNUM t;
-
-       if(x < 0)
-               x = -x;
-       if(y < 0)
-               y = -y;
-
-       if(x > y)
-       {
-               t = x;
-               x = y;
-               y = t;
-       }
-
-       for(;;)
-       {
-               if(x == 0)
-                       return y;
-
-               t = y % x;
-               y = x;
-               x = t;
-       }
-}
-
-BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
-{
-       BIGNUM_2 t;
-
-       if(x < 0)
-               x = -x;
-       if(y < 0)
-               y = -y;
-
-       if(x > y)
-       {
-               t = x;
-               x = y;
-               y = t;
-       }
-
-       for(;;)
-       {
-               if(x == 0)
-                       return y;
-
-               t = y % x;
-               y = x;
-               x = t;
-       }
-}
-
-/* DIVISION */
-INLINE CELL divide_fixnum(CELL x, CELL y)
-{
-       FIXNUM _x = untag_fixnum_fast(x);
-       FIXNUM _y = untag_fixnum_fast(y);
-
-       if(_y == 0)
-       {
-               /* FIXME */
-               abort();
-       }
-       else if(_y < 0)
-       {
-               _x = -_x;
-               _y = -_y;
-       }
-
-       FIXNUM gcd = gcd_fixnum(_x,_y);
-       if(gcd != 1)
-       {
-               _x /= gcd;
-               _y /= gcd;
-       }
-
-       if(_y == 1)
-               return tag_fixnum(_x);
-       else
-               return tag_ratio(ratio(tag_fixnum(_x),tag_fixnum(_y)));
-}
-
-CELL divide_bignum(CELL x, CELL y)
-{
-       BIGNUM_2 _x = ((BIGNUM*)UNTAG(x))->n;
-       BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n;
-
-       if(_y == 0)
-       {
-               /* FIXME */
-               abort();
-       }
-       else if(_y < 0)
-       {
-               _x = -_x;
-               _y = -_y;
-       }
-
-       BIGNUM_2 gcd = gcd_bignum(_x,_y);
-       if(gcd != 1)
-       {
-               _x /= gcd;
-               _y /= gcd;
-       }
-
-       if(_y == 1)
-               return tag_object(bignum(_x));
-       else
-       {
-               return tag_ratio(ratio(
-                       tag_bignum(bignum(_x)),
-                       tag_bignum(bignum(_y))));
-       }
-}
-
-CELL divide_ratio(CELL x, CELL y)
-{
-       RATIO* rx = (RATIO*)UNTAG(x);
-       RATIO* ry = (RATIO*)UNTAG(y);
-       return divide(
-               multiply(rx->numerator,ry->denominator),
-               multiply(rx->denominator,ry->numerator));
-}
-
-BINARY_OP(divide,false)
-
-/* DIVINT */
-INLINE CELL divint_fixnum(CELL x, CELL y)
-{
-       /* division takes common factor of 8 out. */
-       return tag_fixnum(x / y);
-}
-
-CELL divint_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               / ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL divint_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(divint,false)
-
-/* DIVMOD */
-INLINE CELL divmod_fixnum(CELL x, CELL y)
-{
-       ldiv_t q = ldiv(x,y);
-       /* division takes common factor of 8 out. */
-       dpush(tag_fixnum(q.quot));
-       return q.rem;
-}
-
-CELL divmod_bignum(CELL x, CELL 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));
-}
-
-CELL divmod_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(divmod,false)
-
-/* MOD */
-INLINE CELL mod_fixnum(CELL x, CELL y)
-{
-       return x % y;
-}
-
-CELL mod_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               % ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL mod_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(mod,false)
-
-/* AND */
-INLINE CELL and_fixnum(CELL x, CELL y)
-{
-       return x & y;
-}
-
-CELL and_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               & ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL and_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(and,false)
-
-/* OR */
-INLINE CELL or_fixnum(CELL x, CELL y)
-{
-       return x | y;
-}
-
-CELL or_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               | ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL or_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(or,false)
-
-/* XOR */
-INLINE CELL xor_fixnum(CELL x, CELL y)
-{
-       return x ^ y;
-}
-
-CELL xor_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               ^ ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL xor_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(xor,false)
-
-/* SHIFTLEFT */
-INLINE CELL shiftleft_fixnum(CELL x, CELL y)
-{
-       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               << (BIGNUM_2)untag_fixnum_fast(y));
-}
-
-CELL shiftleft_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               << ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL shiftleft_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(shiftleft,false)
-
-/* SHIFTRIGHT */
-INLINE CELL shiftright_fixnum(CELL x, CELL y)
-{
-       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
-               >> (BIGNUM_2)untag_fixnum_fast(y));
-}
-
-CELL shiftright_bignum(CELL x, CELL y)
-{
-       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
-               >> ((BIGNUM*)UNTAG(y))->n));
-}
-
-CELL shiftright_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(shiftright,false)
-
-/* LESS */
-INLINE CELL less_fixnum(CELL x, CELL y)
-{
-       return tag_boolean((FIXNUM)x < (FIXNUM)y);
-}
-
-CELL less_bignum(CELL x, CELL y)
-{
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               < ((BIGNUM*)UNTAG(y))->n);
-}
-
-CELL less_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(less,false)
-
-/* LESSEQ */
-INLINE CELL lesseq_fixnum(CELL x, CELL y)
-{
-       return tag_boolean((FIXNUM)x <= (FIXNUM)y);
-}
-
-CELL lesseq_bignum(CELL x, CELL y)
-{
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               <= ((BIGNUM*)UNTAG(y))->n);
-}
-
-CELL lesseq_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(lesseq,false)
-
-/* GREATER */
-INLINE CELL greater_fixnum(CELL x, CELL y)
-{
-       return tag_boolean((FIXNUM)x > (FIXNUM)y);
-}
-
-CELL greater_bignum(CELL x, CELL y)
-{
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               > ((BIGNUM*)UNTAG(y))->n);
-}
-
-CELL greater_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(greater,false)
-
-/* GREATEREQ */
-INLINE CELL greatereq_fixnum(CELL x, CELL y)
-{
-       return tag_boolean((FIXNUM)x >= (FIXNUM)y);
-}
-
-CELL greatereq_bignum(CELL x, CELL y)
-{
-       return tag_boolean(((BIGNUM*)UNTAG(x))->n
-               >= ((BIGNUM*)UNTAG(y))->n);
-}
-
-CELL greatereq_ratio(CELL x, CELL y)
-{
-       return F;
-}
-
-BINARY_OP(greatereq,false)
+          /* op */   /* anytype */   /* integer only */
+BINARY_OP(number_eq, true,           false)
+BINARY_OP(add,       false,          false)
+BINARY_OP(subtract,  false,          false)
+BINARY_OP(multiply,  false,          false)
+BINARY_OP(divide,    false,          false)
+BINARY_OP(divint,    false,          true)
+BINARY_OP(divmod,    false,          true)
+BINARY_OP(mod,       false,          true)
+BINARY_OP(and,       false,          true)
+BINARY_OP(or,        false,          true)
+BINARY_OP(xor,       false,          true)
+BINARY_OP(shiftleft, false,          true)
+BINARY_OP(shiftright,false,          true)
+BINARY_OP(less,      false,          false)
+BINARY_OP(lesseq,    false,          false)
+BINARY_OP(greater,   false,          false)
+BINARY_OP(greatereq, false,          false)

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 6b38ab320a050fd3c0cfa14f57099d506d8d6bdf..f10a14703fb5a5bbd5e3513986ac3eaf15b2a180 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -1,24 +1,9 @@
 #include "factor.h"
 
-INLINE BIGNUM* fixnum_to_bignum(CELL n)
-{
-       return bignum((BIGNUM_2)untag_fixnum_fast(n));
-}
-
-INLINE RATIO* fixnum_to_ratio(CELL n)
-{
-       return ratio(n,tag_fixnum(1));
-}
-
-INLINE FIXNUM bignum_to_fixnum(CELL tagged)
-{
-       return (FIXNUM)(untag_bignum(tagged)->n);
-}
-
-INLINE RATIO* bignum_to_ratio(CELL n)
-{
-       return ratio(n,tag_fixnum(1));
-}
+BIGNUM* fixnum_to_bignum(CELL n);
+RATIO* fixnum_to_ratio(CELL n);
+FIXNUM bignum_to_fixnum(CELL tagged);
+RATIO* bignum_to_ratio(CELL n);
 
 #define CELL_TO_INTEGER(result) \
        FIXNUM _result = (result); \
@@ -34,7 +19,7 @@ INLINE RATIO* bignum_to_ratio(CELL n)
         else \
                 return tag_fixnum(_result);
 
-#define BINARY_OP(OP,anytype) \
+#define BINARY_OP(OP,anytype,integerOnly) \
 CELL OP(CELL x, CELL y) \
 { \
        switch(TAG(x)) \
@@ -59,7 +44,10 @@ CELL OP(CELL x, CELL y) \
                        } \
                        break; \
                case RATIO_TYPE: \
-                       return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
+                       if(integerOnly) \
+                               return OP(x,to_integer(y)); \
+                       else \
+                               return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
                default: \
                        if(anytype) \
                                return OP##_anytype(x,y); \
@@ -90,7 +78,10 @@ CELL OP(CELL x, CELL y) \
                                        return F; \
                                } \
                        case RATIO_TYPE: \
-                               return OP##_ratio((CELL)bignum_to_ratio(x),y); \
+                               if(integerOnly) \
+                                       return OP(x,to_integer(y)); \
+                               else \
+                                       return OP##_ratio((CELL)bignum_to_ratio(x),y); \
                        default: \
                                if(anytype) \
                                        return OP##_anytype(x,y); \
@@ -113,12 +104,18 @@ CELL OP(CELL x, CELL y) \
                switch(TAG(y)) \
                { \
                case FIXNUM_TYPE: \
-                       return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
+                       if(integerOnly) \
+                               return OP(to_integer(x),y); \
+                       else \
+                               return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
                case OBJECT_TYPE: \
                        switch(object_type(y)) \
                        { \
                        case BIGNUM_TYPE: \
-                               return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
+                               if(integerOnly) \
+                                       return OP(to_integer(x),y); \
+                               else \
+                                       return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
                        default: \
                                if(anytype) \
                                        return OP##_anytype(x,y); \
@@ -128,7 +125,10 @@ CELL OP(CELL x, CELL y) \
                        } \
                        break; \
                case RATIO_TYPE: \
-                       return OP##_ratio(x,y); \
+                       if(integerOnly) \
+                               return OP(to_integer(x),to_integer(y)); \
+                       else \
+                               return OP##_ratio(x,y); \
                default: \
                        if(anytype) \
                                return OP##_anytype(x,y); \
@@ -167,10 +167,15 @@ void primitive_to_integer(void);
 CELL number_eq(CELL x, CELL y);
 void primitive_number_eq(void);
 
+CELL add(CELL x, CELL y);
 void primitive_add(void);
+CELL subtract(CELL x, CELL y);
 void primitive_subtract(void);
+CELL multiply(CELL x, CELL y);
 void primitive_multiply(void);
+CELL divide(CELL x, CELL y);
 void primitive_divmod(void);
+CELL divint(CELL x, CELL y);
 void primitive_divint(void);
 void primitive_divide(void);
 void primitive_less(void);
@@ -183,11 +188,3 @@ void primitive_or(void);
 void primitive_xor(void);
 void primitive_shiftleft(void);
 void primitive_shiftright(void);
-
-CELL add(CELL x, CELL y);
-CELL subtract(CELL x, CELL y);
-CELL multiply(CELL x, CELL y);
-CELL divide(CELL x, CELL y);
-CELL divint(CELL x, CELL y);
-
-FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y);

diff --git a/native/bignum.c b/native/bignum.c
index 5fc796a3921a0c31295212b103a51fbd553d750b..bc8941134cc934e9cfea9d2a7cd604bb27288a92 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -5,3 +5,186 @@ void primitive_bignump(void)
        check_non_empty(env.dt);
        env.dt = tag_boolean(typep(BIGNUM_TYPE,env.dt));
 }
+
+BIGNUM* to_bignum(CELL tagged)
+{
+       RATIO* r;
+
+       switch(type_of(tagged))
+       {
+       case FIXNUM_TYPE:
+               return fixnum_to_bignum(tagged);
+       case BIGNUM_TYPE:
+               return (BIGNUM*)UNTAG(tagged);
+       case RATIO_TYPE:
+               r = (RATIO*)UNTAG(tagged);
+               return to_bignum(divint(r->numerator,r->denominator));
+       default:
+               type_error(BIGNUM_TYPE,tagged);
+               return NULL; /* can't happen */
+       }
+}
+
+void primitive_to_bignum(void)
+{
+       env.dt = tag_bignum(to_bignum(env.dt));
+}
+
+CELL number_eq_bignum(CELL x, CELL y)
+{
+       return tag_boolean(((BIGNUM*)UNTAG(x))->n
+               == ((BIGNUM*)UNTAG(y))->n);
+}
+
+CELL add_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               + ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL subtract_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               - ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL multiply_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               * ((BIGNUM*)UNTAG(y))->n));
+}
+
+BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y)
+{
+       BIGNUM_2 t;
+
+       if(x < 0)
+               x = -x;
+       if(y < 0)
+               y = -y;
+
+       if(x > y)
+       {
+               t = x;
+               x = y;
+               y = t;
+       }
+
+       for(;;)
+       {
+               if(x == 0)
+                       return y;
+
+               t = y % x;
+               y = x;
+               x = t;
+       }
+}
+
+CELL divide_bignum(CELL x, CELL y)
+{
+       BIGNUM_2 _x = ((BIGNUM*)UNTAG(x))->n;
+       BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n;
+       BIGNUM_2 gcd;
+
+       if(_y == 0)
+       {
+               /* FIXME */
+               abort();
+       }
+       else if(_y < 0)
+       {
+               _x = -_x;
+               _y = -_y;
+       }
+
+       gcd = gcd_bignum(_x,_y);
+       if(gcd != 1)
+       {
+               _x /= gcd;
+               _y /= gcd;
+       }
+
+       if(_y == 1)
+               return tag_object(bignum(_x));
+       else
+       {
+               return tag_ratio(ratio(
+                       tag_bignum(bignum(_x)),
+                       tag_bignum(bignum(_y))));
+       }
+}
+
+CELL divint_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               / ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL divmod_bignum(CELL x, CELL 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));
+}
+
+CELL mod_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               % ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL and_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               & ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL or_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               | ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL xor_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               ^ ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL shiftleft_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               << ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL shiftright_bignum(CELL x, CELL y)
+{
+       return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
+               >> ((BIGNUM*)UNTAG(y))->n));
+}
+
+CELL less_bignum(CELL x, CELL y)
+{
+       return tag_boolean(((BIGNUM*)UNTAG(x))->n
+               < ((BIGNUM*)UNTAG(y))->n);
+}
+
+CELL lesseq_bignum(CELL x, CELL y)
+{
+       return tag_boolean(((BIGNUM*)UNTAG(x))->n
+               <= ((BIGNUM*)UNTAG(y))->n);
+}
+
+CELL greater_bignum(CELL x, CELL y)
+{
+       return tag_boolean(((BIGNUM*)UNTAG(x))->n
+               > ((BIGNUM*)UNTAG(y))->n);
+}
+
+CELL greatereq_bignum(CELL x, CELL y)
+{
+       return tag_boolean(((BIGNUM*)UNTAG(x))->n
+               >= ((BIGNUM*)UNTAG(y))->n);
+}

diff --git a/native/bignum.h b/native/bignum.h
index c1948d41572f19ba80f3419f7fce07d50f80943d..d3a128a7ac45b0c63270fb8f221837e5df00fbe2 100644 (file)
--- a/native/bignum.h
+++ b/native/bignum.h
@@ -31,3 +31,23 @@ INLINE CELL tag_bignum(BIGNUM* untagged)
 }
 
 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);
+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 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);

diff --git a/native/factor.h b/native/factor.h
index 7a667467d5bc89e21d7e97ebfd37f841637fc6a6..d57677ac155cc4a420358639ade4920641bbbf06 100644 (file)
--- a/native/factor.h
+++ b/native/factor.h
@@ -41,6 +41,8 @@ typedef unsigned char BYTE;
 #include "types.h"
 #include "array.h"
 #include "handle.h"
+#include "word.h"
+#include "run.h"
 #include "fixnum.h"
 #include "bignum.h"
 #include "ratio.h"
@@ -50,8 +52,6 @@ typedef unsigned char BYTE;
 #include "fd.h"
 #include "file.h"
 #include "cons.h"
-#include "word.h"
-#include "run.h"
 #include "image.h"
 #include "primitives.h"
 #include "vector.h"

diff --git a/native/fixnum.c b/native/fixnum.c
index 2097f7387e95ff6fb8de55ded616617f6886aad8..c4d4285bb3c10efc2f46c5d36faf76386e767a6c 100644 (file)
--- a/native/fixnum.c
+++ b/native/fixnum.c
@@ -11,3 +11,170 @@ void primitive_not(void)
        type_check(FIXNUM_TYPE,env.dt);
        env.dt = RETAG(UNTAG(~env.dt),FIXNUM_TYPE);
 }
+
+FIXNUM to_fixnum(CELL tagged)
+{
+       RATIO* r;
+
+       switch(type_of(tagged))
+       {
+       case FIXNUM_TYPE:
+               return untag_fixnum_fast(tagged);
+       case BIGNUM_TYPE:
+               return bignum_to_fixnum(tagged);
+       case RATIO_TYPE:
+               r = (RATIO*)UNTAG(tagged);
+               return to_fixnum(divint(r->numerator,r->denominator));
+       default:
+               type_error(FIXNUM_TYPE,tagged);
+               return -1; /* can't happen */
+       }
+}
+
+void primitive_to_fixnum(void)
+{
+       env.dt = tag_fixnum(to_fixnum(env.dt));
+}
+
+CELL number_eq_fixnum(CELL x, CELL y)
+{
+       return tag_boolean(x == y);
+}
+
+CELL add_fixnum(CELL x, CELL y)
+{
+       CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y));
+}
+
+CELL subtract_fixnum(CELL x, CELL y)
+{
+       CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
+}
+
+CELL multiply_fixnum(CELL x, CELL y)
+{
+       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               * (BIGNUM_2)untag_fixnum_fast(y));
+}
+
+CELL divint_fixnum(CELL x, CELL y)
+{
+       /* division takes common factor of 8 out. */
+       return tag_fixnum(x / y);
+}
+
+CELL divmod_fixnum(CELL x, CELL y)
+{
+       ldiv_t q = ldiv(x,y);
+       /* division takes common factor of 8 out. */
+       dpush(tag_fixnum(q.quot));
+       return q.rem;
+}
+
+CELL mod_fixnum(CELL x, CELL y)
+{
+       return x % y;
+}
+
+FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y)
+{
+       FIXNUM t;
+
+       if(x < 0)
+               x = -x;
+       if(y < 0)
+               y = -y;
+
+       if(x > y)
+       {
+               t = x;
+               x = y;
+               y = t;
+       }
+
+       for(;;)
+       {
+               if(x == 0)
+                       return y;
+
+               t = y % x;
+               y = x;
+               x = t;
+       }
+}
+
+CELL divide_fixnum(CELL x, CELL y)
+{
+       FIXNUM _x = untag_fixnum_fast(x);
+       FIXNUM _y = untag_fixnum_fast(y);
+
+       if(_y == 0)
+       {
+               /* FIXME */
+               abort();
+       }
+       else if(_y < 0)
+       {
+               _x = -_x;
+               _y = -_y;
+       }
+
+       FIXNUM gcd = gcd_fixnum(_x,_y);
+       if(gcd != 1)
+       {
+               _x /= gcd;
+               _y /= gcd;
+       }
+
+       if(_y == 1)
+               return tag_fixnum(_x);
+       else
+               return tag_ratio(ratio(tag_fixnum(_x),tag_fixnum(_y)));
+}
+
+CELL and_fixnum(CELL x, CELL y)
+{
+       return x & y;
+}
+
+CELL or_fixnum(CELL x, CELL y)
+{
+       return x | y;
+}
+
+CELL xor_fixnum(CELL x, CELL y)
+{
+       return x ^ y;
+}
+
+CELL shiftleft_fixnum(CELL x, CELL y)
+{
+       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               << (BIGNUM_2)untag_fixnum_fast(y));
+}
+
+CELL shiftright_fixnum(CELL x, CELL y)
+{
+       BIGNUM_2_TO_INTEGER((BIGNUM_2)untag_fixnum_fast(x)
+               >> (BIGNUM_2)untag_fixnum_fast(y));
+}
+
+CELL less_fixnum(CELL x, CELL y)
+{
+       return tag_boolean((FIXNUM)x < (FIXNUM)y);
+}
+
+CELL lesseq_fixnum(CELL x, CELL y)
+{
+       return tag_boolean((FIXNUM)x <= (FIXNUM)y);
+}
+
+CELL greater_fixnum(CELL x, CELL y)
+{
+       return tag_boolean((FIXNUM)x > (FIXNUM)y);
+}
+
+CELL greatereq_fixnum(CELL x, CELL y)
+{
+       return tag_boolean((FIXNUM)x >= (FIXNUM)y);
+}

diff --git a/native/fixnum.h b/native/fixnum.h
index 0e294d02ae28fd7d7a63f93f02140cd06b96347c..54750d9eef7c09c2e3a02535387c9ab766208a2a 100644 (file)
--- a/native/fixnum.h
+++ b/native/fixnum.h
@@ -15,3 +15,25 @@ INLINE CELL tag_fixnum(FIXNUM untagged)
 
 void primitive_fixnump(void);
 void primitive_not(void);
+
+FIXNUM to_fixnum(CELL tagged);
+void primitive_to_fixnum(void);
+
+CELL number_eq_fixnum(CELL x, CELL y);
+CELL add_fixnum(CELL x, CELL y);
+CELL subtract_fixnum(CELL x, CELL y);
+CELL multiply_fixnum(CELL x, CELL y);
+FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y);
+CELL divide_fixnum(CELL x, CELL y);
+CELL divint_fixnum(CELL x, CELL y);
+CELL divmod_fixnum(CELL x, CELL y);
+CELL mod_fixnum(CELL x, CELL y);
+CELL and_fixnum(CELL x, CELL y);
+CELL or_fixnum(CELL x, CELL y);
+CELL xor_fixnum(CELL x, CELL y);
+CELL shiftleft_fixnum(CELL x, CELL y);
+CELL shiftright_fixnum(CELL x, CELL y);
+CELL less_fixnum(CELL x, CELL y);
+CELL lesseq_fixnum(CELL x, CELL y);
+CELL greater_fixnum(CELL x, CELL y);
+CELL greatereq_fixnum(CELL x, CELL y);

diff --git a/native/ratio.c b/native/ratio.c
index 720fd9dac8c4fde72b6f337a11e23a3970f04ca7..7c6abcc5dcc7dafd12393740f12c7b2fe1ce992b 100644 (file)
--- a/native/ratio.c
+++ b/native/ratio.c
@@ -47,3 +47,68 @@ void primitive_denominator(void)
                break;
        }
 }
+
+CELL number_eq_ratio(CELL x, CELL 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)));
+}
+
+CELL add_ratio(CELL x, CELL 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));
+}
+
+CELL subtract_ratio(CELL x, CELL 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));
+}
+
+CELL multiply_ratio(CELL x, CELL y)
+{
+       RATIO* rx = (RATIO*)UNTAG(x);
+       RATIO* ry = (RATIO*)UNTAG(y);
+       return divide(
+               multiply(rx->numerator,ry->numerator),
+               multiply(rx->denominator,ry->denominator));
+}
+
+CELL divide_ratio(CELL x, CELL y)
+{
+       RATIO* rx = (RATIO*)UNTAG(x);
+       RATIO* ry = (RATIO*)UNTAG(y);
+       return divide(
+               multiply(rx->numerator,ry->denominator),
+               multiply(rx->denominator,ry->numerator));
+}
+
+CELL less_ratio(CELL x, CELL y)
+{
+       return F;
+}
+
+CELL lesseq_ratio(CELL x, CELL y)
+{
+       return F;
+}
+
+CELL greater_ratio(CELL x, CELL y)
+{
+       return F;
+}
+
+CELL greatereq_ratio(CELL x, CELL y)
+{
+       return F;
+}

diff --git a/native/ratio.h b/native/ratio.h
index 836f243c4970a58afb5de58129c77c116bdd9c29..53073fcf0a02007751b77130d1186d3cd48df9ce 100644 (file)
--- a/native/ratio.h
+++ b/native/ratio.h
@@ -19,3 +19,12 @@ RATIO* ratio(CELL numerator, CELL denominator);
 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 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);

diff --git a/native/word.c b/native/word.c
index 715e9aeb0ead05696a971e2a8b84b881ba956fb4..7a812938782be345b322144280ab0efcc5bef9e0 100644 (file)
--- a/native/word.c
+++ b/native/word.c
@@ -1,6 +1,6 @@
 #include "factor.h"
 
-WORD* word(FIXNUM primitive, CELL parameter, CELL plist)
+WORD* word(CELL primitive, CELL parameter, CELL plist)
 {
        WORD* word = (WORD*)allot_object(WORD_TYPE,sizeof(WORD));
        word->xt = primitive_to_xt(primitive);

diff --git a/native/word.h b/native/word.h
index 9adc014da4ac12b48abd3deef3ffa827404f71a6..55af1730f0ffa9982fd070958311d6a71680241b 100644 (file)
--- a/native/word.h
+++ b/native/word.h
@@ -24,7 +24,7 @@ INLINE CELL tag_word(WORD* word)
        return RETAG(word,WORD_TYPE);
 }
 
-WORD* word(FIXNUM primitive, CELL parameter, CELL plist);
+WORD* word(CELL primitive, CELL parameter, CELL plist);
 void update_xt(WORD* word);
 void fixup_word(WORD* word);
 void collect_word(WORD* word);