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

some minor cleanups in preparation for landing of s48 bignums

cvs
Slava Pestov 2004-08-25 04:26:49 +00:00
parent 63f1365820
commit 8bf9a44f83
13 changed files with 284 additions and 333 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -4,6 +4,7 @@ LIBS = -lm
STRIP = strip STRIP = strip
OBJS = native/arithmetic.o native/array.o native/bignum.o \ OBJS = native/arithmetic.o native/array.o native/bignum.o \
native/s48_bignum.o \
native/complex.o native/cons.o native/error.o \ native/complex.o native/cons.o native/error.o \
native/factor.o native/file.o native/fixnum.o \ native/factor.o native/file.o native/fixnum.o \
native/float.o native/gc.o \ native/float.o native/gc.o \

2
library/cross-compiler.factor
View File

@ -52,6 +52,7 @@ DEFER: room
DEFER: os-env DEFER: os-env
DEFER: type-of DEFER: type-of
DEFER: size-of DEFER: size-of
DEFER: dump
IN: strings IN: strings
DEFER: str= DEFER: str=
@ -244,6 +245,7 @@ IN: cross-compiler
profiling profiling
call-count call-count
set-call-count set-call-count
dump
] [ ] [
swap succ tuck primitive, swap succ tuck primitive,
] each drop ; ] each drop ;

4
library/image.factor
View File

@ -142,7 +142,9 @@ USE: words
#! Very bad! #! Very bad!
object-tag here-as >r object-tag here-as >r
bignum-type >header emit 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> ; ( bignum -- ) emit64 r> ;
( Special objects ) ( Special objects )

49
native/arithmetic.c
View File

@ -1,5 +1,54 @@
#include "factor.h" #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) BIGNUM* fixnum_to_bignum(CELL n)
{ {
return bignum((BIGNUM_2)untag_fixnum_fast(n)); return bignum((BIGNUM_2)untag_fixnum_fast(n));

130
native/arithmetic.h
View File

@ -1,5 +1,6 @@
#include "factor.h" #include "factor.h"
CELL upgraded_arithmetic_type(CELL type1, CELL type2);
BIGNUM* fixnum_to_bignum(CELL n); BIGNUM* fixnum_to_bignum(CELL n);
RATIO* fixnum_to_ratio(CELL n); RATIO* fixnum_to_ratio(CELL n);
FLOAT* fixnum_to_float(CELL n); FLOAT* fixnum_to_float(CELL n);
@ -25,100 +26,19 @@ FLOAT* ratio_to_float(CELL n);
#define BINARY_OP(OP) \ #define BINARY_OP(OP) \
CELL OP(CELL x, CELL y) \ CELL OP(CELL x, CELL y) \
{ \ { \
switch(type_of(x)) \ switch(upgraded_arithmetic_type(type_of(x),type_of(y))) \
{ \ { \
case FIXNUM_TYPE: \ case FIXNUM_TYPE: \
\ return OP##_fixnum(x,y); \
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); \
} \
\
case BIGNUM_TYPE: \ case BIGNUM_TYPE: \
\ return OP##_bignum(to_bignum(x),to_bignum(y)); \
switch(type_of(y)) \ case RATIO_TYPE: \
{ \ return OP##_ratio(to_ratio(x),to_ratio(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); \
} \
\
case FLOAT_TYPE: \ case FLOAT_TYPE: \
\ return OP##_float(to_float(x),to_float(y)); \
switch(type_of(y)) \ case COMPLEX_TYPE: \
{ \ return OP##_complex(to_complex(x),to_complex(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); \
} \
\
default: \ default: \
\
return OP##_anytype(x,y); \ return OP##_anytype(x,y); \
} \ } \
} \ } \
@ -131,21 +51,21 @@ void primitive_##OP(void) \
#define BINARY_OP_INTEGER_ONLY(OP) \ #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; \ 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; \ 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; \ return F; \
} }
@ -165,13 +85,13 @@ CELL OP(CELL x) \
case FIXNUM_TYPE: \ case FIXNUM_TYPE: \
return OP##_fixnum(x); \ return OP##_fixnum(x); \
case RATIO_TYPE: \ case RATIO_TYPE: \
return OP##_ratio(x); \ return OP##_ratio((RATIO*)UNTAG(x)); \
case COMPLEX_TYPE: \ case COMPLEX_TYPE: \
return OP##_complex(x); \ return OP##_complex((COMPLEX*)UNTAG(x)); \
case BIGNUM_TYPE: \ case BIGNUM_TYPE: \
return OP##_bignum(x); \ return OP##_bignum((BIGNUM*)UNTAG(x)); \
case FLOAT_TYPE: \ case FLOAT_TYPE: \
return OP##_float(x); \ return OP##_float((FLOAT*)UNTAG(x)); \
default: \ default: \
return OP##_anytype(x); \ return OP##_anytype(x); \
} \ } \
@ -184,21 +104,21 @@ void primitive_##OP(void) \
#define UNARY_OP_INTEGER_ONLY(OP) \ #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; \ 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; \ 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; \ return F; \
} }

99
native/bignum.c
View File

@ -33,28 +33,24 @@ void primitive_to_bignum(void)
drepl(tag_object(to_bignum(dpeek()))); 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 return tag_boolean(x->n == y->n);
== ((BIGNUM*)UNTAG(y))->n);
} }
CELL add_bignum(CELL x, CELL y) CELL add_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n + y->n));
+ ((BIGNUM*)UNTAG(y))->n));
} }
CELL subtract_bignum(CELL x, CELL y) CELL subtract_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n - y->n));
- ((BIGNUM*)UNTAG(y))->n));
} }
CELL multiply_bignum(CELL x, CELL y) CELL multiply_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n * y->n));
* ((BIGNUM*)UNTAG(y))->n));
} }
BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y) 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 _x = x->n;
BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n; BIGNUM_2 _y = y->n;
BIGNUM_2 gcd; BIGNUM_2 gcd;
if(_y == 0) 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 return tag_object(bignum(x->n / y->n));
/ ((BIGNUM*)UNTAG(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 _x = x->n;
BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n; BIGNUM_2 _y = y->n;
return tag_object(make_float((double)_x / (double)_y)); 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 dpush(tag_object(bignum(x->n / y->n)));
/ ((BIGNUM*)UNTAG(y))->n))); return tag_object(bignum(x->n % y->n));
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n
% ((BIGNUM*)UNTAG(y))->n));
} }
CELL mod_bignum(CELL x, CELL y) CELL mod_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n % y->n));
% ((BIGNUM*)UNTAG(y))->n));
} }
CELL and_bignum(CELL x, CELL y) CELL and_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n & y->n));
& ((BIGNUM*)UNTAG(y))->n));
} }
CELL or_bignum(CELL x, CELL y) CELL or_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n | y->n));
| ((BIGNUM*)UNTAG(y))->n));
} }
CELL xor_bignum(CELL x, CELL y) CELL xor_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n ^ y->n));
^ ((BIGNUM*)UNTAG(y))->n));
} }
CELL shiftleft_bignum(CELL x, CELL y) CELL shiftleft_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n << y->n));
<< ((BIGNUM*)UNTAG(y))->n));
} }
CELL shiftright_bignum(CELL x, CELL y) CELL shiftright_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_object(bignum(((BIGNUM*)UNTAG(x))->n return tag_object(bignum(x->n >> y->n));
>> ((BIGNUM*)UNTAG(y))->n));
} }
CELL less_bignum(CELL x, CELL y) CELL less_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_boolean(((BIGNUM*)UNTAG(x))->n return tag_boolean(x->n < y->n);
< ((BIGNUM*)UNTAG(y))->n);
} }
CELL lesseq_bignum(CELL x, CELL y) CELL lesseq_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_boolean(((BIGNUM*)UNTAG(x))->n return tag_boolean(x->n <= y->n);
<= ((BIGNUM*)UNTAG(y))->n);
} }
CELL greater_bignum(CELL x, CELL y) CELL greater_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_boolean(((BIGNUM*)UNTAG(x))->n return tag_boolean(x->n > y->n);
> ((BIGNUM*)UNTAG(y))->n);
} }
CELL greatereq_bignum(CELL x, CELL y) CELL greatereq_bignum(BIGNUM* x, BIGNUM* y)
{ {
return tag_boolean(((BIGNUM*)UNTAG(x))->n return tag_boolean(x->n >= y->n);
>= ((BIGNUM*)UNTAG(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)));
} }

38
native/bignum.h
View File

@ -32,23 +32,23 @@ INLINE BIGNUM* untag_bignum(CELL tagged)
void primitive_bignump(void); void primitive_bignump(void);
BIGNUM* to_bignum(CELL tagged); BIGNUM* to_bignum(CELL tagged);
void primitive_to_bignum(void); void primitive_to_bignum(void);
CELL number_eq_bignum(CELL x, CELL y); CELL number_eq_bignum(BIGNUM* x, BIGNUM* y);
CELL add_bignum(CELL x, CELL y); CELL add_bignum(BIGNUM* x, BIGNUM* y);
CELL subtract_bignum(CELL x, CELL y); CELL subtract_bignum(BIGNUM* x, BIGNUM* y);
CELL multiply_bignum(CELL x, CELL y); CELL multiply_bignum(BIGNUM* x, BIGNUM* y);
BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y); BIGNUM_2 gcd_bignum(BIGNUM_2 x, BIGNUM_2 y);
CELL divide_bignum(CELL x, CELL y); CELL divide_bignum(BIGNUM* x, BIGNUM* y);
CELL divint_bignum(CELL x, CELL y); CELL divint_bignum(BIGNUM* x, BIGNUM* y);
CELL divfloat_bignum(CELL x, CELL y); CELL divfloat_bignum(BIGNUM* x, BIGNUM* y);
CELL divmod_bignum(CELL x, CELL y); CELL divmod_bignum(BIGNUM* x, BIGNUM* y);
CELL mod_bignum(CELL x, CELL y); CELL mod_bignum(BIGNUM* x, BIGNUM* y);
CELL and_bignum(CELL x, CELL y); CELL and_bignum(BIGNUM* x, BIGNUM* y);
CELL or_bignum(CELL x, CELL y); CELL or_bignum(BIGNUM* x, BIGNUM* y);
CELL xor_bignum(CELL x, CELL y); CELL xor_bignum(BIGNUM* x, BIGNUM* y);
CELL shiftleft_bignum(CELL x, CELL y); CELL shiftleft_bignum(BIGNUM* x, BIGNUM* y);
CELL shiftright_bignum(CELL x, CELL y); CELL shiftright_bignum(BIGNUM* x, BIGNUM* y);
CELL less_bignum(CELL x, CELL y); CELL less_bignum(BIGNUM* x, BIGNUM* y);
CELL lesseq_bignum(CELL x, CELL y); CELL lesseq_bignum(BIGNUM* x, BIGNUM* y);
CELL greater_bignum(CELL x, CELL y); CELL greater_bignum(BIGNUM* x, BIGNUM* y);
CELL greatereq_bignum(CELL x, CELL y); CELL greatereq_bignum(BIGNUM* x, BIGNUM* y);
CELL not_bignum(CELL x); CELL not_bignum(BIGNUM* x);

83
native/complex.c
View File

@ -8,6 +8,23 @@ COMPLEX* complex(CELL real, CELL imaginary)
return complex; 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) CELL possibly_complex(CELL real, CELL imaginary)
{ {
if(zerop(imaginary)) if(zerop(imaginary))
@ -35,7 +52,7 @@ void primitive_real(void)
drepl(untag_complex(dpeek())->real); drepl(untag_complex(dpeek())->real);
break; break;
default: default:
type_error(COMPLEX_TYPE,dpeek()); type_error(NUMBER_TYPE,dpeek());
break; break;
} }
} }
@ -54,7 +71,7 @@ void primitive_imaginary(void)
drepl(untag_complex(dpeek())->imaginary); drepl(untag_complex(dpeek())->imaginary);
break; break;
default: default:
type_error(COMPLEX_TYPE,dpeek()); type_error(NUMBER_TYPE,dpeek());
break; break;
} }
} }
@ -95,68 +112,58 @@ void primitive_from_rect(void)
dpush(possibly_complex(real,imaginary)); 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( return tag_boolean(
untag_boolean(number_eq(cx->real,cy->real)) && untag_boolean(number_eq(x->real,y->real)) &&
untag_boolean(number_eq(cx->imaginary,cy->imaginary))); 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( return possibly_complex(
add(cx->real,cy->real), add(x->real,y->real),
add(cx->imaginary,cy->imaginary)); 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( return possibly_complex(
subtract(cx->real,cy->real), subtract(x->real,y->real),
subtract(cx->imaginary,cy->imaginary)); 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( return possibly_complex(
subtract( subtract(
multiply(cx->real,cy->real), multiply(x->real,y->real),
multiply(cx->imaginary,cy->imaginary)), multiply(x->imaginary,y->imaginary)),
add( add(
multiply(cx->real,cy->imaginary), multiply(x->real,y->imaginary),
multiply(cx->imaginary,cy->real))); multiply(x->imaginary,y->real)));
} }
#define COMPLEX_DIVIDE(x,y) \ #define COMPLEX_DIVIDE(x,y) \
COMPLEX* cx = (COMPLEX*)UNTAG(x); \
COMPLEX* cy = (COMPLEX*)UNTAG(y); \
\ \
CELL mag = add( \ CELL mag = add( \
multiply(cy->real,cy->real), \ multiply(y->real,y->real), \
multiply(cy->imaginary,cy->imaginary)); \ multiply(y->imaginary,y->imaginary)); \
\ \
CELL r = add( \ CELL r = add( \
multiply(cx->real,cy->real), \ multiply(x->real,y->real), \
multiply(cx->imaginary,cy->imaginary)); \ multiply(x->imaginary,y->imaginary)); \
CELL i = subtract( \ CELL i = subtract( \
multiply(cx->imaginary,cy->real), \ multiply(x->imaginary,y->real), \
multiply(cx->real,cy->imaginary)); multiply(x->real,y->imaginary));
CELL divide_complex(CELL x, CELL y) CELL divide_complex(COMPLEX* x, COMPLEX* y)
{ {
COMPLEX_DIVIDE(x,y); COMPLEX_DIVIDE(x,y);
return possibly_complex(divide(r,mag),divide(i,mag)); 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); COMPLEX_DIVIDE(x,y);
return possibly_complex(divfloat(r,mag),divfloat(i,mag)); 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, \ #define INCOMPARABLE(x,y) general_error(ERROR_INCOMPARABLE, \
tag_cons(cons(RETAG(x,COMPLEX_TYPE),RETAG(y,COMPLEX_TYPE)))); 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); INCOMPARABLE(x,y);
return F; return F;
} }
CELL lesseq_complex(CELL x, CELL y) CELL lesseq_complex(COMPLEX* x, COMPLEX* y)
{ {
INCOMPARABLE(x,y); INCOMPARABLE(x,y);
return F; return F;
} }
CELL greater_complex(CELL x, CELL y) CELL greater_complex(COMPLEX* x, COMPLEX* y)
{ {
INCOMPARABLE(x,y); INCOMPARABLE(x,y);
return F; return F;
} }
CELL greatereq_complex(CELL x, CELL y) CELL greatereq_complex(COMPLEX* x, COMPLEX* y)
{ {
INCOMPARABLE(x,y); INCOMPARABLE(x,y);
return F; return F;

21
native/complex.h
View File

@ -15,6 +15,7 @@ INLINE CELL tag_complex(COMPLEX* complex)
} }
COMPLEX* complex(CELL real, CELL imaginary); COMPLEX* complex(CELL real, CELL imaginary);
COMPLEX* to_complex(CELL x);
CELL possibly_complex(CELL real, CELL imaginary); CELL possibly_complex(CELL real, CELL imaginary);
void primitive_complexp(void); void primitive_complexp(void);
@ -22,13 +23,13 @@ void primitive_real(void);
void primitive_imaginary(void); void primitive_imaginary(void);
void primitive_to_rect(void); void primitive_to_rect(void);
void primitive_from_rect(void); void primitive_from_rect(void);
CELL number_eq_complex(CELL x, CELL y); CELL number_eq_complex(COMPLEX* x, COMPLEX* y);
CELL add_complex(CELL x, CELL y); CELL add_complex(COMPLEX* x, COMPLEX* y);
CELL subtract_complex(CELL x, CELL y); CELL subtract_complex(COMPLEX* x, COMPLEX* y);
CELL multiply_complex(CELL x, CELL y); CELL multiply_complex(COMPLEX* x, COMPLEX* y);
CELL divide_complex(CELL x, CELL y); CELL divide_complex(COMPLEX* x, COMPLEX* y);
CELL divfloat_complex(CELL x, CELL y); CELL divfloat_complex(COMPLEX* x, COMPLEX* y);
CELL less_complex(CELL x, CELL y); CELL less_complex(COMPLEX* x, COMPLEX* y);
CELL lesseq_complex(CELL x, CELL y); CELL lesseq_complex(COMPLEX* x, COMPLEX* y);
CELL greater_complex(CELL x, CELL y); CELL greater_complex(COMPLEX* x, COMPLEX* y);
CELL greatereq_complex(CELL x, CELL y); CELL greatereq_complex(COMPLEX* x, COMPLEX* y);

50
native/float.c
View File

@ -54,64 +54,54 @@ void primitive_float_to_bits(void)
drepl(tag_object(bignum(f_raw))); 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 return tag_boolean(x->n == y->n);
== ((FLOAT*)UNTAG(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 return tag_object(make_float(x->n + y->n));
+ ((FLOAT*)UNTAG(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 return tag_object(make_float(x->n - y->n));
- ((FLOAT*)UNTAG(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 return tag_object(make_float(x->n * y->n));
* ((FLOAT*)UNTAG(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 return tag_object(make_float(x->n / y->n));
/ ((FLOAT*)UNTAG(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 return tag_object(make_float(x->n / y->n));
/ ((FLOAT*)UNTAG(y))->n));
} }
CELL less_float(CELL x, CELL y) CELL less_float(FLOAT* x, FLOAT* y)
{ {
return tag_boolean(((FLOAT*)UNTAG(x))->n return tag_boolean(x->n < y->n);
< ((FLOAT*)UNTAG(y))->n);
} }
CELL lesseq_float(CELL x, CELL y) CELL lesseq_float(FLOAT* x, FLOAT* y)
{ {
return tag_boolean(((FLOAT*)UNTAG(x))->n return tag_boolean(x->n <= y->n);
<= ((FLOAT*)UNTAG(y))->n);
} }
CELL greater_float(CELL x, CELL y) CELL greater_float(FLOAT* x, FLOAT* y)
{ {
return tag_boolean(((FLOAT*)UNTAG(x))->n return tag_boolean(x->n > y->n);
> ((FLOAT*)UNTAG(y))->n);
} }
CELL greatereq_float(CELL x, CELL y) CELL greatereq_float(FLOAT* x, FLOAT* y)
{ {
return tag_boolean(((FLOAT*)UNTAG(x))->n return tag_boolean(x->n >= y->n);
>= ((FLOAT*)UNTAG(y))->n);
} }
void primitive_facos(void) void primitive_facos(void)

20
native/float.h
View File

@ -32,16 +32,16 @@ void primitive_str_to_float(void);
void primitive_float_to_str(void); void primitive_float_to_str(void);
void primitive_float_to_bits(void); void primitive_float_to_bits(void);
CELL number_eq_float(CELL x, CELL y); CELL number_eq_float(FLOAT* x, FLOAT* y);
CELL add_float(CELL x, CELL y); CELL add_float(FLOAT* x, FLOAT* y);
CELL subtract_float(CELL x, CELL y); CELL subtract_float(FLOAT* x, FLOAT* y);
CELL multiply_float(CELL x, CELL y); CELL multiply_float(FLOAT* x, FLOAT* y);
CELL divide_float(CELL x, CELL y); CELL divide_float(FLOAT* x, FLOAT* y);
CELL divfloat_float(CELL x, CELL y); CELL divfloat_float(FLOAT* x, FLOAT* y);
CELL less_float(CELL x, CELL y); CELL less_float(FLOAT* x, FLOAT* y);
CELL lesseq_float(CELL x, CELL y); CELL lesseq_float(FLOAT* x, FLOAT* y);
CELL greater_float(CELL x, CELL y); CELL greater_float(FLOAT* x, FLOAT* y);
CELL greatereq_float(CELL x, CELL y); CELL greatereq_float(FLOAT* x, FLOAT* y);
void primitive_facos(void); void primitive_facos(void);
void primitive_fasin(void); void primitive_fasin(void);

99
native/ratio.c
View File

@ -8,6 +8,21 @@ RATIO* ratio(CELL numerator, CELL denominator)
return ratio; 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) void primitive_ratiop(void)
{ {
drepl(tag_boolean(typep(RATIO_TYPE,dpeek()))); 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( return tag_boolean(
untag_boolean(number_eq(rx->numerator,ry->numerator)) && untag_boolean(number_eq(x->numerator,y->numerator)) &&
untag_boolean(number_eq(rx->denominator,ry->denominator))); 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); return divide(add(multiply(x->numerator,y->denominator),
RATIO* ry = (RATIO*)UNTAG(y); multiply(x->denominator,y->numerator)),
return divide(add(multiply(rx->numerator,ry->denominator), multiply(x->denominator,y->denominator));
multiply(rx->denominator,ry->numerator)),
multiply(rx->denominator,ry->denominator));
} }
CELL subtract_ratio(CELL x, CELL y) CELL subtract_ratio(RATIO* x, RATIO* y)
{ {
RATIO* rx = (RATIO*)UNTAG(x); return divide(subtract(multiply(x->numerator,y->denominator),
RATIO* ry = (RATIO*)UNTAG(y); multiply(x->denominator,y->numerator)),
return divide(subtract(multiply(rx->numerator,ry->denominator), multiply(x->denominator,y->denominator));
multiply(rx->denominator,ry->numerator)),
multiply(rx->denominator,ry->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( return divide(
multiply(rx->numerator,ry->numerator), multiply(x->numerator,y->numerator),
multiply(rx->denominator,ry->denominator)); 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( return divide(
multiply(rx->numerator,ry->denominator), multiply(x->numerator,y->denominator),
multiply(rx->denominator,ry->numerator)); 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( return divfloat(
multiply(rx->numerator,ry->denominator), multiply(x->numerator,y->denominator),
multiply(rx->denominator,ry->numerator)); multiply(x->denominator,y->numerator));
} }
CELL less_ratio(CELL x, CELL y) CELL less_ratio(RATIO* x, RATIO* y)
{ {
RATIO* rx = (RATIO*)UNTAG(x); return less(multiply(x->numerator,y->denominator),
RATIO* ry = (RATIO*)UNTAG(y); multiply(y->numerator,x->denominator));
return less(multiply(rx->numerator,ry->denominator),
multiply(ry->numerator,rx->denominator));
} }
CELL lesseq_ratio(CELL x, CELL y) CELL lesseq_ratio(RATIO* x, RATIO* y)
{ {
RATIO* rx = (RATIO*)UNTAG(x); return lesseq(multiply(x->numerator,y->denominator),
RATIO* ry = (RATIO*)UNTAG(y); multiply(y->numerator,x->denominator));
return lesseq(multiply(rx->numerator,ry->denominator),
multiply(ry->numerator,rx->denominator));
} }
CELL greater_ratio(CELL x, CELL y) CELL greater_ratio(RATIO* x, RATIO* y)
{ {
RATIO* rx = (RATIO*)UNTAG(x); return greater(multiply(x->numerator,y->denominator),
RATIO* ry = (RATIO*)UNTAG(y); multiply(y->numerator,x->denominator));
return greater(multiply(rx->numerator,ry->denominator),
multiply(ry->numerator,rx->denominator));
} }
CELL greatereq_ratio(CELL x, CELL y) CELL greatereq_ratio(RATIO* x, RATIO* y)
{ {
RATIO* rx = (RATIO*)UNTAG(x); return greatereq(multiply(x->numerator,y->denominator),
RATIO* ry = (RATIO*)UNTAG(y); multiply(y->numerator,x->denominator));
return greatereq(multiply(rx->numerator,ry->denominator),
multiply(ry->numerator,rx->denominator));
} }

21
native/ratio.h
View File

@ -15,17 +15,18 @@ INLINE CELL tag_ratio(RATIO* ratio)
} }
RATIO* ratio(CELL numerator, CELL denominator); RATIO* ratio(CELL numerator, CELL denominator);
RATIO* to_ratio(CELL x);
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 number_eq_ratio(RATIO* x, RATIO* y);
CELL add_ratio(CELL x, CELL y); CELL add_ratio(RATIO* x, RATIO* y);
CELL subtract_ratio(CELL x, CELL y); CELL subtract_ratio(RATIO* x, RATIO* y);
CELL multiply_ratio(CELL x, CELL y); CELL multiply_ratio(RATIO* x, RATIO* y);
CELL divide_ratio(CELL x, CELL y); CELL divide_ratio(RATIO* x, RATIO* y);
CELL divfloat_ratio(CELL x, CELL y); CELL divfloat_ratio(RATIO* x, RATIO* y);
CELL less_ratio(CELL x, CELL y); CELL less_ratio(RATIO* x, RATIO* y);
CELL lesseq_ratio(CELL x, CELL y); CELL lesseq_ratio(RATIO* x, RATIO* y);
CELL greater_ratio(CELL x, CELL y); CELL greater_ratio(RATIO* x, RATIO* y);
CELL greatereq_ratio(CELL x, CELL y); CELL greatereq_ratio(RATIO* x, RATIO* y);