diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index a36f3c9555..ae2c1b4d74 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,7 @@ + native: ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ] - +- errors: don't show .factor-rc - ratio comparsion, ratio bitops that coerce to integers - handle division by zero - fixup-words is crusty diff --git a/doc/devel-guide.lyx b/doc/devel-guide.lyx index 0c19007b91..915e3cbb0b 100644 --- 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 +The main menu \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'. -\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 16dfc96e15..d063923780 100644 --- a/native/arithmetic.c +++ b/native/arithmetic.c @@ -1,5 +1,25 @@ #include "factor.h" +BIGNUM* fixnum_to_bignum(CELL n) +{ + return bignum((BIGNUM_2)untag_fixnum_fast(n)); +} + +RATIO* fixnum_to_ratio(CELL n) +{ + return ratio(n,tag_fixnum(1)); +} + +FIXNUM bignum_to_fixnum(CELL tagged) +{ + return (FIXNUM)(untag_bignum(tagged)->n); +} + +RATIO* bignum_to_ratio(CELL n) +{ + return ratio(n,tag_fixnum(1)); +} + void primitive_numberp(void) { check_non_empty(env.dt); @@ -17,54 +37,6 @@ void primitive_numberp(void) } } -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)); -} - -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 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 6b38ab320a..f10a14703f 100644 --- 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 5fc796a392..bc8941134c 100644 --- 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 c1948d4157..d3a128a7ac 100644 --- 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 7a667467d5..d57677ac15 100644 --- 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 2097f7387e..c4d4285bb3 100644 --- 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 0e294d02ae..54750d9eef 100644 --- 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 720fd9dac8..7c6abcc5dc 100644 --- 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 836f243c49..53073fcf0a 100644 --- 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 715e9aeb0e..7a81293878 100644 --- 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 9adc014da4..55af1730f0 100644 --- 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);