steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

clean up native arithmetic code

cvs
Slava Pestov 2004-08-05 19:18:31 +00:00
parent 5207ee8700
commit 3ad0b47e2d
13 changed files with 541 additions and 559 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
TODO.FACTOR.txt
View File

@ -1,7 +1,7 @@
+ native: + native:
ERROR: I/O error: [ "primitive_read_line_fd_8" "Resource temporarily unavailable" ] 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 - ratio comparsion, ratio bitops that coerce to integers
- handle division by zero - handle division by zero
- fixup-words is crusty - fixup-words is crusty

20
doc/devel-guide.lyx
View File

@ -4202,26 +4202,10 @@ Studying Factor 0:30
Paperwork 1:05 Paperwork 1:05
\layout Subsection \layout Subsection
The complete program The main menu
\layout Standard \layout Standard
TODO operations: Reading a number, showing a menu
\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
\layout Section \layout Section
Variables and namespaces Variables and namespaces

541
native/arithmetic.c
View File

@ -1,5 +1,25 @@
#include "factor.h" #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) void primitive_numberp(void)
{ {
check_non_empty(env.dt); 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) CELL to_integer(CELL tagged)
{ {
RATIO* r; RATIO* r;
@ -89,463 +61,26 @@ void primitive_to_integer(void)
} }
/* EQUALITY */ /* 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) CELL number_eq_anytype(CELL x, CELL y)
{ {
return F; return F;
} }
BINARY_OP(number_eq,true) /* op */ /* anytype */ /* integer only */
BINARY_OP(number_eq, true, false)
/* ADDITION */ BINARY_OP(add, false, false)
INLINE CELL add_fixnum(CELL x, CELL y) BINARY_OP(subtract, false, false)
{ BINARY_OP(multiply, false, false)
CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y)); BINARY_OP(divide, false, false)
} BINARY_OP(divint, false, true)
BINARY_OP(divmod, false, true)
CELL add_bignum(CELL x, CELL y) BINARY_OP(mod, false, true)
{ BINARY_OP(and, false, true)
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n BINARY_OP(or, false, true)
+ ((BIGNUM*)UNTAG(y))->n)); BINARY_OP(xor, false, true)
} BINARY_OP(shiftleft, false, true)
BINARY_OP(shiftright,false, true)
CELL add_ratio(CELL x, CELL y) BINARY_OP(less, false, false)
{ BINARY_OP(lesseq, false, false)
RATIO* rx = (RATIO*)UNTAG(x); BINARY_OP(greater, false, false)
RATIO* ry = (RATIO*)UNTAG(y); BINARY_OP(greatereq, false, false)
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)

53
native/arithmetic.h
View File

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

183
native/bignum.c
View File

@ -5,3 +5,186 @@ void primitive_bignump(void)
check_non_empty(env.dt); check_non_empty(env.dt);
env.dt = tag_boolean(typep(BIGNUM_TYPE,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);
}

20
native/bignum.h
View File

@ -31,3 +31,23 @@ INLINE CELL tag_bignum(BIGNUM* untagged)
} }
void primitive_bignump(void); 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);

4
native/factor.h
View File

@ -41,6 +41,8 @@ typedef unsigned char BYTE;
#include "types.h" #include "types.h"
#include "array.h" #include "array.h"
#include "handle.h" #include "handle.h"
#include "word.h"
#include "run.h"
#include "fixnum.h" #include "fixnum.h"
#include "bignum.h" #include "bignum.h"
#include "ratio.h" #include "ratio.h"
@ -50,8 +52,6 @@ typedef unsigned char BYTE;
#include "fd.h" #include "fd.h"
#include "file.h" #include "file.h"
#include "cons.h" #include "cons.h"
#include "word.h"
#include "run.h"
#include "image.h" #include "image.h"
#include "primitives.h" #include "primitives.h"
#include "vector.h" #include "vector.h"

167
native/fixnum.c
View File

@ -11,3 +11,170 @@ void primitive_not(void)
type_check(FIXNUM_TYPE,env.dt); type_check(FIXNUM_TYPE,env.dt);
env.dt = RETAG(UNTAG(~env.dt),FIXNUM_TYPE); 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);
}

22
native/fixnum.h
View File

@ -15,3 +15,25 @@ INLINE CELL tag_fixnum(FIXNUM untagged)
void primitive_fixnump(void); void primitive_fixnump(void);
void primitive_not(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);

65
native/ratio.c
View File

@ -47,3 +47,68 @@ void primitive_denominator(void)
break; 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;
}

9
native/ratio.h
View File

@ -19,3 +19,12 @@ RATIO* ratio(CELL numerator, CELL denominator);
void primitive_ratiop(void); void primitive_ratiop(void);
void primitive_numerator(void); void primitive_numerator(void);
void primitive_denominator(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);

2
native/word.c
View File

@ -1,6 +1,6 @@
#include "factor.h" #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* word = (WORD*)allot_object(WORD_TYPE,sizeof(WORD));
word->xt = primitive_to_xt(primitive); word->xt = primitive_to_xt(primitive);

2
native/word.h
View File

@ -24,7 +24,7 @@ INLINE CELL tag_word(WORD* word)
return RETAG(word,WORD_TYPE); 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 update_xt(WORD* word);
void fixup_word(WORD* word); void fixup_word(WORD* word);
void collect_word(WORD* word); void collect_word(WORD* word);